<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
# vim: ts=4 sts=4 sw=4:
package CPAN::Author;
use strict;

use CPAN::InfoObj;
@CPAN::Author::ISA = qw(CPAN::InfoObj);
use vars qw(
            $VERSION
);
$VERSION = "5.5002";

package CPAN::Author;
use strict;

#-&gt; sub CPAN::Author::force
sub force {
    my $self = shift;
    $self-&gt;{force}++;
}

#-&gt; sub CPAN::Author::force
sub unforce {
    my $self = shift;
    delete $self-&gt;{force};
}

#-&gt; sub CPAN::Author::id
sub id {
    my $self = shift;
    my $id = $self-&gt;{ID};
    $CPAN::Frontend-&gt;mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/;
    $id;
}

#-&gt; sub CPAN::Author::as_glimpse ;
sub as_glimpse {
    my($self) = @_;
    my(@m);
    my $class = ref($self);
    $class =~ s/^CPAN:://;
    push @m, sprintf(qq{%-15s %s ("%s" &lt;%s&gt;)\n},
                     $class,
                     $self-&gt;{ID},
                     $self-&gt;fullname,
                     $self-&gt;email);
    join "", @m;
}

#-&gt; sub CPAN::Author::fullname ;
sub fullname {
    shift-&gt;ro-&gt;{FULLNAME};
}
*name = \&amp;fullname;

#-&gt; sub CPAN::Author::email ;
sub email    { shift-&gt;ro-&gt;{EMAIL}; }

