1# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2# vim: ts=4 sts=4 sw=4:
3package CPAN::Author;
4use strict;
5
6use CPAN::InfoObj;
7@CPAN::Author::ISA = qw(CPAN::InfoObj);
8use vars qw(
9            $VERSION
10);
11$VERSION = "5.5002";
12
13package CPAN::Author;
14use strict;
15
16#-> sub CPAN::Author::force
17sub force {
18    my $self = shift;
19    $self->{force}++;
20}
21
22#-> sub CPAN::Author::force
23sub unforce {
24    my $self = shift;
25    delete $self->{force};
26}
27
28#-> sub CPAN::Author::id
29sub id {
30    my $self = shift;
31    my $id = $self->{ID};
32    $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
33    $id;
34}
35
36#-> sub CPAN::Author::as_glimpse ;
37sub as_glimpse {
38    my($self) = @_;
39    my(@m);
40    my $class = ref($self);
41    $class =~ s/^CPAN:://;
42    push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
43                     $class,
44                     $self->{ID},
45                     $self->fullname,
46                     $self->email);
47    join "", @m;
48}
49
50#-> sub CPAN::Author::fullname ;
51sub fullname {
52    shift->ro->{FULLNAME};
53}
54*name = \&fullname;
55
56#-> sub CPAN::Author::email ;
57sub email    { shift->ro->{EMAIL}; }
58
59#-> sub CPAN::Author::ls ;
60sub ls {
61    my $self = shift;
62    my $glob = shift || "";
63    my $silent = shift || 0;
64    my $id = $self->id;
65
66    # adapted from CPAN::Distribution::verifyCHECKSUM ;
67    my(@csf); # chksumfile
68    @csf = $self->id =~ /(.)(.)(.*)/;
69    $csf[1] = join "", @csf[0,1];
70    $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
71    my(@dl);
72    @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
73    unless (grep {$_->[2] eq $csf[1]} @dl) {
74        $CPAN::Frontend->myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
75        return;
76    }
77    @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
78    unless (grep {$_->[2] eq $csf[2]} @dl) {
79        $CPAN::Frontend->myprint("Directory $id/ does not exist\n") unless $silent;
80        return;
81    }
82    @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
83    if ($glob) {
84        if ($CPAN::META->has_inst("Text::Glob")) {
85            $glob =~ s|/$|/*|;
86            my $rglob = Text::Glob::glob_to_regex($glob);
87            CPAN->debug("glob[$glob]rglob[$rglob]dl[@dl]") if $CPAN::DEBUG;
88            my @tmpdl = grep { $_->[2] =~ /$rglob/ } @dl;
89            if (1==@tmpdl && $tmpdl[0][0]==0) {
90                $rglob = Text::Glob::glob_to_regex("$glob/*");
91                @dl = grep { $_->[2] =~ /$rglob/ } @dl;
92            } else {
93                @dl = @tmpdl;
94            }
95            CPAN->debug("rglob[$rglob]dl[@dl]") if $CPAN::DEBUG;
96        } else {
97            $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
98        }
99    }
100    unless ($silent >= 2) {
101        $CPAN::Frontend->myprint
102            (
103             join "",
104             map {
105                 sprintf
106                     (
107                      "%8d %10s %s/%s%s\n",
108                      $_->[0],
109                      $_->[1],
110                      $id,
111                      $_->[2],
112                      0==$_->[0]?"/":"",
113                     )
114                 } sort { $a->[2] cmp $b->[2] } @dl
115            );
116    }
117    @dl;
118}
119
120# returns an array of arrays, the latter contain (size,mtime,filename)
121#-> sub CPAN::Author::dir_listing ;
122sub dir_listing {
123    my $self = shift;
124    my $chksumfile = shift;
125    my $recursive = shift;
126    my $may_ftp = shift;
127
128    my $lc_want =
129        File::Spec->catfile($CPAN::Config->{keep_source_where},
130                            "authors", "id", @$chksumfile);
131
132    my $fh;
133
134    CPAN->debug("chksumfile[@$chksumfile]recursive[$recursive]may_ftp[$may_ftp]") if $CPAN::DEBUG;
135    # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
136    # hazard.  (Without GPG installed they are not that much better,
137    # though.)
138    $fh = FileHandle->new;
139    if (open($fh, $lc_want)) {
140        my $line = <$fh>; close $fh;
141        unlink($lc_want) unless $line =~ /PGP/;
142    }
143
144    local($") = "/";
145    # connect "force" argument with "index_expire".
146    my $force = $self->{force};
147    if (my @stat = stat $lc_want) {
148        $force ||= $stat[9] + $CPAN::Config->{index_expire}*86400 <= time;
149    }
150    my $lc_file;
151    if ($may_ftp) {
152        $lc_file = eval {
153            CPAN::FTP->localize
154                    (
155                     "authors/id/@$chksumfile",
156                     $lc_want,
157                     $force,
158                    );
159        };
160        unless ($lc_file) {
161            $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
162            $chksumfile->[-1] .= ".gz";
163            $lc_file = eval {
164                CPAN::FTP->localize
165                        ("authors/id/@$chksumfile",
166                         "$lc_want.gz",
167                         1,
168                        );
169            };
170            if ($lc_file) {
171                $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
172                eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
173            } else {
174                return;
175            }
176        }
177    } else {
178        $lc_file = $lc_want;
179        # we *could* second-guess and if the user has a file: URL,
180        # then we could look there. But on the other hand, if they do
181        # have a file: URL, why did they choose to set
182        # $CPAN::Config->{show_upload_date} to false?
183    }
184
185    # adapted from CPAN::Distribution::CHECKSUM_check_file ;
186    $fh = FileHandle->new;
187    my($cksum);
188    if (open $fh, $lc_file) {
189        local($/);
190        my $eval = <$fh>;
191        $eval =~ s/\015?\012/\n/g;
192        close $fh;
193        my($compmt) = Safe->new();
194        $cksum = $compmt->reval($eval);
195        if ($@) {
196            rename $lc_file, "$lc_file.bad";
197            Carp::confess($@) if $@;
198        }
199    } elsif ($may_ftp) {
200        Carp::carp ("Could not open '$lc_file' for reading.");
201    } else {
202        # Maybe should warn: "You may want to set show_upload_date to a true value"
203        return;
204    }
205    my(@result,$f);
206    for $f (sort keys %$cksum) {
207        if (exists $cksum->{$f}{isdir}) {
208            if ($recursive) {
209                my(@dir) = @$chksumfile;
210                pop @dir;
211                push @dir, $f, "CHECKSUMS";
212                push @result, [ 0, "-", $f ];
213                push @result, map {
214                    [$_->[0], $_->[1], "$f/$_->[2]"]
215                } $self->dir_listing(\@dir,1,$may_ftp);
216            } else {
217                push @result, [ 0, "-", $f ];
218            }
219        } else {
220            push @result, [
221                           ($cksum->{$f}{"size"}||0),
222                           $cksum->{$f}{"mtime"}||"---",
223                           $f
224                          ];
225        }
226    }
227    @result;
228}
229
230#-> sub CPAN::Author::reports
231sub reports {
232    $CPAN::Frontend->mywarn("reports on authors not implemented.
233Please file a bugreport if you need this.\n");
234}
235
2361;
237