1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2 # vim: ts=4 sts=4 sw=4:
7 @CPAN::Author::ISA = qw(CPAN::InfoObj);
16 #-> sub CPAN::Author::force
22 #-> sub CPAN::Author::force
25 delete $self->{force};
28 #-> sub CPAN::Author::id
32 $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
36 #-> sub CPAN::Author::as_glimpse ;
40 my $class = ref($self);
41 $class =~ s/^CPAN:://;
42 push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n},
50 #-> sub CPAN::Author::fullname ;
52 shift->ro->{FULLNAME};
56 #-> sub CPAN::Author::email ;
57 sub email { shift->ro->{EMAIL}; }
59 #-> sub CPAN::Author::ls ;
62 my $glob = shift || "";
63 my $silent = shift || 0;
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")
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 ;
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;
82 @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1, 1);
84 if ($CPAN::META->has_inst("Text::Glob")) {
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;
95 CPAN->debug("rglob[$rglob]dl[@dl]") if $CPAN::DEBUG;
97 $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
100 unless ($silent >= 2) {
101 $CPAN::Frontend->myprint
107 "%8d %10s %s/%s%s\n",
114 } sort { $a->[2] cmp $b->[2] } @dl
120 # returns an array of arrays, the latter contain (size,mtime,filename)
121 #-> sub CPAN::Author::dir_listing ;
124 my $chksumfile = shift;
125 my $recursive = shift;
129 File::Spec->catfile($CPAN::Config->{keep_source_where},
130 "authors", "id", @$chksumfile);
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,
138 $fh = FileHandle->new;
139 if (open($fh, $lc_want)) {
140 my $line = <$fh>; close $fh;
141 unlink($lc_want) unless $line =~ /PGP/;
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;
152 $lc_file = CPAN::FTP->localize(
153 "authors/id/@$chksumfile",
158 $CPAN::Frontend->myprint("Trying $lc_want.gz\n");
159 $chksumfile->[-1] .= ".gz";
160 $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile",
163 $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
164 eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)};
171 # we *could* second-guess and if the user has a file: URL,
172 # then we could look there. But on the other hand, if they do
173 # have a file: URL, wy did they choose to set
174 # $CPAN::Config->{show_upload_date} to false?
177 # adapted from CPAN::Distribution::CHECKSUM_check_file ;
178 $fh = FileHandle->new;
180 if (open $fh, $lc_file) {
183 $eval =~ s/\015?\012/\n/g;
185 my($compmt) = Safe->new();
186 $cksum = $compmt->reval($eval);
188 rename $lc_file, "$lc_file.bad";
189 Carp::confess($@) if $@;
192 Carp::carp ("Could not open '$lc_file' for reading.");
194 # Maybe should warn: "You may want to set show_upload_date to a true value"
198 for $f (sort keys %$cksum) {
199 if (exists $cksum->{$f}{isdir}) {
201 my(@dir) = @$chksumfile;
203 push @dir, $f, "CHECKSUMS";
204 push @result, [ 0, "-", $f ];
206 [$_->[0], $_->[1], "$f/$_->[2]"]
207 } $self->dir_listing(\@dir,1,$may_ftp);
209 push @result, [ 0, "-", $f ];
213 ($cksum->{$f}{"size"}||0),
214 $cksum->{$f}{"mtime"}||"---",
222 #-> sub CPAN::Author::reports
224 $CPAN::Frontend->mywarn("reports on authors not implemented.
225 Please file a bugreport if you need this.\n");