#-&gt; sub CPAN::Author::ls ;
sub ls {
    my $self = shift;
    my $glob = shift || "";
    my $silent = shift || 0;
    my $id = $self-&gt;id;

    # adapted from CPAN::Distribution::verifyCHECKSUM ;
    my(@csf); # chksumfile
    @csf = $self-&gt;id =~ /(.)(.)(.*)/;
    $csf[1] = join "", @csf[0,1];
    $csf[2] = join "", @csf[1,2]; # ("A","AN","ANDK")
    my(@dl);
    @dl = $self-&gt;dir_listing([$csf[0],"CHECKSUMS"], 0, 1);
    unless (grep {$_-&gt;[2] eq $csf[1]} @dl) {
        $CPAN::Frontend-&gt;myprint("Directory $csf[1]/ does not exist\n") unless $silent ;
        return;
    }
    @dl = $self-&gt;dir_listing([@csf[0,1],"CHECKSUMS"], 0, 1);
    unless (grep {$_-&gt;[2] eq $csf[2]} @dl) {
        $CPAN::Frontend-&gt;myprint("Directory $id/ does not exist\n") unless $silent;
        return;
    }
    @dl = $self-&gt;dir_listing([@csf,"CHECKSUMS"], 1, 1);
    if ($glob) {
        if ($CPAN::META-&gt;has_inst("Text::Glob")) {
            $glob =~ s|/$|/*|;
            my $rglob = Text::Glob::glob_to_regex($glob);
            CPAN-&gt;debug("glob[$glob]rglob[$rglob]dl[@dl]") if $CPAN::DEBUG;
            my @tmpdl = grep { $_-&gt;[2] =~ /$rglob/ } @dl;
            if (1==@tmpdl &amp;&amp; $tmpdl[0][0]==0) {
                $rglob = Text::Glob::glob_to_regex("$glob/*");
                @dl = grep { $_-&gt;[2] =~ /$rglob/ } @dl;
            } else {
                @dl = @tmpdl;
            }
            CPAN-&gt;debug("rglob[$rglob]dl[@dl]") if $CPAN::DEBUG;
        } else {
            $CPAN::Frontend-&gt;mydie("Text::Glob not installed, cannot proceed");
        }
    }
    unless ($silent &gt;= 2) {
        $CPAN::Frontend-&gt;myprint
            (
             join "",
             map {
                 sprintf
                     (
                      "%8d %10s %s/%s%s\n",
                      $_-&gt;[0],
                      $_-&gt;[1],
                      $id,
                      $_-&gt;[2],
                      0==$_-&gt;[0]?"/":"",
                     )
                 } sort { $a-&gt;[2] cmp $b-&gt;[2] } @dl
            );
    }
    @dl;
}

# returns an array of arrays, the latter contain (size,mtime,filename)
#-&gt; sub CPAN::Author::dir_listing ;
sub dir_listing {
    my $self = shift;
    my $chksumfile = shift;
    my $recursive = shift;
    my $may_ftp = shift;

    my $lc_want =
        File::Spec-&gt;catfile($CPAN::Config-&gt;{keep_source_where},
                            "authors", "id", @$chksumfile);

    my $fh;

    CPAN-&gt;debug("chksumfile[@$chksumfile]recursive[$recursive]may_ftp[$may_ftp]") if $CPAN::DEBUG;
    # Purge and refetch old (pre-PGP) CHECKSUMS; they are a security
    # hazard.  (Without GPG installed they are not that much better,
    # though.)
    $fh = FileHandle-&gt;new;
    if (open($fh, $lc_want)) {
        my $line = &lt;$fh&gt;; close $fh;
        unlink($lc_want) unless $line =~ /PGP/;
    }

    local($") = "/";
    # connect "force" argument with "index_expire".
    my $force = $self-&gt;{force};
    if (my @stat = stat $lc_want) {
        $force ||= $stat[9] + $CPAN::Config-&gt;{index_expire}*86400 &lt;= time;
    }
    my $lc_file;
    if ($may_ftp) {
        $lc_file = eval {
            CPAN::FTP-&gt;localize
                    (
                     "authors/id/@$chksumfile",
                     $lc_want,
                     $force,
                    );
        };
        unless ($lc_file) {
            $CPAN::Frontend-&gt;myprint("Trying $lc_want.gz\n");
            $chksumfile-&gt;[-1] .= ".gz";
            $lc_file = eval {
                CPAN::FTP-&gt;localize
                        ("authors/id/@$chksumfile",
                         "$lc_want.gz",
                         1,
                        );
            };
            if ($lc_file) {
                $lc_file =~ s{\.gz(?!\n)\Z}{}; #};
                eval{CPAN::Tarzip-&gt;new("$lc_file.gz")-&gt;gunzip($lc_file)};
            } else {
                return;
            }
        }
    } else {
        $lc_file = $lc_want;
        # we *could* second-guess and if the user has a file: URL,
        # then we could look there. But on the other hand, if they do
        # have a file: URL, why did they choose to set
        # $CPAN::Config-&gt;{show_upload_date} to false?
    }

    # adapted from CPAN::Distribution::CHECKSUM_check_file ;
    $fh = FileHandle-&gt;new;
    my($cksum);
    if (open $fh, $lc_file) {
        local($/);
        my $eval = &lt;$fh&gt;;
        $eval =~ s/\015?\012/\n/g;
        close $fh;
        my($compmt) = Safe-&gt;new();
        $cksum = $compmt-&gt;reval($eval);
        if ($@) {
            rename $lc_file, "$lc_file.bad";
            Carp::confess($@) if $@;
        }
    } elsif ($may_ftp) {
        Carp::carp ("Could not open '$lc_file' for reading.");
    } else {
        # Maybe should warn: "You may want to set show_upload_date to a true value"
        return;
    }
    my(@result,$f);
    for $f (sort keys %$cksum) {
        if (exists $cksum-&gt;{$f}{isdir}) {
            if ($recursive) {
                my(@dir) = @$chksumfile;
                pop @dir;
                push @dir, $f, "CHECKSUMS";
                push @result, [ 0, "-", $f ];
                push @result, map {
                    [$_-&gt;[0], $_-&gt;[1], "$f/$_-&gt;[2]"]
                } $self-&gt;dir_listing(\@dir,1,$may_ftp);
            } else {
                push @result, [ 0, "-", $f ];
            }
        } else {
            push @result, [
                           ($cksum-&gt;{$f}{"size"}||0),
                           $cksum-&gt;{$f}{"mtime"}||"---",
                           $f
                          ];
        }
    }
    @result;
}

#-&gt; sub CPAN::Author::reports
sub reports {
    $CPAN::Frontend-&gt;mywarn("reports on authors not implemented.
Please file a bugreport if you need this.\n");
}

1;
</pre></body></html>