# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
# vim: ts=4 sts=4 sw=4:
use strict;
package CPAN;
$CPAN::VERSION = '1.9301';
$CPAN::VERSION =~ s/_//;

# we need to run chdir all over and we would get at wrong libraries
# there
use File::Spec ();
BEGIN {
    if (File::Spec->can("rel2abs")) {
        for my $inc (@INC) {
            $inc = File::Spec->rel2abs($inc) unless ref $inc;
        }
    }
}
use CPAN::HandleConfig;
use CPAN::Version;
use CPAN::Debug;
use CPAN::Queue;
use CPAN::Tarzip;
use CPAN::DeferedCode;
use Carp ();
use Config ();
use Cwd qw(chdir);
use DirHandle ();
use Exporter ();
use ExtUtils::MakeMaker qw(prompt); # for some unknown reason,
                                    # 5.005_04 does not work without
                                    # this
use File::Basename ();
use File::Copy ();
use File::Find;
use File::Path ();
use FileHandle ();
use Fcntl qw(:flock);
use Safe ();
use Sys::Hostname qw(hostname);
use Text::ParseWords ();
use Text::Wrap ();

# protect against "called too early"
sub find_perl ();
sub anycwd ();

no lib ".";

require Mac::BuildTools if $^O eq 'MacOS';
if ($ENV{PERL5_CPAN_IS_RUNNING} && $$ != $ENV{PERL5_CPAN_IS_RUNNING}) {
    $ENV{PERL5_CPAN_IS_RUNNING_IN_RECURSION} ||= $ENV{PERL5_CPAN_IS_RUNNING};
    my $rec = $ENV{PERL5_CPAN_IS_RUNNING_IN_RECURSION} .= ",$$";
    my @rec = split /,/, $rec;
    # warn "# Note: Recursive call of CPAN.pm detected\n";
    my $w = sprintf "# Note: CPAN.pm is running in process %d now", pop @rec;
    my %sleep = (
                 5 => 30,
                 6 => 60,
                 7 => 120,
                );
    my $sleep = @rec > 7 ? 300 : ($sleep{scalar @rec}||0);
    my $verbose = @rec >= 4;
    while (@rec) {
        $w .= sprintf " which has been called by process %d", pop @rec;
    }
    if ($sleep) {
        $w .= ".\n\n# Sleeping $sleep seconds to protect other processes\n";
    }
    if ($verbose) {
        warn $w;
    }
    local $| = 1;
    while ($sleep > 0) {
        printf "\r#%5d", --$sleep;
        sleep 1;
    }
    print "\n";
}
$ENV{PERL5_CPAN_IS_RUNNING}=$$;
$ENV{PERL5_CPANPLUS_IS_RUNNING}=$$; # https://rt.cpan.org/Ticket/Display.html?id=23735

END { $CPAN::End++; &cleanup; }

$CPAN::Signal ||= 0;
$CPAN::Frontend ||= "CPAN::Shell";
unless (@CPAN::Defaultsites) {
    @CPAN::Defaultsites = map {
        CPAN::URL->new(TEXT => $_, FROM => "DEF")
    }
        "http://www.perl.org/CPAN/",
            "ftp://ftp.perl.org/pub/CPAN/";
}
# $CPAN::iCwd (i for initial)
$CPAN::iCwd ||= CPAN::anycwd();
$CPAN::Perl ||= CPAN::find_perl();
$CPAN::Defaultdocs ||= "http://search.cpan.org/perldoc?";
$CPAN::Defaultrecent ||= "http://search.cpan.org/uploads.rdf";
$CPAN::Defaultrecent ||= "http://cpan.uwinnipeg.ca/htdocs/cpan.xml";

# our globals are getting a mess
use vars qw(
            $AUTOLOAD
            $Be_Silent
            $CONFIG_DIRTY
            $Defaultdocs
            $Echo_readline
            $Frontend
            $GOTOSHELL
            $HAS_USABLE
            $Have_warned
            $MAX_RECURSION
            $META
            $RUN_DEGRADED
            $Signal
            $SQLite
            $Suppress_readline
            $VERSION
            $autoload_recursion
            $term
            @Defaultsites
            @EXPORT
           );

$MAX_RECURSION = 32;

@CPAN::ISA = qw(CPAN::Debug Exporter);

# note that these functions live in CPAN::Shell and get executed via
# AUTOLOAD when called directly
@EXPORT = qw(
             autobundle
             bundle
             clean
             cvs_import
             expand
             force
             fforce
             get
             install
             install_tested
             is_tested
             make
             mkmyconfig
             notest
             perldoc
             readme
             recent
             recompile
             report
             shell
             smoke
             test
             upgrade
            );

sub soft_chdir_with_alternatives ($);

{
    $autoload_recursion ||= 0;

    #-> sub CPAN::AUTOLOAD ;
    sub AUTOLOAD {
        $autoload_recursion++;
        my($l) = $AUTOLOAD;
        $l =~ s/.*:://;
        if ($CPAN::Signal) {
            warn "Refusing to autoload '$l' while signal pending";
            $autoload_recursion--;
            return;
        }
        if ($autoload_recursion > 1) {
            my $fullcommand = join " ", map { "'$_'" } $l, @_;
            warn "Refusing to autoload $fullcommand in recursion\n";
            $autoload_recursion--;
            return;
        }
        my(%export);
        @export{@EXPORT} = '';
        CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
        if (exists $export{$l}) {
            CPAN::Shell->$l(@_);
        } else {
            die(qq{Unknown CPAN command "$AUTOLOAD". }.
                qq{Type ? for help.\n});
        }
        $autoload_recursion--;
    }
}

{
    my $x = *SAVEOUT; # avoid warning
    open($x,">&STDOUT") or die "dup failed";
    my $redir = 0;
    sub _redirect(@) {
        #die if $redir;
        local $_;
        push(@_,undef);
        while(defined($_=shift)) {
            if (s/^\s*>//){
                my ($m) = s/^>// ? ">" : "";
                s/\s+//;
                $_=shift unless length;
                die "no dest" unless defined;
                open(STDOUT,">$m$_") or die "open:$_:$!\n";
                $redir=1;
            } elsif ( s/^\s*\|\s*// ) {
                my $pipe="| $_";
                while(defined($_[0])){
                    $pipe .= ' ' . shift;
                }
                open(STDOUT,$pipe) or die "open:$pipe:$!\n";
                $redir=1;
            } else {
                push(@_,$_);
            }
        }
        return @_;
    }
    sub _unredirect {
        return unless $redir;
        $redir = 0;
        ## redirect: unredirect and propagate errors.  explicit close to wait for pipe.
        close(STDOUT);
        open(STDOUT,">&SAVEOUT");
        die "$@" if "$@";
        ## redirect: done
    }
}

#-> sub CPAN::shell ;
sub shell {
    my($self) = @_;
    $Suppress_readline = ! -t STDIN unless defined $Suppress_readline;
    CPAN::HandleConfig->load unless $CPAN::Config_loaded++;

    my $oprompt = shift || CPAN::Prompt->new;
    my $prompt = $oprompt;
    my $commandline = shift || "";
    $CPAN::CurrentCommandId ||= 1;

    local($^W) = 1;
    unless ($Suppress_readline) {
        require Term::ReadLine;
        if (! $term
            or
            $term->ReadLine eq "Term::ReadLine::Stub"
           ) {
            $term = Term::ReadLine->new('CPAN Monitor');
        }
        if ($term->ReadLine eq "Term::ReadLine::Gnu") {
            my $attribs = $term->Attribs;
            $attribs->{attempted_completion_function} = sub {
                &CPAN::Complete::gnu_cpl;
            }
        } else {
            $readline::rl_completion_function =
                $readline::rl_completion_function = 'CPAN::Complete::cpl';
        }
        if (my $histfile = $CPAN::Config->{'histfile'}) {{
            unless ($term->can("AddHistory")) {
                $CPAN::Frontend->mywarn("Terminal does not support AddHistory.\n");
                last;
            }
            $META->readhist($term,$histfile);
        }}
        for ($CPAN::Config->{term_ornaments}) { # alias
            local $Term::ReadLine::termcap_nowarn = 1;
            $term->ornaments($_) if defined;
        }
        # $term->OUT is autoflushed anyway
        my $odef = select STDERR;
        $| = 1;
        select STDOUT;
        $| = 1;
        select $odef;
    }

    $META->checklock();
    my @cwd = grep { defined $_ and length $_ }
        CPAN::anycwd(),
              File::Spec->can("tmpdir") ? File::Spec->tmpdir() : (),
                    File::Spec->rootdir();
    my $try_detect_readline;
    $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term;
    unless ($CPAN::Config->{inhibit_startup_message}) {
        my $rl_avail = $Suppress_readline ? "suppressed" :
            ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
                "available (maybe install Bundle::CPAN or Bundle::CPANxxl?)";
        $CPAN::Frontend->myprint(
                                 sprintf qq{
cpan shell -- CPAN exploration and modules installation (v%s)
ReadLine support %s

},
                                 $CPAN::VERSION,
                                 $rl_avail
                                )
    }
    my($continuation) = "";
    my $last_term_ornaments;
  SHELLCOMMAND: while () {
        if ($Suppress_readline) {
            if ($Echo_readline) {
                $|=1;
            }
            print $prompt;
            last SHELLCOMMAND unless defined ($_ = <> );
            if ($Echo_readline) {
                # backdoor: I could not find a way to record sessions
                print $_;
            }
            chomp;
        } else {
            last SHELLCOMMAND unless
                defined ($_ = $term->readline($prompt, $commandline));
        }
        $_ = "$continuation$_" if $continuation;
        s/^\s+//;
        next SHELLCOMMAND if /^$/;
        s/^\s*\?\s*/help /;
        if (/^(?:q(?:uit)?|bye|exit)$/i) {
            last SHELLCOMMAND;
        } elsif (s/\\$//s) {
            chomp;
            $continuation = $_;
            $prompt = "    > ";
        } elsif (/^\!/) {
            s/^\!//;
            my($eval) = $_;
            package CPAN::Eval;
            use strict;
            use vars qw($import_done);
            CPAN->import(':DEFAULT') unless $import_done++;
            CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
            eval($eval);
            warn $@ if $@;
            $continuation = "";
            $prompt = $oprompt;
        } elsif (/./) {
            my(@line);
            eval { @line = Text::ParseWords::shellwords($_) };
            warn($@), next SHELLCOMMAND if $@;
            warn("Text::Parsewords could not parse the line [$_]"),
                next SHELLCOMMAND unless @line;
            $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
            my $command = shift @line;
            eval {
                local (*STDOUT)=*STDOUT;
                @line = _redirect(@line);
                CPAN::Shell->$command(@line)
              };
            _unredirect;
            if ($@) {
                my $err = "$@";
                if ($err =~ /\S/) {
                    require Carp;
                    require Dumpvalue;
                    my $dv = Dumpvalue->new(tick => '"');
                    Carp::cluck(sprintf "Catching error: %s", $dv->stringify($err));
                }
            }
            if ($command =~ /^(
                             # classic commands
                             make
                             |test
                             |install
                             |clean

                             # pragmas for classic commands
                             |ff?orce
                             |notest

                             # compounds
                             |report
                             |smoke
                             |upgrade
                            )$/x) {
                # only commands that tell us something about failed distros
                CPAN::Shell->failed($CPAN::CurrentCommandId,1);
            }
            soft_chdir_with_alternatives(\@cwd);
            $CPAN::Frontend->myprint("\n");
            $continuation = "";
            $CPAN::CurrentCommandId++;
            $prompt = $oprompt;
        }
    } continue {
        $commandline = ""; # I do want to be able to pass a default to
                           # shell, but on the second command I see no
                           # use in that
        $Signal=0;
        CPAN::Queue->nullify_queue;
        if ($try_detect_readline) {
            if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
                ||
                $CPAN::META->has_inst("Term::ReadLine::Perl")
            ) {
                delete $INC{"Term/ReadLine.pm"};
                my $redef = 0;
                local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef);
                require Term::ReadLine;
                $CPAN::Frontend->myprint("\n$redef subroutines in ".
                                         "Term::ReadLine redefined\n");
                $GOTOSHELL = 1;
            }
        }
        if ($term and $term->can("ornaments")) {
            for ($CPAN::Config->{term_ornaments}) { # alias
                if (defined $_) {
                    if (not defined $last_term_ornaments
                        or $_ != $last_term_ornaments
                    ) {
                        local $Term::ReadLine::termcap_nowarn = 1;
                        $term->ornaments($_);
                        $last_term_ornaments = $_;
                    }
                } else {
                    undef $last_term_ornaments;
                }
            }
        }
        for my $class (qw(Module Distribution)) {
            # again unsafe meta access?
            for my $dm (keys %{$CPAN::META->{readwrite}{"CPAN::$class"}}) {
                next unless $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
                CPAN->debug("BUG: $class '$dm' was in command state, resetting");
                delete $CPAN::META->{readwrite}{"CPAN::$class"}{$dm}{incommandcolor};
            }
        }
        if ($GOTOSHELL) {
            $GOTOSHELL = 0; # not too often
            $META->savehist if $CPAN::term && $CPAN::term->can("GetHistory");
            @_ = ($oprompt,"");
            goto &shell;
        }
    }
    soft_chdir_with_alternatives(\@cwd);
}

#-> CPAN::soft_chdir_with_alternatives ;
sub soft_chdir_with_alternatives ($) {
    my($cwd) = @_;
    unless (@$cwd) {
        my $root = File::Spec->rootdir();
        $CPAN::Frontend->mywarn(qq{Warning: no good directory to chdir to!
Trying '$root' as temporary haven.
});
        push @$cwd, $root;
    }
    while () {
        if (chdir $cwd->[0]) {
            return;
        } else {
            if (@$cwd>1) {
                $CPAN::Frontend->mywarn(qq{Could not chdir to "$cwd->[0]": $!
Trying to chdir to "$cwd->[1]" instead.
});
                shift @$cwd;
            } else {
                $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd->[0]": $!});
            }
        }
    }
}

sub _flock {
    my($fh,$mode) = @_;
    if ( $Config::Config{d_flock} || $Config::Config{d_fcntl_can_lock} ) {
        return flock $fh, $mode;
    } elsif (!$Have_warned->{"d_flock"}++) {
        $CPAN::Frontend->mywarn("Your OS does not seem to support locking; continuing and ignoring all locking issues\n");
        $CPAN::Frontend->mysleep(5);
        return 1;
    } else {
        return 1;
    }
}

sub _yaml_module () {
    my $yaml_module = $CPAN::Config->{yaml_module} || "YAML";
    if (
        $yaml_module ne "YAML"
        &&
        !$CPAN::META->has_inst($yaml_module)
       ) {
        # $CPAN::Frontend->mywarn("'$yaml_module' not installed, falling back to 'YAML'\n");
        $yaml_module = "YAML";
    }
    if ($yaml_module eq "YAML"
        &&
        $CPAN::META->has_inst($yaml_module)
        &&
        $YAML::VERSION < 0.60
        &&
        !$Have_warned->{"YAML"}++
       ) {
        $CPAN::Frontend->mywarn("Warning: YAML version '$YAML::VERSION' is too low, please upgrade!\n".
                                "I'll continue but problems are *very* likely to happen.\n"
                               );
        $CPAN::Frontend->mysleep(5);
    }
    return $yaml_module;
}

# CPAN::_yaml_loadfile
sub _yaml_loadfile {
    my($self,$local_file) = @_;
    return +[] unless -s $local_file;
    my $yaml_module = _yaml_module;
    if ($CPAN::META->has_inst($yaml_module)) {
        # temporarly enable yaml code deserialisation
        no strict 'refs';
        # 5.6.2 could not do the local() with the reference
        # so we do it manually instead
        my $old_loadcode = ${"$yaml_module\::LoadCode"};
        ${ "$yaml_module\::LoadCode" } = $CPAN::Config->{yaml_load_code} || 0;

        my ($code, @yaml);
        if ($code = UNIVERSAL::can($yaml_module, "LoadFile")) {
            eval { @yaml = $code->($local_file); };
            if ($@) {
                # this shall not be done by the frontend
                die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
            }
        } elsif ($code = UNIVERSAL::can($yaml_module, "Load")) {
            local *FH;
            open FH, $local_file or die "Could not open '$local_file': $!";
            local $/;
            my $ystream = <FH>;
            eval { @yaml = $code->($ystream); };
            if ($@) {
                # this shall not be done by the frontend
                die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"parse",$@);
            }
        }
        ${"$yaml_module\::LoadCode"} = $old_loadcode;
        return \@yaml;
    } else {
        # this shall not be done by the frontend
        die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "parse");
    }
    return +[];
}

# CPAN::_yaml_dumpfile
sub _yaml_dumpfile {
    my($self,$local_file,@what) = @_;
    my $yaml_module = _yaml_module;
    if ($CPAN::META->has_inst($yaml_module)) {
        my $code;
        if (UNIVERSAL::isa($local_file, "FileHandle")) {
            $code = UNIVERSAL::can($yaml_module, "Dump");
            eval { print $local_file $code->(@what) };
        } elsif ($code = UNIVERSAL::can($yaml_module, "DumpFile")) {
            eval { $code->($local_file,@what); };
        } elsif ($code = UNIVERSAL::can($yaml_module, "Dump")) {
            local *FH;
            open FH, ">$local_file" or die "Could not open '$local_file': $!";
            print FH $code->(@what);
        }
        if ($@) {
            die CPAN::Exception::yaml_process_error->new($yaml_module,$local_file,"dump",$@);
        }
    } else {
        if (UNIVERSAL::isa($local_file, "FileHandle")) {
            # I think this case does not justify a warning at all
        } else {
            die CPAN::Exception::yaml_not_installed->new($yaml_module, $local_file, "dump");
        }
    }
}

sub _init_sqlite () {
    unless ($CPAN::META->has_inst("CPAN::SQLite")) {
        $CPAN::Frontend->mywarn(qq{CPAN::SQLite not installed, trying to work without\n})
            unless $Have_warned->{"CPAN::SQLite"}++;
        return;
    }
    require CPAN::SQLite::META; # not needed since CVS version of 2006-12-17
    $CPAN::SQLite ||= CPAN::SQLite::META->new($CPAN::META);
}

{
    my $negative_cache = {};
    sub _sqlite_running {
        if ($negative_cache->{time} && time < $negative_cache->{time} + 60) {
            # need to cache the result, otherwise too slow
            return $negative_cache->{fact};
        } else {
            $negative_cache = {}; # reset
        }
        my $ret = $CPAN::Config->{use_sqlite} && ($CPAN::SQLite || _init_sqlite());
        return $ret if $ret; # fast anyway
        $negative_cache->{time} = time;
        return $negative_cache->{fact} = $ret;
    }
}

package CPAN::CacheMgr;
use strict;
@CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
use Cwd qw(chdir);
use File::Find;

package CPAN::FTP;
use strict;
use Fcntl qw(:flock);
use vars qw($connect_to_internet_ok $Ua $Thesite $ThesiteURL $Themethod);
@CPAN::FTP::ISA = qw(CPAN::Debug);

package CPAN::LWP::UserAgent;
use strict;
use vars qw(@ISA $USER $PASSWD $SETUPDONE);
# we delay requiring LWP::UserAgent and setting up inheritance until we need it

package CPAN::Complete;
use strict;
@CPAN::Complete::ISA = qw(CPAN::Debug);
# Q: where is the "How do I add a new command" HOWTO?
# A: svn diff -r 1048:1049 where andk added the report command
@CPAN::Complete::COMMANDS = sort qw(
                                    ? ! a b d h i m o q r u
                                    autobundle
                                    bye
                                    clean
                                    cvs_import
                                    dump
                                    exit
                                    failed
                                    force
                                    fforce
                                    hosts
                                    install
                                    install_tested
                                    is_tested
                                    look
                                    ls
                                    make
                                    mkmyconfig
                                    notest
                                    perldoc
                                    quit
                                    readme
                                    recent
                                    recompile
                                    reload
                                    report
                                    reports
                                    scripts
                                    smoke
                                    test
                                    upgrade
);

package CPAN::Index;
use strict;
use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED);
@CPAN::Index::ISA = qw(CPAN::Debug);
$LAST_TIME ||= 0;
$DATE_OF_03 ||= 0;
# use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57
sub PROTOCOL { 2.0 }

package CPAN::InfoObj;
use strict;
@CPAN::InfoObj::ISA = qw(CPAN::Debug);

package CPAN::Author;
use strict;
@CPAN::Author::ISA = qw(CPAN::InfoObj);

package CPAN::Distribution;
use strict;
@CPAN::Distribution::ISA = qw(CPAN::InfoObj);

package CPAN::Bundle;
use strict;
@CPAN::Bundle::ISA = qw(CPAN::Module);

package CPAN::Module;
use strict;
@CPAN::Module::ISA = qw(CPAN::InfoObj);

package CPAN::Exception::RecursiveDependency;
use strict;
use overload '""' => "as_string";

# a module sees its distribution (no version)
# a distribution sees its prereqs (which are module names) (usually with versions)
# a bundle sees its module names and/or its distributions (no version)

sub new {
    my($class) = shift;
    my($deps) = shift;
    my (@deps,%seen,$loop_starts_with);
  DCHAIN: for my $dep (@$deps) {
        push @deps, {name => $dep, display_as => $dep};
        if ($seen{$dep}++) {
            $loop_starts_with = $dep;
            last DCHAIN;
        }
    }
    my $in_loop = 0;
    for my $i (0..$#deps) {
        my $x = $deps[$i]{name};
        $in_loop ||= $x eq $loop_starts_with;
        my $xo = CPAN::Shell->expandany($x) or next;
        if ($xo->isa("CPAN::Module")) {
            my $have = $xo->inst_version || "N/A";
            my($want,$d,$want_type);
            if ($i>0 and $d = $deps[$i-1]{name}) {
                my $do = CPAN::Shell->expandany($d);
                $want = $do->{prereq_pm}{requires}{$x};
                if (defined $want) {
                    $want_type = "requires: ";
                } else {
                    $want = $do->{prereq_pm}{build_requires}{$x};
                    if (defined $want) {
                        $want_type = "build_requires: ";
                    } else {
                        $want_type = "unknown status";
                        $want = "???";
                    }
                }
            } else {
                $want = $xo->cpan_version;
                $want_type = "want: ";
            }
            $deps[$i]{have} = $have;
            $deps[$i]{want_type} = $want_type;
            $deps[$i]{want} = $want;
            $deps[$i]{display_as} = "$x (have: $have; $want_type$want)";
        } elsif ($xo->isa("CPAN::Distribution")) {
            $deps[$i]{display_as} = $xo->pretty_id;
            if ($in_loop) {
                $xo->{make} = CPAN::Distrostatus->new("NO cannot resolve circular dependency");
            } else {
                $xo->{make} = CPAN::Distrostatus->new("NO one dependency ($loop_starts_with) is a circular dependency");
            }
            $xo->store_persistent_state; # otherwise I will not reach
                                         # all involved parties for
                                         # the next session
        }
    }
    bless { deps => \@deps }, $class;
}

sub as_string {
    my($self) = shift;
    my $ret = "\nRecursive dependency detected:\n    ";
    $ret .= join("\n => ", map {$_->{display_as}} @{$self->{deps}});
    $ret .= ".\nCannot resolve.\n";
    $ret;
}

package CPAN::Exception::yaml_not_installed;
use strict;
use overload '""' => "as_string";

sub new {
    my($class,$module,$file,$during) = @_;
    bless { module => $module, file => $file, during => $during }, $class;
}

sub as_string {
    my($self) = shift;
    "'$self->{module}' not installed, cannot $self->{during} '$self->{file}'\n";
}

package CPAN::Exception::yaml_process_error;
use strict;
use overload '""' => "as_string";

sub new {
    my($class,$module,$file,$during,$error) = @_;
    # my $at = Carp::longmess(""); # XXX find something more beautiful
    bless { module => $module,
            file => $file,
            during => $during,
            error => $error,
            # at => $at,
          }, $class;
}

sub as_string {
    my($self) = shift;
    if ($self->{during}) {
        if ($self->{file}) {
            if ($self->{module}) {
                if ($self->{error}) {
                    return "Alert: While trying to '$self->{during}' YAML file\n".
                        " '$self->{file}'\n".
                            "with '$self->{module}' the following error was encountered:\n".
                                "  $self->{error}\n";
                } else {
                    return "Alert: While trying to '$self->{during}' YAML file\n".
                        " '$self->{file}'\n".
                            "with '$self->{module}' some unknown error was encountered\n";
                }
            } else {
                return "Alert: While trying to '$self->{during}' YAML file\n".
                    " '$self->{file}'\n".
                        "some unknown error was encountered\n";
            }
        } else {
            return "Alert: While trying to '$self->{during}' some YAML file\n".
                    "some unknown error was encountered\n";
        }
    } else {
        return "Alert: unknown error encountered\n";
    }
}

package CPAN::Prompt; use overload '""' => "as_string";
use vars qw($prompt);
$prompt = "cpan> ";
$CPAN::CurrentCommandId ||= 0;
sub new {
    bless {}, shift;
}
sub as_string {
    my $word = "cpan";
    unless ($CPAN::META->{LOCK}) {
        $word = "nolock_cpan";
    }
    if ($CPAN::Config->{commandnumber_in_prompt}) {
        sprintf "$word\[%d]> ", $CPAN::CurrentCommandId;
    } else {
        "$word> ";
    }
}

package CPAN::URL; use overload '""' => "as_string", fallback => 1;
# accessors: TEXT(the url string), FROM(DEF=>defaultlist,USER=>urllist),
# planned are things like age or quality
sub new {
    my($class,%args) = @_;
    bless {
           %args
          }, $class;
}
sub as_string {
    my($self) = @_;
    $self->text;
}
sub text {
    my($self,$set) = @_;
    if (defined $set) {
        $self->{TEXT} = $set;
    }
    $self->{TEXT};
}

package CPAN::Distrostatus;
use overload '""' => "as_string",
    fallback => 1;
use vars qw($something_has_failed_at);
sub new {
    my($class,$arg) = @_;
    my $failed = substr($arg,0,2) eq "NO";
    if ($failed) {
        $something_has_failed_at = $CPAN::CurrentCommandId;
    }
    bless {
           TEXT => $arg,
           FAILED => $failed,
           COMMANDID => $CPAN::CurrentCommandId,
           TIME => time,
          }, $class;
}
sub something_has_just_failed () {
    defined $something_has_failed_at &&
        $something_has_failed_at == $CPAN::CurrentCommandId;
}
sub commandid { shift->{COMMANDID} }
sub failed { shift->{FAILED} }
sub text {
    my($self,$set) = @_;
    if (defined $set) {
        $self->{TEXT} = $set;
    }
    $self->{TEXT};
}
sub as_string {
    my($self) = @_;
    $self->text;
}

package CPAN::Shell;
use strict;
use vars qw(
            $ADVANCED_QUERY
            $AUTOLOAD
            $COLOR_REGISTERED
            $Help
            $autoload_recursion
            $reload
            @ISA
            @relo
           );
@relo =     (
             "CPAN.pm",
             "CPAN/Debug.pm",
             "CPAN/Distroprefs.pm",
             "CPAN/FirstTime.pm",
             "CPAN/HandleConfig.pm",
             "CPAN/Kwalify.pm",
             "CPAN/Queue.pm",
             "CPAN/Reporter/Config.pm",
             "CPAN/Reporter/History.pm",
             "CPAN/Reporter/PrereqCheck.pm",
             "CPAN/Reporter.pm",
             "CPAN/SQLite.pm",
             "CPAN/Tarzip.pm",
             "CPAN/Version.pm",
            );
# record the initial timestamp for reload.
$reload = { map {$INC{$_} ? ($_,(stat $INC{$_})[9]) : ()} @relo };
@CPAN::Shell::ISA = qw(CPAN::Debug);
use Cwd qw(chdir);
$COLOR_REGISTERED ||= 0;
$Help = {
         '?' => \"help",
         '!' => "eval the rest of the line as perl",
         a => "whois author",
         autobundle => "wtite inventory into a bundle file",
         b => "info about bundle",
         bye => \"quit",
         clean => "clean up a distribution's build directory",
         # cvs_import
         d => "info about a distribution",
         # dump
         exit => \"quit",
         failed => "list all failed actions within current session",
         fforce => "redo a command from scratch",
         force => "redo a command",
         h => \"help",
         help => "overview over commands; 'help ...' explains specific commands",
         hosts => "statistics about recently used hosts",
         i => "info about authors/bundles/distributions/modules",
         install => "install a distribution",
         install_tested => "install all distributions tested OK",
         is_tested => "list all distributions tested OK",
         look => "open a subshell in a distribution's directory",
         ls => "list distributions according to a glob",
         m => "info about a module",
         make => "make/build a distribution",
         mkmyconfig => "write current config into a CPAN/MyConfig.pm file",
         notest => "run a (usually install) command but leave out the test phase",
         o => "'o conf ...' for config stuff; 'o debug ...' for debugging",
         perldoc => "try to get a manpage for a module",
         q => \"quit",
         quit => "leave the cpan shell",
         r => "review over upgradeable modules",
         readme => "display the README of a distro woth a pager",
         recent => "show recent uploads to the CPAN",
         # recompile
         reload => "'reload cpan' or 'reload index'",
         report => "test a distribution and send a test report to cpantesters",
         reports => "info about reported tests from cpantesters",
         # scripts
         # smoke
         test => "test a distribution",
         u => "display uninstalled modules",
         upgrade => "combine 'r' command with immediate installation",
        };
{
    $autoload_recursion   ||= 0;

    #-> sub CPAN::Shell::AUTOLOAD ;
    sub AUTOLOAD {
        $autoload_recursion++;
        my($l) = $AUTOLOAD;
        my $class = shift(@_);
        # warn "autoload[$l] class[$class]";
        $l =~ s/.*:://;
        if ($CPAN::Signal) {
            warn "Refusing to autoload '$l' while signal pending";
            $autoload_recursion--;
            return;
        }
        if ($autoload_recursion > 1) {
            my $fullcommand = join " ", map { "'$_'" } $l, @_;
            warn "Refusing to autoload $fullcommand in recursion\n";
            $autoload_recursion--;
            return;
        }
        if ($l =~ /^w/) {
            # XXX needs to be reconsidered
            if ($CPAN::META->has_inst('CPAN::WAIT')) {
                CPAN::WAIT->$l(@_);
            } else {
                $CPAN::Frontend->mywarn(qq{
Commands starting with "w" require CPAN::WAIT to be installed.
Please consider installing CPAN::WAIT to use the fulltext index.
For this you just need to type
    install CPAN::WAIT
});
            }
        } else {
            $CPAN::Frontend->mywarn(qq{Unknown shell command '$l'. }.
                                    qq{Type ? for help.
});
        }
        $autoload_recursion--;
    }
}

package CPAN;
use strict;

$META ||= CPAN->new; # In case we re-eval ourselves we need the ||

# from here on only subs.
################################################################################

sub _perl_fingerprint {
    my($self,$other_fingerprint) = @_;
    my $dll = eval {OS2::DLLname()};
    my $mtime_dll = 0;
    if (defined $dll) {
        $mtime_dll = (-f $dll ? (stat(_))[9] : '-1');
    }
    my $mtime_perl = (-f CPAN::find_perl ? (stat(_))[9] : '-1');
    my $this_fingerprint = {
                            '$^X' => CPAN::find_perl,
                            sitearchexp => $Config::Config{sitearchexp},
                            'mtime_$^X' => $mtime_perl,
                            'mtime_dll' => $mtime_dll,
                           };
    if ($other_fingerprint) {
        if (exists $other_fingerprint->{'stat($^X)'}) { # repair fp from rev. 1.88_57
            $other_fingerprint->{'mtime_$^X'} = $other_fingerprint->{'stat($^X)'}[9];
        }
        # mandatory keys since 1.88_57
        for my $key (qw($^X sitearchexp mtime_dll mtime_$^X)) {
            return unless $other_fingerprint->{$key} eq $this_fingerprint->{$key};
        }
        return 1;
    } else {
        return $this_fingerprint;
    }
}

sub suggest_myconfig () {
  SUGGEST_MYCONFIG: if(!$INC{'CPAN/MyConfig.pm'}) {
        $CPAN::Frontend->myprint("You don't seem to have a user ".
                                 "configuration (MyConfig.pm) yet.\n");
        my $new = CPAN::Shell::colorable_makemaker_prompt("Do you want to create a ".
                                              "user configuration now? (Y/n)",
                                              "yes");
        if($new =~ m{^y}i) {
            CPAN::Shell->mkmyconfig();
            return &checklock;
        } else {
            $CPAN::Frontend->mydie("OK, giving up.");
        }
    }
}

#-> sub CPAN::all_objects ;
sub all_objects {
    my($mgr,$class) = @_;
    CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
    CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
    CPAN::Index->reload;
    values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok
}

# Called by shell, not in batch mode. In batch mode I see no risk in
# having many processes updating something as installations are
# continually checked at runtime. In shell mode I suspect it is
# unintentional to open more than one shell at a time

#-> sub CPAN::checklock ;
sub checklock {
    my($self) = @_;
    my $lockfile = File::Spec->catfile($CPAN::Config->{cpan_home},".lock");
    if (-f $lockfile && -M _ > 0) {
        my $fh = FileHandle->new($lockfile) or
            $CPAN::Frontend->mydie("Could not open lockfile '$lockfile': $!");
        my $otherpid  = <$fh>;
        my $otherhost = <$fh>;
        $fh->close;
        if (defined $otherpid && $otherpid) {
            chomp $otherpid;
        }
        if (defined $otherhost && $otherhost) {
            chomp $otherhost;
        }
        my $thishost  = hostname();
        if (defined $otherhost && defined $thishost &&
            $otherhost ne '' && $thishost ne '' &&
            $otherhost ne $thishost) {
            $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile '$lockfile'\n".
                                           "reports other host $otherhost and other ".
                                           "process $otherpid.\n".
                                           "Cannot proceed.\n"));
        } elsif ($RUN_DEGRADED) {
            $CPAN::Frontend->mywarn("Running in degraded mode (experimental)\n");
        } elsif (defined $otherpid && $otherpid) {
            return if $$ == $otherpid; # should never happen
            $CPAN::Frontend->mywarn(
                                    qq{
There seems to be running another CPAN process (pid $otherpid).  Contacting...
});
            if (kill 0, $otherpid or $!{EPERM}) {
                $CPAN::Frontend->mywarn(qq{Other job is running.\n});
                my($ans) =
                    CPAN::Shell::colorable_makemaker_prompt
                        (qq{Shall I try to run in degraded }.
                        qq{mode? (Y/n)},"y");
                if ($ans =~ /^y/i) {
                    $CPAN::Frontend->mywarn("Running in degraded mode (experimental).
Please report if something unexpected happens\n");
                    $RUN_DEGRADED = 1;
                    for ($CPAN::Config) {
                        # XXX
                        # $_->{build_dir_reuse} = 0; # 2006-11-17 akoenig Why was that?
                        $_->{commandnumber_in_prompt} = 0; # visibility
                        $_->{histfile} = "";               # who should win otherwise?
                        $_->{cache_metadata} = 0;          # better would be a lock?
                        $_->{use_sqlite} = 0;              # better would be a write lock!
                    }
                } else {
                    $CPAN::Frontend->mydie("
You may want to kill the other job and delete the lockfile. On UNIX try:
    kill $otherpid
    rm $lockfile
");
                }
            } elsif (-w $lockfile) {
                my($ans) =
                    CPAN::Shell::colorable_makemaker_prompt
                        (qq{Other job not responding. Shall I overwrite }.
                        qq{the lockfile '$lockfile'? (Y/n)},"y");
            $CPAN::Frontend->myexit("Ok, bye\n")
                unless $ans =~ /^y/i;
            } else {
                Carp::croak(
                    qq{Lockfile '$lockfile' not writeable by you. }.
                    qq{Cannot proceed.\n}.
                    qq{    On UNIX try:\n}.
                    qq{    rm '$lockfile'\n}.
                    qq{  and then rerun us.\n}
                );
            }
        } else {
            $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Found invalid lockfile ".
                                           "'$lockfile', please remove. Cannot proceed.\n"));
        }
    }
    my $dotcpan = $CPAN::Config->{cpan_home};
    eval { File::Path::mkpath($dotcpan);};
    if ($@) {
        # A special case at least for Jarkko.
        my $firsterror = $@;
        my $seconderror;
        my $symlinkcpan;
        if (-l $dotcpan) {
            $symlinkcpan = readlink $dotcpan;
            die "readlink $dotcpan failed: $!" unless defined $symlinkcpan;
            eval { File::Path::mkpath($symlinkcpan); };
            if ($@) {
                $seconderror = $@;
            } else {
                $CPAN::Frontend->mywarn(qq{
Working directory $symlinkcpan created.
});
            }
        }
        unless (-d $dotcpan) {
            my $mess = qq{
Your configuration suggests "$dotcpan" as your
CPAN.pm working directory. I could not create this directory due
to this error: $firsterror\n};
            $mess .= qq{
As "$dotcpan" is a symlink to "$symlinkcpan",
I tried to create that, but I failed with this error: $seconderror
} if $seconderror;
            $mess .= qq{
Please make sure the directory exists and is writable.
};
            $CPAN::Frontend->mywarn($mess);
            return suggest_myconfig;
        }
    } # $@ after eval mkpath $dotcpan
    if (0) { # to test what happens when a race condition occurs
        for (reverse 1..10) {
            print $_, "\n";
            sleep 1;
        }
    }
    # locking
    if (!$RUN_DEGRADED && !$self->{LOCKFH}) {
        my $fh;
        unless ($fh = FileHandle->new("+>>$lockfile")) {
            if ($! =~ /Permission/) {
                $CPAN::Frontend->mywarn(qq{

Your configuration suggests that CPAN.pm should use a working
directory of
    $CPAN::Config->{cpan_home}
Unfortunately we could not create the lock file
    $lockfile
due to permission problems.

Please make sure that the configuration variable
    \$CPAN::Config->{cpan_home}
points to a directory where you can write a .lock file. You can set
this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your
\@INC path;
});
                return suggest_myconfig;
            }
        }
        my $sleep = 1;
        while (!CPAN::_flock($fh, LOCK_EX|LOCK_NB)) {
            if ($sleep>10) {
                $CPAN::Frontend->mydie("Giving up\n");
            }
            $CPAN::Frontend->mysleep($sleep++);
            $CPAN::Frontend->mywarn("Could not lock lockfile with flock: $!; retrying\n");
        }

        seek $fh, 0, 0;
        truncate $fh, 0;
        $fh->autoflush(1);
        $fh->print($$, "\n");
        $fh->print(hostname(), "\n");
        $self->{LOCK} = $lockfile;
        $self->{LOCKFH} = $fh;
    }
    $SIG{TERM} = sub {
        my $sig = shift;
        &cleanup;
        $CPAN::Frontend->mydie("Got SIG$sig, leaving");
    };
    $SIG{INT} = sub {
      # no blocks!!!
        my $sig = shift;
        &cleanup if $Signal;
        die "Got yet another signal" if $Signal > 1;
        $CPAN::Frontend->mydie("Got another SIG$sig") if $Signal;
        $CPAN::Frontend->mywarn("Caught SIG$sig, trying to continue\n");
        $Signal++;
    };

#       From: Larry Wall <larry@wall.org>
#       Subject: Re: deprecating SIGDIE
#       To: perl5-porters@perl.org
#       Date: Thu, 30 Sep 1999 14:58:40 -0700 (PDT)
#
#       The original intent of __DIE__ was only to allow you to substitute one
#       kind of death for another on an application-wide basis without respect
#       to whether you were in an eval or not.  As a global backstop, it should
#       not be used any more lightly (or any more heavily :-) than class
#       UNIVERSAL.  Any attempt to build a general exception model on it should
#       be politely squashed.  Any bug that causes every eval {} to have to be
#       modified should be not so politely squashed.
#
#       Those are my current opinions.  It is also my optinion that polite
#       arguments degenerate to personal arguments far too frequently, and that
#       when they do, it's because both people wanted it to, or at least didn't
#       sufficiently want it not to.
#
#       Larry

    # global backstop to cleanup if we should really die
    $SIG{__DIE__} = \&cleanup;
    $self->debug("Signal handler set.") if $CPAN::DEBUG;
}

#-> sub CPAN::DESTROY ;
sub DESTROY {
    &cleanup; # need an eval?
}

#-> sub CPAN::anycwd ;
sub anycwd () {
    my $getcwd;
    $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
    CPAN->$getcwd();
}

#-> sub CPAN::cwd ;
sub cwd {Cwd::cwd();}

#-> sub CPAN::getcwd ;
sub getcwd {Cwd::getcwd();}

#-> sub CPAN::fastcwd ;
sub fastcwd {Cwd::fastcwd();}

#-> sub CPAN::backtickcwd ;
sub backtickcwd {my $cwd = `cwd`; chomp $cwd; $cwd}

#-> sub CPAN::find_perl ;
sub find_perl () {
    my($perl) = File::Spec->file_name_is_absolute($^X) ? $^X : "";
    unless ($perl) {
        my $candidate = File::Spec->catfile($CPAN::iCwd,$^X);
        $^X = $perl = $candidate if MM->maybe_command($candidate);
    }
    unless ($perl) {
        my ($component,$perl_name);
      DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
          PATH_COMPONENT: foreach $component (File::Spec->path(),
                                                $Config::Config{'binexp'}) {
                next unless defined($component) && $component;
                my($abs) = File::Spec->catfile($component,$perl_name);
                if (MM->maybe_command($abs)) {
                    $^X = $perl = $abs;
                    last DIST_PERLNAME;
                }
            }
        }
    }
    return $perl;
}


#-> sub CPAN::exists ;
sub exists {
    my($mgr,$class,$id) = @_;
    CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
    CPAN::Index->reload;
    ### Carp::croak "exists called without class argument" unless $class;
    $id ||= "";
    $id =~ s/:+/::/g if $class eq "CPAN::Module";
    my $exists;
    if (CPAN::_sqlite_running) {
        $exists = (exists $META->{readonly}{$class}{$id} or
                   $CPAN::SQLite->set($class, $id));
    } else {
        $exists =  exists $META->{readonly}{$class}{$id};
    }
    $exists ||= exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
}

#-> sub CPAN::delete ;
sub delete {
  my($mgr,$class,$id) = @_;
  delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok
  delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok
}

#-> sub CPAN::has_usable
# has_inst is sometimes too optimistic, we should replace it with this
# has_usable whenever a case is given
sub has_usable {
    my($self,$mod,$message) = @_;
    return 1 if $HAS_USABLE->{$mod};
    my $has_inst = $self->has_inst($mod,$message);
    return unless $has_inst;
    my $usable;
    $usable = {
               LWP => [ # we frequently had "Can't locate object
                        # method "new" via package "LWP::UserAgent" at
                        # (eval 69) line 2006
                       sub {require LWP},
                       sub {require LWP::UserAgent},
                       sub {require HTTP::Request},
                       sub {require URI::URL},
                      ],
               'Net::FTP' => [
                            sub {require Net::FTP},
                            sub {require Net::Config},
                           ],
               'File::HomeDir' => [
                                   sub {require File::HomeDir;
                                        unless (CPAN::Version->vge(File::HomeDir::->VERSION, 0.52)) {
                                            for ("Will not use File::HomeDir, need 0.52\n") {
                                                $CPAN::Frontend->mywarn($_);
                                                die $_;
                                            }
                                        }
                                    },
                                  ],
               'Archive::Tar' => [
                                  sub {require Archive::Tar;
                                       unless (CPAN::Version->vge(Archive::Tar::->VERSION, 1.00)) {
                                            for ("Will not use Archive::Tar, need 1.00\n") {
                                                $CPAN::Frontend->mywarn($_);
                                                die $_;
                                            }
                                       }
                                  },
                                 ],
               'File::Temp' => [
                                # XXX we should probably delete from
                                # %INC too so we can load after we
                                # installed a new enough version --
                                # I'm not sure.
                                sub {require File::Temp;
                                     unless (CPAN::Version->vge(File::Temp::->VERSION,0.16)) {
                                         for ("Will not use File::Temp, need 0.16\n") {
                                                $CPAN::Frontend->mywarn($_);
                                                die $_;
                                         }
                                     }
                                },
                               ]
              };
    if ($usable->{$mod}) {
        for my $c (0..$#{$usable->{$mod}}) {
            my $code = $usable->{$mod}[$c];
            my $ret = eval { &$code() };
            $ret = "" unless defined $ret;
            if ($@) {
                # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]";
                return;
            }
        }
    }
    return $HAS_USABLE->{$mod} = 1;
}

#-> sub CPAN::has_inst
sub has_inst {
    my($self,$mod,$message) = @_;
    Carp::croak("CPAN->has_inst() called without an argument")
        unless defined $mod;
    my %dont = map { $_ => 1 } keys %{$CPAN::META->{dontload_hash}||{}},
        keys %{$CPAN::Config->{dontload_hash}||{}},
            @{$CPAN::Config->{dontload_list}||[]};
    if (defined $message && $message eq "no"  # afair only used by Nox
        ||
        $dont{$mod}
       ) {
      $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
      return 0;
    }
    my $file = $mod;
    my $obj;
    $file =~ s|::|/|g;
    $file .= ".pm";
    if ($INC{$file}) {
        # checking %INC is wrong, because $INC{LWP} may be true
        # although $INC{"URI/URL.pm"} may have failed. But as
        # I really want to say "bla loaded OK", I have to somehow
        # cache results.
        ### warn "$file in %INC"; #debug
        return 1;
    } elsif (eval { require $file }) {
        # eval is good: if we haven't yet read the database it's
        # perfect and if we have installed the module in the meantime,
        # it tries again. The second require is only a NOOP returning
        # 1 if we had success, otherwise it's retrying

        my $mtime = (stat $INC{$file})[9];
        # privileged files loaded by has_inst; Note: we use $mtime
        # as a proxy for a checksum.
        $CPAN::Shell::reload->{$file} = $mtime;
        my $v = eval "\$$mod\::VERSION";
        $v = $v ? " (v$v)" : "";
        CPAN::Shell->optprint("load_module","CPAN: $mod loaded ok$v\n");
        if ($mod eq "CPAN::WAIT") {
            push @CPAN::Shell::ISA, 'CPAN::WAIT';
        }
        return 1;
    } elsif ($mod eq "Net::FTP") {
        $CPAN::Frontend->mywarn(qq{
  Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
  if you just type
      install Bundle::libnet

}) unless $Have_warned->{"Net::FTP"}++;
        $CPAN::Frontend->mysleep(3);
    } elsif ($mod eq "Digest::SHA") {
        if ($Have_warned->{"Digest::SHA"}++) {
            $CPAN::Frontend->mywarn(qq{CPAN: checksum security checks disabled }.
                                     qq{because Digest::SHA not installed.\n});
        } else {
            $CPAN::Frontend->mywarn(qq{
  CPAN: checksum security checks disabled because Digest::SHA not installed.
  Please consider installing the Digest::SHA module.

});
            $CPAN::Frontend->mysleep(2);
        }
    } elsif ($mod eq "Module::Signature") {
        # NOT prefs_lookup, we are not a distro
        my $check_sigs = $CPAN::Config->{check_sigs};
        if (not $check_sigs) {
            # they do not want us:-(
        } elsif (not $Have_warned->{"Module::Signature"}++) {
            # No point in complaining unless the user can
            # reasonably install and use it.
            if (eval { require Crypt::OpenPGP; 1 } ||
                (
                 defined $CPAN::Config->{'gpg'}
                 &&
                 $CPAN::Config->{'gpg'} =~ /\S/
                )
               ) {
                $CPAN::Frontend->mywarn(qq{
  CPAN: Module::Signature security checks disabled because Module::Signature
  not installed.  Please consider installing the Module::Signature module.
  You may also need to be able to connect over the Internet to the public
  keyservers like pgp.mit.edu (port 11371).

});
                $CPAN::Frontend->mysleep(2);
            }
        }
    } else {
        delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
    }
    return 0;
}

#-> sub CPAN::instance ;
sub instance {
    my($mgr,$class,$id) = @_;
    CPAN::Index->reload;
    $id ||= "";
    # unsafe meta access, ok?
    return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id};
    $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id);
}

#-> sub CPAN::new ;
sub new {
    bless {}, shift;
}

#-> sub CPAN::cleanup ;
sub cleanup {
  # warn "cleanup called with arg[@_] End[$CPAN::End] Signal[$Signal]";
  local $SIG{__DIE__} = '';
  my($message) = @_;
  my $i = 0;
  my $ineval = 0;
  my($subroutine);
  while ((undef,undef,undef,$subroutine) = caller(++$i)) {
      $ineval = 1, last if
        $subroutine eq '(eval)';
  }
  return if $ineval && !$CPAN::End;
  return unless defined $META->{LOCK};
  return unless -f $META->{LOCK};
  $META->savehist;
  close $META->{LOCKFH};
  unlink $META->{LOCK};
  # require Carp;
  # Carp::cluck("DEBUGGING");
  if ( $CPAN::CONFIG_DIRTY ) {
      $CPAN::Frontend->mywarn("Warning: Configuration not saved.\n");
  }
  $CPAN::Frontend->myprint("Lockfile removed.\n");
}

#-> sub CPAN::readhist
sub readhist {
    my($self,$term,$histfile) = @_;
    my $histsize = $CPAN::Config->{'histsize'} || 100;
    $term->Attribs->{'MaxHistorySize'} = $histsize if (defined($term->Attribs->{'MaxHistorySize'}));
    my($fh) = FileHandle->new;
    open $fh, "<$histfile" or return;
    local $/ = "\n";
    while (<$fh>) {
        chomp;
        $term->AddHistory($_);
    }
    close $fh;
}

#-> sub CPAN::savehist
sub savehist {
    my($self) = @_;
    my($histfile,$histsize);
    unless ($histfile = $CPAN::Config->{'histfile'}) {
        $CPAN::Frontend->mywarn("No history written (no histfile specified).\n");
        return;
    }
    $histsize = $CPAN::Config->{'histsize'} || 100;
    if ($CPAN::term) {
        unless ($CPAN::term->can("GetHistory")) {
            $CPAN::Frontend->mywarn("Terminal does not support GetHistory.\n");
            return;
        }
    } else {
        return;
    }
    my @h = $CPAN::term->GetHistory;
    splice @h, 0, @h-$histsize if @h>$histsize;
    my($fh) = FileHandle->new;
    open $fh, ">$histfile" or $CPAN::Frontend->mydie("Couldn't open >$histfile: $!");
    local $\ = local $, = "\n";
    print $fh @h;
    close $fh;
}

#-> sub CPAN::is_tested
sub is_tested {
    my($self,$what,$when) = @_;
    unless ($what) {
        Carp::cluck("DEBUG: empty what");
        return;
    }
    $self->{is_tested}{$what} = $when;
}

#-> sub CPAN::reset_tested
# forget all distributions tested -- resets what gets included in PERL5LIB
sub reset_tested {
    my ($self) = @_;
    $self->{is_tested} = {};
}

#-> sub CPAN::is_installed
# unsets the is_tested flag: as soon as the thing is installed, it is
# not needed in set_perl5lib anymore
sub is_installed {
    my($self,$what) = @_;
    delete $self->{is_tested}{$what};
}

sub _list_sorted_descending_is_tested {
    my($self) = @_;
    sort
        { ($self->{is_tested}{$b}||0) <=> ($self->{is_tested}{$a}||0) }
            keys %{$self->{is_tested}}
}

#-> sub CPAN::set_perl5lib
# Notes on max environment variable length:
#   - Win32 : XP or later, 8191; Win2000 or NT4, 2047
{
my $fh;
sub set_perl5lib {
    my($self,$for) = @_;
    unless ($for) {
        (undef,undef,undef,$for) = caller(1);
        $for =~ s/.*://;
    }
    $self->{is_tested} ||= {};
    return unless %{$self->{is_tested}};
    my $env = $ENV{PERL5LIB};
    $env = $ENV{PERLLIB} unless defined $env;
    my @env;
    push @env, split /\Q$Config::Config{path_sep}\E/, $env if defined $env and length $env;
    #my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
    #$CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");

    my @dirs = map {("$_/blib/arch", "$_/blib/lib")} $self->_list_sorted_descending_is_tested;
    return if !@dirs;

    if (@dirs < 12) {
        $CPAN::Frontend->optprint('perl5lib', "Prepending @dirs to PERL5LIB for '$for'\n");
        $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
    } elsif (@dirs < 24 ) {
        my @d = map {my $cp = $_;
                     $cp =~ s/^\Q$CPAN::Config->{build_dir}\E/%BUILDDIR%/;
                     $cp
                 } @dirs;
        $CPAN::Frontend->optprint('perl5lib', "Prepending @d to PERL5LIB; ".
                                 "%BUILDDIR%=$CPAN::Config->{build_dir} ".
                                 "for '$for'\n"
                                );
        $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
    } else {
        my $cnt = keys %{$self->{is_tested}};
        $CPAN::Frontend->optprint('perl5lib', "Prepending blib/arch and blib/lib of ".
                                 "$cnt build dirs to PERL5LIB; ".
                                 "for '$for'\n"
                                );
        $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
    }
}}

package CPAN::CacheMgr;
use strict;

#-> sub CPAN::CacheMgr::as_string ;
sub as_string {
    eval { require Data::Dumper };
    if ($@) {
        return shift->SUPER::as_string;
    } else {
        return Data::Dumper::Dumper(shift);
    }
}

#-> sub CPAN::CacheMgr::cachesize ;
sub cachesize {
    shift->{DU};
}

#-> sub CPAN::CacheMgr::tidyup ;
sub tidyup {
  my($self) = @_;
  return unless $CPAN::META->{LOCK};
  return unless -d $self->{ID};
  my @toremove = grep { $self->{SIZE}{$_}==0 } @{$self->{FIFO}};
  for my $current (0..$#toremove) {
    my $toremove = $toremove[$current];
    $CPAN::Frontend->myprint(sprintf(
                                     "DEL(%d/%d): %s \n",
                                     $current+1,
                                     scalar @toremove,
                                     $toremove,
                                    )
                            );
    return if $CPAN::Signal;
    $self->_clean_cache($toremove);
    return if $CPAN::Signal;
  }
}

#-> sub CPAN::CacheMgr::dir ;
sub dir {
    shift->{ID};
}

#-> sub CPAN::CacheMgr::entries ;
sub entries {
    my($self,$dir) = @_;
    return unless defined $dir;
    $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
    $dir ||= $self->{ID};
    my($cwd) = CPAN::anycwd();
    chdir $dir or Carp::croak("Can't chdir to $dir: $!");
    my $dh = DirHandle->new(File::Spec->curdir)
        or Carp::croak("Couldn't opendir $dir: $!");
    my(@entries);
    for ($dh->read) {
        next if $_ eq "." || $_ eq "..";
        if (-f $_) {
            push @entries, File::Spec->catfile($dir,$_);
        } elsif (-d _) {
            push @entries, File::Spec->catdir($dir,$_);
        } else {
            $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
        }
    }
    chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
    sort { -M $a <=> -M $b} @entries;
}

#-> sub CPAN::CacheMgr::disk_usage ;
sub disk_usage {
    my($self,$dir,$fast) = @_;
    return if exists $self->{SIZE}{$dir};
    return if $CPAN::Signal;
    my($Du) = 0;
    if (-e $dir) {
        if (-d $dir) {
            unless (-x $dir) {
                unless (chmod 0755, $dir) {
                    $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
                                            "permission to change the permission; cannot ".
                                            "estimate disk usage of '$dir'\n");
                    $CPAN::Frontend->mysleep(5);
                    return;
                }
            }
        } elsif (-f $dir) {
            # nothing to say, no matter what the permissions
        }
    } else {
        $CPAN::Frontend->mywarn("File or directory '$dir' has gone, ignoring\n");
        return;
    }
    if ($fast) {
        $Du = 0; # placeholder
    } else {
        find(
             sub {
           $File::Find::prune++ if $CPAN::Signal;
           return if -l $_;
           if ($^O eq 'MacOS') {
             require Mac::Files;
             my $cat  = Mac::Files::FSpGetCatInfo($_);
             $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
           } else {
             if (-d _) {
               unless (-x _) {
                 unless (chmod 0755, $_) {
                   $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
                                           "the permission to change the permission; ".
                                           "can only partially estimate disk usage ".
                                           "of '$_'\n");
                   $CPAN::Frontend->mysleep(5);
                   return;
                 }
               }
             } else {
               $Du += (-s _);
             }
           }
         },
         $dir
            );
    }
    return if $CPAN::Signal;
    $self->{SIZE}{$dir} = $Du/1024/1024;
    unshift @{$self->{FIFO}}, $dir;
    $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
    $self->{DU} += $Du/1024/1024;
    $self->{DU};
}

#-> sub CPAN::CacheMgr::_clean_cache ;
sub _clean_cache {
    my($self,$dir) = @_;
    return unless -e $dir;
    unless (File::Spec->canonpath(File::Basename::dirname($dir))
            eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
        $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
                                "will not remove\n");
        $CPAN::Frontend->mysleep(5);
        return;
    }
    $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
        if $CPAN::DEBUG;
    File::Path::rmtree($dir);
    my $id_deleted = 0;
    if ($dir !~ /\.yml$/ && -f "$dir.yml") {
        my $yaml_module = CPAN::_yaml_module;
        if ($CPAN::META->has_inst($yaml_module)) {
            my($peek_yaml) = eval { CPAN->_yaml_loadfile("$dir.yml"); };
            if ($@) {
                $CPAN::Frontend->mywarn("(parse error on '$dir.yml' removing anyway)");
                unlink "$dir.yml" or
                    $CPAN::Frontend->mywarn("(Could not unlink '$dir.yml': $!)");
                return;
            } elsif (my $id = $peek_yaml->[0]{distribution}{ID}) {
                $CPAN::META->delete("CPAN::Distribution", $id);

                # XXX we should restore the state NOW, otherise this
                # distro does not exist until we read an index. BUG ALERT(?)

                # $CPAN::Frontend->mywarn (" +++\n");
                $id_deleted++;
            }
        }
        unlink "$dir.yml"; # may fail
        unless ($id_deleted) {
            CPAN->debug("no distro found associated with '$dir'");
        }
    }
    $self->{DU} -= $self->{SIZE}{$dir};
    delete $self->{SIZE}{$dir};
}

#-> sub CPAN::CacheMgr::new ;
sub new {
    my $class = shift;
    my $time = time;
    my($debug,$t2);
    $debug = "";
    my $self = {
        ID => $CPAN::Config->{build_dir},
        MAX => $CPAN::Config->{'build_cache'},
        SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
        DU => 0
    };
    File::Path::mkpath($self->{ID});
    my $dh = DirHandle->new($self->{ID});
    bless $self, $class;
    $self->scan_cache;
    $t2 = time;
    $debug .= "timing of CacheMgr->new: ".($t2 - $time);
    $time = $t2;
    CPAN->debug($debug) if $CPAN::DEBUG;
    $self;
}

#-> sub CPAN::CacheMgr::scan_cache ;
sub scan_cache {
    my $self = shift;
    return if $self->{SCAN} eq 'never';
    $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
        unless $self->{SCAN} eq 'atstart';
    return unless $CPAN::META->{LOCK};
    $CPAN::Frontend->myprint(
                             sprintf("Scanning cache %s for sizes\n",
                             $self->{ID}));
    my $e;
    my @entries = $self->entries($self->{ID});
    my $i = 0;
    my $painted = 0;
    for $e (@entries) {
        my $symbol = ".";
        if ($self->{DU} > $self->{MAX}) {
            $symbol = "-";
            $self->disk_usage($e,1);
        } else {
            $self->disk_usage($e);
        }
        $i++;
        while (($painted/76) < ($i/@entries)) {
            $CPAN::Frontend->myprint($symbol);
            $painted++;
        }
        return if $CPAN::Signal;
    }
    $CPAN::Frontend->myprint("DONE\n");
    $self->tidyup;
}

package CPAN::Shell;
use strict;

#-> sub CPAN::Shell::h ;
sub h {
    my($class,$about) = @_;
    if (defined $about) {
        my $help;
        if (exists $Help->{$about}) {
            if (ref $Help->{$about}) { # aliases
                $about = ${$Help->{$about}};
            }
            $help = $Help->{$about};
        } else {
            $help = "No help available";
        }
        $CPAN::Frontend->myprint("$about\: $help\n");
    } else {
        my $filler = " " x (80 - 28 - length($CPAN::VERSION));
        $CPAN::Frontend->myprint(qq{
Display Information $filler (ver $CPAN::VERSION)
 command  argument          description
 a,b,d,m  WORD or /REGEXP/  about authors, bundles, distributions, modules
 i        WORD or /REGEXP/  about any of the above
 ls       AUTHOR or GLOB    about files in the author's directory
    (with WORD being a module, bundle or author name or a distribution
    name of the form AUTHOR/DISTRIBUTION)

Download, Test, Make, Install...
 get      download                     clean    make clean
 make     make (implies get)           look     open subshell in dist directory
 test     make test (implies make)     readme   display these README files
 install  make install (implies test)  perldoc  display POD documentation

Upgrade
 r        WORDs or /REGEXP/ or NONE    report updates for some/matching/all modules
 upgrade  WORDs or /REGEXP/ or NONE    upgrade some/matching/all modules

Pragmas
 force  CMD    try hard to do command  fforce CMD    try harder
 notest CMD    skip testing

Other
 h,?           display this menu       ! perl-code   eval a perl command
 o conf [opt]  set and query options   q             quit the cpan shell
 reload cpan   load CPAN.pm again      reload index  load newer indices
 autobundle    Snapshot                recent        latest CPAN uploads});
}
}

*help = \&h;

#-> sub CPAN::Shell::a ;
sub a {
  my($self,@arg) = @_;
  # authors are always UPPERCASE
  for (@arg) {
    $_ = uc $_ unless /=/;
  }
  $CPAN::Frontend->myprint($self->format_result('Author',@arg));
}

#-> sub CPAN::Shell::globls ;
sub globls {
    my($self,$s,$pragmas) = @_;
    # ls is really very different, but we had it once as an ordinary
    # command in the Shell (upto rev. 321) and we could not handle
    # force well then
    my(@accept,@preexpand);
    if ($s =~ /[\*\?\/]/) {
        if ($CPAN::META->has_inst("Text::Glob")) {
            if (my($au,$pathglob) = $s =~ m|(.*?)/(.*)|) {
                my $rau = Text::Glob::glob_to_regex(uc $au);
                CPAN::Shell->debug("au[$au]pathglob[$pathglob]rau[$rau]")
                      if $CPAN::DEBUG;
                push @preexpand, map { $_->id . "/" . $pathglob }
                    CPAN::Shell->expand_by_method('CPAN::Author',['id'],"/$rau/");
            } else {
                my $rau = Text::Glob::glob_to_regex(uc $s);
                push @preexpand, map { $_->id }
                    CPAN::Shell->expand_by_method('CPAN::Author',
                                                  ['id'],
                                                  "/$rau/");
            }
        } else {
            $CPAN::Frontend->mydie("Text::Glob not installed, cannot proceed");
        }
    } else {
        push @preexpand, uc $s;
    }
    for (@preexpand) {
        unless (/^[A-Z0-9\-]+(\/|$)/i) {
            $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author\n");
            next;
        }
        push @accept, $_;
    }
    my $silent = @accept>1;
    my $last_alpha = "";
    my @results;
    for my $a (@accept) {
        my($author,$pathglob);
        if ($a =~ m|(.*?)/(.*)|) {
            my $a2 = $1;
            $pathglob = $2;
            $author = CPAN::Shell->expand_by_method('CPAN::Author',
                                                    ['id'],
                                                    $a2)
                or $CPAN::Frontend->mydie("No author found for $a2\n");
        } else {
            $author = CPAN::Shell->expand_by_method('CPAN::Author',
                                                    ['id'],
                                                    $a)
                or $CPAN::Frontend->mydie("No author found for $a\n");
        }
        if ($silent) {
            my $alpha = substr $author->id, 0, 1;
            my $ad;
            if ($alpha eq $last_alpha) {
                $ad = "";
            } else {
                $ad = "[$alpha]";
                $last_alpha = $alpha;
            }
            $CPAN::Frontend->myprint($ad);
        }
        for my $pragma (@$pragmas) {
            if ($author->can($pragma)) {
                $author->$pragma();
            }
        }
        push @results, $author->ls($pathglob,$silent); # silent if
                                                       # more than one
                                                       # author
        for my $pragma (@$pragmas) {
            my $unpragma = "un$pragma";
            if ($author->can($unpragma)) {
                $author->$unpragma();
            }
        }
    }
    @results;
}

#-> sub CPAN::Shell::local_bundles ;
sub local_bundles {
    my($self,@which) = @_;
    my($incdir,$bdir,$dh);
    foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
        my @bbase = "Bundle";
        while (my $bbase = shift @bbase) {
            $bdir = File::Spec->catdir($incdir,split /::/, $bbase);
            CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG;
            if ($dh = DirHandle->new($bdir)) { # may fail
                my($entry);
                for $entry ($dh->read) {
                    next if $entry =~ /^\./;
                    next unless $entry =~ /^\w+(\.pm)?(?!\n)\Z/;
                    if (-d File::Spec->catdir($bdir,$entry)) {
                        push @bbase, "$bbase\::$entry";
                    } else {
                        next unless $entry =~ s/\.pm(?!\n)\Z//;
                        $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry");
                    }
                }
            }
        }
    }
}

#-> sub CPAN::Shell::b ;
sub b {
    my($self,@which) = @_;
    CPAN->debug("which[@which]") if $CPAN::DEBUG;
    $self->local_bundles;
    $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
}

#-> sub CPAN::Shell::d ;
sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}

#-> sub CPAN::Shell::m ;
sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
    my $self = shift;
    $CPAN::Frontend->myprint($self->format_result('Module',@_));
}

#-> sub CPAN::Shell::i ;
sub i {
    my($self) = shift;
    my(@args) = @_;
    @args = '/./' unless @args;
    my(@result);
    for my $type (qw/Bundle Distribution Module/) {
        push @result, $self->expand($type,@args);
    }
    # Authors are always uppercase.
    push @result, $self->expand("Author", map { uc $_ } @args);

    my $result = @result == 1 ?
        $result[0]->as_string :
            @result == 0 ?
                "No objects found of any type for argument @args\n" :
                    join("",
                         (map {$_->as_glimpse} @result),
                         scalar @result, " items found\n",
                        );
    $CPAN::Frontend->myprint($result);
}

#-> sub CPAN::Shell::o ;

# CPAN::Shell::o and CPAN::HandleConfig::edit are closely related. 'o
# conf' calls through to CPAN::HandleConfig::edit. 'o conf' should
# probably have been called 'set' and 'o debug' maybe 'set debug' or
# 'debug'; 'o conf ARGS' calls ->edit in CPAN/HandleConfig.pm
sub o {
    my($self,$o_type,@o_what) = @_;
    $o_type ||= "";
    CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
    if ($o_type eq 'conf') {
        my($cfilter);
        ($cfilter) = $o_what[0] =~ m|^/(.*)/$| if @o_what;
        if (!@o_what or $cfilter) { # print all things, "o conf"
            $cfilter ||= "";
            my $qrfilter = eval 'qr/$cfilter/';
            my($k,$v);
            $CPAN::Frontend->myprint("\$CPAN::Config options from ");
            my @from;
            if (exists $INC{'CPAN/Config.pm'}) {
                push @from, $INC{'CPAN/Config.pm'};
            }
            if (exists $INC{'CPAN/MyConfig.pm'}) {
                push @from, $INC{'CPAN/MyConfig.pm'};
            }
            $CPAN::Frontend->myprint(join " and ", map {"'$_'"} @from);
            $CPAN::Frontend->myprint(":\n");
            for $k (sort keys %CPAN::HandleConfig::can) {
                next unless $k =~ /$qrfilter/;
                $v = $CPAN::HandleConfig::can{$k};
                $CPAN::Frontend->myprint(sprintf "    %-18s [%s]\n", $k, $v);
            }
            $CPAN::Frontend->myprint("\n");
            for $k (sort keys %CPAN::HandleConfig::keys) {
                next unless $k =~ /$qrfilter/;
                CPAN::HandleConfig->prettyprint($k);
            }
            $CPAN::Frontend->myprint("\n");
        } else {
            if (CPAN::HandleConfig->edit(@o_what)) {
            } else {
                $CPAN::Frontend->myprint(qq{Type 'o conf' to view all configuration }.
                                         qq{items\n\n});
            }
        }
    } elsif ($o_type eq 'debug') {
        my(%valid);
        @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
        if (@o_what) {
            while (@o_what) {
                my($what) = shift @o_what;
                if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) {
                    $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what};
                    next;
                }
                if ( exists $CPAN::DEBUG{$what} ) {
                    $CPAN::DEBUG |= $CPAN::DEBUG{$what};
                } elsif ($what =~ /^\d/) {
                    $CPAN::DEBUG = $what;
                } elsif (lc $what eq 'all') {
                    my($max) = 0;
                    for (values %CPAN::DEBUG) {
                        $max += $_;
                    }
                    $CPAN::DEBUG = $max;
                } else {
                    my($known) = 0;
                    for (keys %CPAN::DEBUG) {
                        next unless lc($_) eq lc($what);
                        $CPAN::DEBUG |= $CPAN::DEBUG{$_};
                        $known = 1;
                    }
                    $CPAN::Frontend->myprint("unknown argument [$what]\n")
                        unless $known;
                }
            }
        } else {
            my $raw = "Valid options for debug are ".
                join(", ",sort(keys %CPAN::DEBUG), 'all').
                     qq{ or a number. Completion works on the options. }.
                     qq{Case is ignored.};
            require Text::Wrap;
            $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw));
            $CPAN::Frontend->myprint("\n\n");
        }
        if ($CPAN::DEBUG) {
            $CPAN::Frontend->myprint("Options set for debugging ($CPAN::DEBUG):\n");
            my($k,$v);
            for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
                $v = $CPAN::DEBUG{$k};
                $CPAN::Frontend->myprint(sprintf "    %-14s(%s)\n", $k, $v)
                    if $v & $CPAN::DEBUG;
            }
        } else {
            $CPAN::Frontend->myprint("Debugging turned off completely.\n");
        }
    } else {
        $CPAN::Frontend->myprint(qq{
Known options:
  conf    set or get configuration variables
  debug   set or get debugging options
});
    }
}

# CPAN::Shell::paintdots_onreload
sub paintdots_onreload {
    my($ref) = shift;
    sub {
        if ( $_[0] =~ /[Ss]ubroutine ([\w:]+) redefined/ ) {
            my($subr) = $1;
            ++$$ref;
            local($|) = 1;
            # $CPAN::Frontend->myprint(".($subr)");
            $CPAN::Frontend->myprint(".");
            if ($subr =~ /\bshell\b/i) {
                # warn "debug[$_[0]]";

                # It would be nice if we could detect that a
                # subroutine has actually changed, but for now we
                # practically always set the GOTOSHELL global

                $CPAN::GOTOSHELL=1;
            }
            return;
        }
        warn @_;
    };
}

#-> sub CPAN::Shell::hosts ;
sub hosts {
    my($self) = @_;
    my $fullstats = CPAN::FTP->_ftp_statistics();
    my $history = $fullstats->{history} || [];
    my %S; # statistics
    while (my $last = pop @$history) {
        my $attempts = $last->{attempts} or next;
        my $start;
        if (@$attempts) {
            $start = $attempts->[-1]{start};
            if ($#$attempts > 0) {
                for my $i (0..$#$attempts-1) {
                    my $url = $attempts->[$i]{url} or next;
                    $S{no}{$url}++;
                }
            }
        } else {
            $start = $last->{start};
        }
        next unless $last->{thesiteurl}; # C-C? bad filenames?
        $S{start} = $start;
        $S{end} ||= $last->{end};
        my $dltime = $last->{end} - $start;
        my $dlsize = $last->{filesize} || 0;
        my $url = ref $last->{thesiteurl} ? $last->{thesiteurl}->text : $last->{thesiteurl};
        my $s = $S{ok}{$url} ||= {};
        $s->{n}++;
        $s->{dlsize} ||= 0;
        $s->{dlsize} += $dlsize/1024;
        $s->{dltime} ||= 0;
        $s->{dltime} += $dltime;
    }
    my $res;
    for my $url (keys %{$S{ok}}) {
        next if $S{ok}{$url}{dltime} == 0; # div by zero
        push @{$res->{ok}}, [@{$S{ok}{$url}}{qw(n dlsize dltime)},
                             $S{ok}{$url}{dlsize}/$S{ok}{$url}{dltime},
                             $url,
                            ];
    }
    for my $url (keys %{$S{no}}) {
        push @{$res->{no}}, [$S{no}{$url},
                             $url,
                            ];
    }
    my $R = ""; # report
    if ($S{start} && $S{end}) {
        $R .= sprintf "Log starts: %s\n", $S{start} ? scalar(localtime $S{start}) : "unknown";
        $R .= sprintf "Log ends  : %s\n", $S{end}   ? scalar(localtime $S{end})   : "unknown";
    }
    if ($res->{ok} && @{$res->{ok}}) {
        $R .= sprintf "\nSuccessful downloads:
   N       kB  secs      kB/s url\n";
        my $i = 20;
        for (sort { $b->[3] <=> $a->[3] } @{$res->{ok}}) {
            $R .= sprintf "%4d %8d %5d %9.1f %s\n", @$_;
            last if --$i<=0;
        }
    }
    if ($res->{no} && @{$res->{no}}) {
        $R .= sprintf "\nUnsuccessful downloads:\n";
        my $i = 20;
        for (sort { $b->[0] <=> $a->[0] } @{$res->{no}}) {
            $R .= sprintf "%4d %s\n", @$_;
            last if --$i<=0;
        }
    }
    $CPAN::Frontend->myprint($R);
}

# here is where 'reload cpan' is done
#-> sub CPAN::Shell::reload ;
sub reload {
    my($self,$command,@arg) = @_;
    $command ||= "";
    $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
    if ($command =~ /^cpan$/i) {
        my $redef = 0;
        chdir $CPAN::iCwd if $CPAN::iCwd; # may fail
        my $failed;
      MFILE: for my $f (@relo) {
            next unless exists $INC{$f};
            my $p = $f;
            $p =~ s/\.pm$//;
            $p =~ s|/|::|g;
            $CPAN::Frontend->myprint("($p");
            local($SIG{__WARN__}) = paintdots_onreload(\$redef);
            $self->_reload_this($f) or $failed++;
            my $v = eval "$p\::->VERSION";
            $CPAN::Frontend->myprint("v$v)");
        }
        $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
        if ($failed) {
            my $errors = $failed == 1 ? "error" : "errors";
            $CPAN::Frontend->mywarn("\n$failed $errors during reload. You better quit ".
                                    "this session.\n");
        }
    } elsif ($command =~ /^index$/i) {
      CPAN::Index->force_reload;
    } else {
      $CPAN::Frontend->myprint(qq{cpan     re-evals the CPAN modules
index    re-reads the index files\n});
    }
}

# reload means only load again what we have loaded before
#-> sub CPAN::Shell::_reload_this ;
sub _reload_this {
    my($self,$f,$args) = @_;
    CPAN->debug("f[$f]") if $CPAN::DEBUG;
    return 1 unless $INC{$f}; # we never loaded this, so we do not
                              # reload but say OK
    my $pwd = CPAN::anycwd();
    CPAN->debug("pwd[$pwd]") if $CPAN::DEBUG;
    my($file);
    for my $inc (@INC) {
        $file = File::Spec->catfile($inc,split /\//, $f);
        last if -f $file;
        $file = "";
    }
    CPAN->debug("file[$file]") if $CPAN::DEBUG;
    my @inc = @INC;
    unless ($file && -f $file) {
        # this thingie is not in the INC path, maybe CPAN/MyConfig.pm?
        $file = $INC{$f};
        unless (CPAN->has_inst("File::Basename")) {
            @inc = File::Basename::dirname($file);
        } else {
            # do we ever need this?
            @inc = substr($file,0,-length($f)-1); # bring in back to me!
        }
    }
    CPAN->debug("file[$file]inc[@inc]") if $CPAN::DEBUG;
    unless (-f $file) {
        $CPAN::Frontend->mywarn("Found no file to reload for '$f'\n");
        return;
    }
    my $mtime = (stat $file)[9];
    $reload->{$f} ||= -1;
    my $must_reload = $mtime != $reload->{$f};
    $args ||= {};
    $must_reload ||= $args->{reloforce}; # o conf defaults needs this
    if ($must_reload) {
        my $fh = FileHandle->new($file) or
            $CPAN::Frontend->mydie("Could not open $file: $!");
        local($/);
        local $^W = 1;
        my $content = <$fh>;
        CPAN->debug(sprintf("reload file[%s] content[%s...]",$file,substr($content,0,128)))
            if $CPAN::DEBUG;
        delete $INC{$f};
        local @INC = @inc;
        eval "require '$f'";
        if ($@) {
            warn $@;
            return;
        }
        $reload->{$f} = $mtime;
    } else {
        $CPAN::Frontend->myprint("__unchanged__");
    }
    return 1;
}

#-> sub CPAN::Shell::mkmyconfig ;
sub mkmyconfig {
    my($self, $cpanpm, %args) = @_;
    require CPAN::FirstTime;
    my $home = CPAN::HandleConfig::home;
    $cpanpm = $INC{'CPAN/MyConfig.pm'} ||
        File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm");
    File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm;
    CPAN::HandleConfig::require_myconfig_or_config;
    $CPAN::Config ||= {};
    $CPAN::Config = {
        %$CPAN::Config,
        build_dir           =>  undef,
        cpan_home           =>  undef,
        keep_source_where   =>  undef,
        histfile            =>  undef,
    };
    CPAN::FirstTime::init($cpanpm, %args);
}

#-> sub CPAN::Shell::_binary_extensions ;
sub _binary_extensions {
    my($self) = shift @_;
    my(@result,$module,%seen,%need,$headerdone);
    for $module ($self->expand('Module','/./')) {
        my $file  = $module->cpan_file;
        next if $file eq "N/A";
        next if $file =~ /^Contact Author/;
        my $dist = $CPAN::META->instance('CPAN::Distribution',$file);
        next if $dist->isa_perl;
        next unless $module->xs_file;
        local($|) = 1;
        $CPAN::Frontend->myprint(".");
        push @result, $module;
    }
#    print join " | ", @result;
    $CPAN::Frontend->myprint("\n");
    return @result;
}

#-> sub CPAN::Shell::recompile ;
sub recompile {
    my($self) = shift @_;
    my($module,@module,$cpan_file,%dist);
    @module = $self->_binary_extensions();
    for $module (@module) { # we force now and compile later, so we
                            # don't do it twice
        $cpan_file = $module->cpan_file;
        my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
        $pack->force;
        $dist{$cpan_file}++;
    }
    for $cpan_file (sort keys %dist) {
        $CPAN::Frontend->myprint("  CPAN: Recompiling $cpan_file\n\n");
        my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
        $pack->install;
        $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
                           # stop a package from recompiling,
                           # e.g. IO-1.12 when we have perl5.003_10
    }
}

#-> sub CPAN::Shell::scripts ;
sub scripts {
    my($self, $arg) = @_;
    $CPAN::Frontend->mywarn(">>>> experimental command, currently unsupported <<<<\n\n");

    for my $req (qw( HTML::LinkExtor Sort::Versions List::Util )) {
        unless ($CPAN::META->has_inst($req)) {
            $CPAN::Frontend->mywarn("  $req not available\n");
        }
    }
    my $p = HTML::LinkExtor->new();
    my $indexfile = "/home/ftp/pub/PAUSE/scripts/new/index.html";
    unless (-f $indexfile) {
        $CPAN::Frontend->mydie("found no indexfile[$indexfile]\n");
    }
    $p->parse_file($indexfile);
    my @hrefs;
    my $qrarg;
    if ($arg =~ s|^/(.+)/$|$1|) {
        $qrarg = eval 'qr/$arg/'; # hide construct from 5.004
    }
    for my $l ($p->links) {
        my $tag = shift @$l;
        next unless $tag eq "a";
        my %att = @$l;
        my $href = $att{href};
        next unless $href =~ s|^\.\./authors/id/./../||;
        if ($arg) {
            if ($qrarg) {
                if ($href =~ $qrarg) {
                    push @hrefs, $href;
                }
            } else {
                if ($href =~ /\Q$arg\E/) {
                    push @hrefs, $href;
                }
            }
        } else {
            push @hrefs, $href;
        }
    }
    # now filter for the latest version if there is more than one of a name
    my %stems;
    for (sort @hrefs) {
        my $href = $_;
        s/-v?\d.*//;
        my $stem = $_;
        $stems{$stem} ||= [];
        push @{$stems{$stem}}, $href;
    }
    for (sort keys %stems) {
        my $highest;
        if (@{$stems{$_}} > 1) {
            $highest = List::Util::reduce {
                Sort::Versions::versioncmp($a,$b) > 0 ? $a : $b
              } @{$stems{$_}};
        } else {
            $highest = $stems{$_}[0];
        }
        $CPAN::Frontend->myprint("$highest\n");
    }
}

#-> sub CPAN::Shell::report ;
sub report {
    my($self,@args) = @_;
    unless ($CPAN::META->has_inst("CPAN::Reporter")) {
        $CPAN::Frontend->mydie("CPAN::Reporter not installed; cannot continue");
    }
    local $CPAN::Config->{test_report} = 1;
    $self->force("test",@args); # force is there so that the test be
                                # re-run (as documented)
}

# compare with is_tested
#-> sub CPAN::Shell::install_tested
sub install_tested {
    my($self,@some) = @_;
    $CPAN::Frontend->mywarn("install_tested() must not be called with arguments.\n"),
        return if @some;
    CPAN::Index->reload;

    for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) {
        my $yaml = "$b.yml";
        unless (-f $yaml) {
            $CPAN::Frontend->mywarn("No YAML file for $b available, skipping\n");
            next;
        }
        my $yaml_content = CPAN->_yaml_loadfile($yaml);
        my $id = $yaml_content->[0]{distribution}{ID};
        unless ($id) {
            $CPAN::Frontend->mywarn("No ID found in '$yaml', skipping\n");
            next;
        }
        my $do = CPAN::Shell->expandany($id);
        unless ($do) {
            $CPAN::Frontend->mywarn("Could not expand ID '$id', skipping\n");
            next;
        }
        unless ($do->{build_dir}) {
            $CPAN::Frontend->mywarn("Distro '$id' has no build_dir, skipping\n");
            next;
        }
        unless ($do->{build_dir} eq $b) {
            $CPAN::Frontend->mywarn("Distro '$id' has build_dir '$do->{build_dir}' but expected '$b', skipping\n");
            next;
        }
        push @some, $do;
    }

    $CPAN::Frontend->mywarn("No tested distributions found.\n"),
        return unless @some;

    @some = grep { $_->{make_test} && ! $_->{make_test}->failed } @some;
    $CPAN::Frontend->mywarn("No distributions tested with this build of perl found.\n"),
        return unless @some;

    # @some = grep { not $_->uptodate } @some;
    # $CPAN::Frontend->mywarn("No non-uptodate distributions tested with this build of perl found.\n"),
    #     return unless @some;

    CPAN->debug("some[@some]");
    for my $d (@some) {
        my $id = $d->can("pretty_id") ? $d->pretty_id : $d->id;
        $CPAN::Frontend->myprint("install_tested: Running for $id\n");
        $CPAN::Frontend->mysleep(1);
        $self->install($d);
    }
}

#-> sub CPAN::Shell::upgrade ;
sub upgrade {
    my($self,@args) = @_;
    $self->install($self->r(@args));
}

#-> sub CPAN::Shell::_u_r_common ;
sub _u_r_common {
    my($self) = shift @_;
    my($what) = shift @_;
    CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
    Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless
          $what && $what =~ /^[aru]$/;
    my(@args) = @_;
    @args = '/./' unless @args;
    my(@result,$module,%seen,%need,$headerdone,
       $version_undefs,$version_zeroes,
       @version_undefs,@version_zeroes);
    $version_undefs = $version_zeroes = 0;
    my $sprintf = "%s%-25s%s %9s %9s  %s\n";
    my @expand = $self->expand('Module',@args);
    if ($CPAN::DEBUG) { # Looks like noise to me, was very useful for debugging
             # for metadata cache
        my $expand = scalar @expand;
        $CPAN::Frontend->myprint(sprintf "%d matches in the database, time[%d]\n", $expand, time);
    }
    my @sexpand;
    if ($] < 5.008) {
        # hard to believe that the more complex sorting can lead to
        # stack curruptions on older perl
        @sexpand = sort {$a->id cmp $b->id} @expand;
    } else {
        @sexpand = map {
            $_->[1]
        } sort {
            $b->[0] <=> $a->[0]
            ||
            $a->[1]{ID} cmp $b->[1]{ID},
        } map {
            [$_->_is_representative_module,
             $_
            ]
        } @expand;
    }
    if ($CPAN::DEBUG) {
        $CPAN::Frontend->myprint(sprintf "sorted at time[%d]\n", time);
        sleep 1;
    }
  MODULE: for $module (@sexpand) {
        my $file  = $module->cpan_file;
        next MODULE unless defined $file; # ??
        $file =~ s!^./../!!;
        my($latest) = $module->cpan_version;
        my($inst_file) = $module->inst_file;
        CPAN->debug("file[$file]latest[$latest]") if $CPAN::DEBUG;
        my($have);
        return if $CPAN::Signal;
        my($next_MODULE);
        eval { # version.pm involved!
            if ($inst_file) {
                if ($what eq "a") {
                    $have = $module->inst_version;
                } elsif ($what eq "r") {
                    $have = $module->inst_version;
                    local($^W) = 0;
                    if ($have eq "undef") {
                        $version_undefs++;
                        push @version_undefs, $module->as_glimpse;
                    } elsif (CPAN::Version->vcmp($have,0)==0) {
                        $version_zeroes++;
                        push @version_zeroes, $module->as_glimpse;
                    }
                    ++$next_MODULE unless CPAN::Version->vgt($latest, $have);
                    # to be pedantic we should probably say:
                    #    && !($have eq "undef" && $latest ne "undef" && $latest gt "");
                    # to catch the case where CPAN has a version 0 and we have a version undef
                } elsif ($what eq "u") {
                    ++$next_MODULE;
                }
            } else {
                if ($what eq "a") {
                    ++$next_MODULE;
                } elsif ($what eq "r") {
                    ++$next_MODULE;
                } elsif ($what eq "u") {
                    $have = "-";
                }
            }
        };
        next MODULE if $next_MODULE;
        if ($@) {
            $CPAN::Frontend->mywarn
                (sprintf("Error while comparing cpan/installed versions of '%s':
INST_FILE: %s
INST_VERSION: %s %s
CPAN_VERSION: %s %s
",
                         $module->id,
                         $inst_file || "",
                         (defined $have ? $have : "[UNDEFINED]"),
                         (ref $have ? ref $have : ""),
                         $latest,
                         (ref $latest ? ref $latest : ""),
                        ));
            next MODULE;
        }
        return if $CPAN::Signal; # this is sometimes lengthy
        $seen{$file} ||= 0;
        if ($what eq "a") {
            push @result, sprintf "%s %s\n", $module->id, $have;
        } elsif ($what eq "r") {
            push @result, $module->id;
            next MODULE if $seen{$file}++;
        } elsif ($what eq "u") {
            push @result, $module->id;
            next MODULE if $seen{$file}++;
            next MODULE if $file =~ /^Contact/;
        }
        unless ($headerdone++) {
            $CPAN::Frontend->myprint("\n");
            $CPAN::Frontend->myprint(sprintf(
                                             $sprintf,
                                             "",
                                             "Package namespace",
                                             "",
                                             "installed",
                                             "latest",
                                             "in CPAN file"
                                            ));
        }
        my $color_on = "";
        my $color_off = "";
        if (
            $COLOR_REGISTERED
            &&
            $CPAN::META->has_inst("Term::ANSIColor")
            &&
            $module->description
           ) {
            $color_on = Term::ANSIColor::color("green");
            $color_off = Term::ANSIColor::color("reset");
        }
        $CPAN::Frontend->myprint(sprintf $sprintf,
                                 $color_on,
                                 $module->id,
                                 $color_off,
                                 $have,
                                 $latest,
                                 $file);
        $need{$module->id}++;
    }
    unless (%need) {
        if ($what eq "u") {
            $CPAN::Frontend->myprint("No modules found for @args\n");
        } elsif ($what eq "r") {
            $CPAN::Frontend->myprint("All modules are up to date for @args\n");
        }
    }
    if ($what eq "r") {
        if ($version_zeroes) {
            my $s_has = $version_zeroes > 1 ? "s have" : " has";
            $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
                                     qq{a version number of 0\n});
            if ($CPAN::Config->{show_zero_versions}) {
                local $" = "\t";
                $CPAN::Frontend->myprint(qq{  they are\n\t@version_zeroes\n});
                $CPAN::Frontend->myprint(qq{(use 'o conf show_zero_versions 0' }.
                                         qq{to hide them)\n});
            } else {
                $CPAN::Frontend->myprint(qq{(use 'o conf show_zero_versions 1' }.
                                         qq{to show them)\n});
            }
        }
        if ($version_undefs) {
            my $s_has = $version_undefs > 1 ? "s have" : " has";
            $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
                                     qq{parseable version number\n});
            if ($CPAN::Config->{show_unparsable_versions}) {
                local $" = "\t";
                $CPAN::Frontend->myprint(qq{  they are\n\t@version_undefs\n});
                $CPAN::Frontend->myprint(qq{(use 'o conf show_unparsable_versions 0' }.
                                         qq{to hide them)\n});
            } else {
                $CPAN::Frontend->myprint(qq{(use 'o conf show_unparsable_versions 1' }.
                                         qq{to show them)\n});
            }
        }
    }
    @result;
}

#-> sub CPAN::Shell::r ;
sub r {
    shift->_u_r_common("r",@_);
}

#-> sub CPAN::Shell::u ;
sub u {
    shift->_u_r_common("u",@_);
}

#-> sub CPAN::Shell::failed ;
sub failed {
    my($self,$only_id,$silent) = @_;
    my @failed;
  DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) {
        my $failed = "";
      NAY: for my $nosayer ( # order matters!
                            "unwrapped",
                            "writemakefile",
                            "signature_verify",
                            "make",
                            "make_test",
                            "install",
                            "make_clean",
                           ) {
            next unless exists $d->{$nosayer};
            next unless defined $d->{$nosayer};
            next unless (
                         UNIVERSAL::can($d->{$nosayer},"failed") ?
                         $d->{$nosayer}->failed :
                         $d->{$nosayer} =~ /^NO/
                        );
            next NAY if $only_id && $only_id != (
                                                 UNIVERSAL::can($d->{$nosayer},"commandid")
                                                 ?
                                                 $d->{$nosayer}->commandid
                                                 :
                                                 $CPAN::CurrentCommandId
                                                );
            $failed = $nosayer;
            last;
        }
        next DIST unless $failed;
        my $id = $d->id;
        $id =~ s|^./../||;
        #$print .= sprintf(
        #                  "  %-45s: %s %s\n",
        push @failed,
            (
             UNIVERSAL::can($d->{$failed},"failed") ?
             [
              $d->{$failed}->commandid,
              $id,
              $failed,
              $d->{$failed}->text,
              $d->{$failed}{TIME}||0,
             ] :
             [
              1,
              $id,
              $failed,
              $d->{$failed},
              0,
             ]
            );
    }
    my $scope;
    if ($only_id) {
        $scope = "this command";
    } elsif ($CPAN::Index::HAVE_REANIMATED) {
        $scope = "this or a previous session";
        # it might be nice to have a section for previous session and
        # a second for this
    } else {
        $scope = "this session";
    }
    if (@failed) {
        my $print;
        my $debug = 0;
        if ($debug) {
            $print = join "",
                map { sprintf "%5d %-45s: %s %s\n", @$_ }
                    sort { $a->[0] <=> $b->[0] } @failed;
        } else {
            $print = join "",
                map { sprintf " %-45s: %s %s\n", @$_[1..3] }
                    sort {
                        $a->[0] <=> $b->[0]
                            ||
                                $a->[4] <=> $b->[4]
                       } @failed;
        }
        $CPAN::Frontend->myprint("Failed during $scope:\n$print");
    } elsif (!$only_id || !$silent) {
        $CPAN::Frontend->myprint("Nothing failed in $scope\n");
    }
}

# XXX intentionally undocumented because completely bogus, unportable,
# useless, etc.

#-> sub CPAN::Shell::status ;
sub status {
    my($self) = @_;
    require Devel::Size;
    my $ps = FileHandle->new;
    open $ps, "/proc/$$/status";
    my $vm = 0;
    while (<$ps>) {
        next unless /VmSize:\s+(\d+)/;
        $vm = $1;
        last;
    }
    $CPAN::Frontend->mywarn(sprintf(
                                    "%-27s %6d\n%-27s %6d\n",
                                    "vm",
                                    $vm,
                                    "CPAN::META",
                                    Devel::Size::total_size($CPAN::META)/1024,
                                   ));
    for my $k (sort keys %$CPAN::META) {
        next unless substr($k,0,4) eq "read";
        warn sprintf " %-26s %6d\n", $k, Devel::Size::total_size($CPAN::META->{$k})/1024;
        for my $k2 (sort keys %{$CPAN::META->{$k}}) {
            warn sprintf "  %-25s %6d (keys: %6d)\n",
                $k2,
                    Devel::Size::total_size($CPAN::META->{$k}{$k2})/1024,
                          scalar keys %{$CPAN::META->{$k}{$k2}};
        }
    }
}

# compare with install_tested
#-> sub CPAN::Shell::is_tested
sub is_tested {
    my($self) = @_;
    CPAN::Index->reload;
    for my $b (reverse $CPAN::META->_list_sorted_descending_is_tested) {
        my $time;
        if ($CPAN::META->{is_tested}{$b}) {
            $time = scalar(localtime $CPAN::META->{is_tested}{$b});
        } else {
            $time = scalar localtime;
            $time =~ s/\S/?/g;
        }
        $CPAN::Frontend->myprint(sprintf "%s %s\n", $time, $b);
    }
}

#-> sub CPAN::Shell::autobundle ;
sub autobundle {
    my($self) = shift;
    CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
    my(@bundle) = $self->_u_r_common("a",@_);
    my($todir) = File::Spec->catdir($CPAN::Config->{'cpan_home'},"Bundle");
    File::Path::mkpath($todir);
    unless (-d $todir) {
        $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
        return;
    }
    my($y,$m,$d) =  (localtime)[5,4,3];
    $y+=1900;
    $m++;
    my($c) = 0;
    my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
    my($to) = File::Spec->catfile($todir,"$me.pm");
    while (-f $to) {
        $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
        $to = File::Spec->catfile($todir,"$me.pm");
    }
    my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
    $fh->print(
               "package Bundle::$me;\n\n",
               "\$VERSION = '0.01';\n\n",
               "1;\n\n",
               "__END__\n\n",
               "=head1 NAME\n\n",
               "Bundle::$me - Snapshot of installation on ",
               $Config::Config{'myhostname'},
               " on ",
               scalar(localtime),
               "\n\n=head1 SYNOPSIS\n\n",
               "perl -MCPAN -e 'install Bundle::$me'\n\n",
               "=head1 CONTENTS\n\n",
               join("\n", @bundle),
               "\n\n=head1 CONFIGURATION\n\n",
               Config->myconfig,
               "\n\n=head1 AUTHOR\n\n",
               "This Bundle has been generated automatically ",
               "by the autobundle routine in CPAN.pm.\n",
              );
    $fh->close;
    $CPAN::Frontend->myprint("\nWrote bundle file
    $to\n\n");
}

#-> sub CPAN::Shell::expandany ;
sub expandany {
    my($self,$s) = @_;
    CPAN->debug("s[$s]") if $CPAN::DEBUG;
    if ($s =~ m|/| or substr($s,-1,1) eq ".") { # looks like a file or a directory
        $s = CPAN::Distribution->normalize($s);
        return $CPAN::META->instance('CPAN::Distribution',$s);
        # Distributions spring into existence, not expand
    } elsif ($s =~ m|^Bundle::|) {
        $self->local_bundles; # scanning so late for bundles seems
                              # both attractive and crumpy: always
                              # current state but easy to forget
                              # somewhere
        return $self->expand('Bundle',$s);
    } else {
        return $self->expand('Module',$s)
            if $CPAN::META->exists('CPAN::Module',$s);
    }
    return;
}

#-> sub CPAN::Shell::expand ;
sub expand {
    my $self = shift;
    my($type,@args) = @_;
    CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG;
    my $class = "CPAN::$type";
    my $methods = ['id'];
    for my $meth (qw(name)) {
        next unless $class->can($meth);
        push @$methods, $meth;
    }
    $self->expand_by_method($class,$methods,@args);
}

#-> sub CPAN::Shell::expand_by_method ;
sub expand_by_method {
    my $self = shift;
    my($class,$methods,@args) = @_;
    my($arg,@m);
    for $arg (@args) {
        my($regex,$command);
        if ($arg =~ m|^/(.*)/$|) {
            $regex = $1;
# FIXME:  there seem to be some ='s in the author data, which trigger
#         a failure here.  This needs to be contemplated.
#            } elsif ($arg =~ m/=/) {
#                $command = 1;
        }
        my $obj;
        CPAN->debug(sprintf "class[%s]regex[%s]command[%s]",
                    $class,
                    defined $regex ? $regex : "UNDEFINED",
                    defined $command ? $command : "UNDEFINED",
                   ) if $CPAN::DEBUG;
        if (defined $regex) {
            if (CPAN::_sqlite_running) {
                CPAN::Index->reload;
                $CPAN::SQLite->search($class, $regex);
            }
            for $obj (
                      $CPAN::META->all_objects($class)
                     ) {
                unless ($obj && UNIVERSAL::can($obj,"id") && $obj->id) {
                    # BUG, we got an empty object somewhere
                    require Data::Dumper;
                    CPAN->debug(sprintf(
                                        "Bug in CPAN: Empty id on obj[%s][%s]",
                                        $obj,
                                        Data::Dumper::Dumper($obj)
                                       )) if $CPAN::DEBUG;
                    next;
                }
                for my $method (@$methods) {
                    my $match = eval {$obj->$method() =~ /$regex/i};
                    if ($@) {
                        my($err) = $@ =~ /^(.+) at .+? line \d+\.$/;
                        $err ||= $@; # if we were too restrictive above
                        $CPAN::Frontend->mydie("$err\n");
                    } elsif ($match) {
                        push @m, $obj;
                        last;
                    }
                }
            }
        } elsif ($command) {
            die "equal sign in command disabled (immature interface), ".
                "you can set
 ! \$CPAN::Shell::ADVANCED_QUERY=1
to enable it. But please note, this is HIGHLY EXPERIMENTAL code
that may go away anytime.\n"
                    unless $ADVANCED_QUERY;
            my($method,$criterion) = $arg =~ /(.+?)=(.+)/;
            my($matchcrit) = $criterion =~ m/^~(.+)/;
            for my $self (
                          sort
                          {$a->id cmp $b->id}
                          $CPAN::META->all_objects($class)
                         ) {
                my $lhs = $self->$method() or next; # () for 5.00503
                if ($matchcrit) {
                    push @m, $self if $lhs =~ m/$matchcrit/;
                } else {
                    push @m, $self if $lhs eq $criterion;
                }
            }
        } else {
            my($xarg) = $arg;
            if ( $class eq 'CPAN::Bundle' ) {
                $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
            } elsif ($class eq "CPAN::Distribution") {
                $xarg = CPAN::Distribution->normalize($arg);
            } else {
                $xarg =~ s/:+/::/g;
            }
            if ($CPAN::META->exists($class,$xarg)) {
                $obj = $CPAN::META->instance($class,$xarg);
            } elsif ($CPAN::META->exists($class,$arg)) {
                $obj = $CPAN::META->instance($class,$arg);
            } else {
                next;
            }
            push @m, $obj;
        }
    }
    @m = sort {$a->id cmp $b->id} @m;
    if ( $CPAN::DEBUG ) {
        my $wantarray = wantarray;
        my $join_m = join ",", map {$_->id} @m;
        # $self->debug("wantarray[$wantarray]join_m[$join_m]");
        my $count = scalar @m;
        $self->debug("class[$class]wantarray[$wantarray]count m[$count]");
    }
    return wantarray ? @m : $m[0];
}

#-> sub CPAN::Shell::format_result ;
sub format_result {
    my($self) = shift;
    my($type,@args) = @_;
    @args = '/./' unless @args;
    my(@result) = $self->expand($type,@args);
    my $result = @result == 1 ?
        $result[0]->as_string :
            @result == 0 ?
                "No objects of type $type found for argument @args\n" :
                    join("",
                         (map {$_->as_glimpse} @result),
                         scalar @result, " items found\n",
                        );
    $result;
}

#-> sub CPAN::Shell::report_fh ;
{
    my $installation_report_fh;
    my $previously_noticed = 0;

    sub report_fh {
        return $installation_report_fh if $installation_report_fh;
        if ($CPAN::META->has_usable("File::Temp")) {
            $installation_report_fh
                = File::Temp->new(
                                  dir      => File::Spec->tmpdir,
                                  template => 'cpan_install_XXXX',
                                  suffix   => '.txt',
                                  unlink   => 0,
                                 );
        }
        unless ( $installation_report_fh ) {
            warn("Couldn't open installation report file; " .
                 "no report file will be generated."
                ) unless $previously_noticed++;
        }
    }
}


# The only reason for this method is currently to have a reliable
# debugging utility that reveals which output is going through which
# channel. No, I don't like the colors ;-)

# to turn colordebugging on, write
# cpan> o conf colorize_output 1

#-> sub CPAN::Shell::colorize_output ;
{
    my $print_ornamented_have_warned = 0;
    sub colorize_output {
        my $colorize_output = $CPAN::Config->{colorize_output};
        if ($colorize_output && !$CPAN::META->has_inst("Term::ANSIColor")) {
            unless ($print_ornamented_have_warned++) {
                # no myprint/mywarn within myprint/mywarn!
                warn "Colorize_output is set to true but Term::ANSIColor is not
installed. To activate colorized output, please install Term::ANSIColor.\n\n";
            }
            $colorize_output = 0;
        }
        return $colorize_output;
    }
}


#-> sub CPAN::Shell::print_ornamented ;
sub print_ornamented {
    my($self,$what,$ornament) = @_;
    return unless defined $what;

    local $| = 1; # Flush immediately
    if ( $CPAN::Be_Silent ) {
        print {report_fh()} $what;
        return;
    }
    my $swhat = "$what"; # stringify if it is an object
    if ($CPAN::Config->{term_is_latin}) {
        # note: deprecated, need to switch to $LANG and $LC_*
        # courtesy jhi:
        $swhat
            =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
    }
    if ($self->colorize_output) {
        if ( $CPAN::DEBUG && $swhat =~ /^Debug\(/ ) {
            # if you want to have this configurable, please file a bugreport
            $ornament = $CPAN::Config->{colorize_debug} || "black on_cyan";
        }
        my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
        if ($@) {
            print "Term::ANSIColor rejects color[$ornament]: $@\n
Please choose a different color (Hint: try 'o conf init /color/')\n";
        }
        # GGOLDBACH/Test-GreaterVersion-0.008 broke without this
        # $trailer construct. We want the newline be the last thing if
        # there is a newline at the end ensuring that the next line is
        # empty for other players
        my $trailer = "";
        $trailer = $1 if $swhat =~ s/([\r\n]+)\z//;
        print $color_on,
            $swhat,
                Term::ANSIColor::color("reset"),
                      $trailer;
    } else {
        print $swhat;
    }
}

#-> sub CPAN::Shell::myprint ;

# where is myprint/mywarn/Frontend/etc. documented? Where to use what?
# I think, we send everything to STDOUT and use print for normal/good
# news and warn for news that need more attention. Yes, this is our
# working contract for now.
sub myprint {
    my($self,$what) = @_;
    $self->print_ornamented($what,
                            $CPAN::Config->{colorize_print}||'bold blue on_white',
                           );
}

sub optprint {
    my($self,$category,$what) = @_;
    my $vname = $category . "_verbosity";
    CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
    if (!$CPAN::Config->{$vname}
        || $CPAN::Config->{$vname} =~ /^v/
       ) {
        $CPAN::Frontend->myprint($what);
    }
}

#-> sub CPAN::Shell::myexit ;
sub myexit {
    my($self,$what) = @_;
    $self->myprint($what);
    exit;
}

#-> sub CPAN::Shell::mywarn ;
sub mywarn {
    my($self,$what) = @_;
    $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
}

# only to be used for shell commands
#-> sub CPAN::Shell::mydie ;
sub mydie {
    my($self,$what) = @_;
    $self->mywarn($what);

    # If it is the shell, we want the following die to be silent,
    # but if it is not the shell, we would need a 'die $what'. We need
    # to take care that only shell commands use mydie. Is this
    # possible?

    die "\n";
}

# sub CPAN::Shell::colorable_makemaker_prompt ;
sub colorable_makemaker_prompt {
    my($foo,$bar) = @_;
    if (CPAN::Shell->colorize_output) {
        my $ornament = $CPAN::Config->{colorize_print}||'bold blue on_white';
        my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
        print $color_on;
    }
    my $ans = ExtUtils::MakeMaker::prompt($foo,$bar);
    if (CPAN::Shell->colorize_output) {
        print Term::ANSIColor::color('reset');
    }
    return $ans;
}

# use this only for unrecoverable errors!
#-> sub CPAN::Shell::unrecoverable_error ;
sub unrecoverable_error {
    my($self,$what) = @_;
    my @lines = split /\n/, $what;
    my $longest = 0;
    for my $l (@lines) {
        $longest = length $l if length $l > $longest;
    }
    $longest = 62 if $longest > 62;
    for my $l (@lines) {
        if ($l =~ /^\s*$/) {
            $l = "\n";
            next;
        }
        $l = "==> $l";
        if (length $l < 66) {
            $l = pack "A66 A*", $l, "<==";
        }
        $l .= "\n";
    }
    unshift @lines, "\n";
    $self->mydie(join "", @lines);
}

#-> sub CPAN::Shell::mysleep ;
sub mysleep {
    my($self, $sleep) = @_;
    if (CPAN->has_inst("Time::HiRes")) {
        Time::HiRes::sleep($sleep);
    } else {
        sleep($sleep < 1 ? 1 : int($sleep + 0.5));
    }
}

#-> sub CPAN::Shell::setup_output ;
sub setup_output {
    return if -t STDOUT;
    my $odef = select STDERR;
    $| = 1;
    select STDOUT;
    $| = 1;
    select $odef;
}

#-> sub CPAN::Shell::rematein ;
# RE-adme||MA-ke||TE-st||IN-stall : nearly everything runs through here
sub rematein {
    my $self = shift;
    my($meth,@some) = @_;
    my @pragma;
    while($meth =~ /^(ff?orce|notest)$/) {
        push @pragma, $meth;
        $meth = shift @some or
            $CPAN::Frontend->mydie("Pragma $pragma[-1] used without method: ".
                                   "cannot continue");
    }
    setup_output();
    CPAN->debug("pragma[@pragma]meth[$meth]some[@some]") if $CPAN::DEBUG;

    # Here is the place to set "test_count" on all involved parties to
    # 0. We then can pass this counter on to the involved
    # distributions and those can refuse to test if test_count > X. In
    # the first stab at it we could use a 1 for "X".

    # But when do I reset the distributions to start with 0 again?
    # Jost suggested to have a random or cycling interaction ID that
    # we pass through. But the ID is something that is just left lying
    # around in addition to the counter, so I'd prefer to set the
    # counter to 0 now, and repeat at the end of the loop. But what
    # about dependencies? They appear later and are not reset, they
    # enter the queue but not its copy. How do they get a sensible
    # test_count?

    # With configure_requires, "get" is vulnerable in recursion.

    my $needs_recursion_protection = "get|make|test|install";

    # construct the queue
    my($s,@s,@qcopy);
  STHING: foreach $s (@some) {
        my $obj;
        if (ref $s) {
            CPAN->debug("s is an object[$s]") if $CPAN::DEBUG;
            $obj = $s;
        } elsif ($s =~ m|[\$\@\%]|) { # looks like a perl variable
        } elsif ($s =~ m|^/|) { # looks like a regexp
            if (substr($s,-1,1) eq ".") {
                $obj = CPAN::Shell->expandany($s);
            } else {
                $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ".
                                        "not supported.\nRejecting argument '$s'\n");
                $CPAN::Frontend->mysleep(2);
                next;
            }
        } elsif ($meth eq "ls") {
            $self->globls($s,\@pragma);
            next STHING;
        } else {
            CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG;
            $obj = CPAN::Shell->expandany($s);
        }
        if (0) {
        } elsif (ref $obj) {
            if ($meth =~ /^($needs_recursion_protection)$/) {
                # it would be silly to check for recursion for look or dump
                # (we are in CPAN::Shell::rematein)
                CPAN->debug("Going to test against recursion") if $CPAN::DEBUG;
                eval {  $obj->color_cmd_tmps(0,1); };
                if ($@) {
                    if (ref $@
                        and $@->isa("CPAN::Exception::RecursiveDependency")) {
                        $CPAN::Frontend->mywarn($@);
                    } else {
                        if (0) {
                            require Carp;
                            Carp::confess(sprintf "DEBUG: \$\@[%s]ref[%s]", $@, ref $@);
                        }
                        die;
                    }
                }
            }
            CPAN::Queue->queue_item(qmod => $obj->id, reqtype => "c");
            push @qcopy, $obj;
        } elsif ($CPAN::META->exists('CPAN::Author',uc($s))) {
            $obj = $CPAN::META->instance('CPAN::Author',uc($s));
            if ($meth =~ /^(dump|ls|reports)$/) {
                $obj->$meth();
            } else {
                $CPAN::Frontend->mywarn(
                                        join "",
                                        "Don't be silly, you can't $meth ",
                                        $obj->fullname,
                                        " ;-)\n"
                                       );
                $CPAN::Frontend->mysleep(2);
            }
        } elsif ($s =~ m|[\$\@\%]| && $meth eq "dump") {
            CPAN::InfoObj->dump($s);
        } else {
            $CPAN::Frontend
                ->mywarn(qq{Warning: Cannot $meth $s, }.
                         qq{don't know what it is.
Try the command

    i /$s/

to find objects with matching identifiers.
});
            $CPAN::Frontend->mysleep(2);
        }
    }

    # queuerunner (please be warned: when I started to change the
    # queue to hold objects instead of names, I made one or two
    # mistakes and never found which. I reverted back instead)
  QITEM: while (my $q = CPAN::Queue->first) {
        my $obj;
        my $s = $q->as_string;
        my $reqtype = $q->reqtype || "";
        $obj = CPAN::Shell->expandany($s);
        unless ($obj) {
            # don't know how this can happen, maybe we should panic,
            # but maybe we get a solution from the first user who hits
            # this unfortunate exception?
            $CPAN::Frontend->mywarn("Warning: Could not expand string '$s' ".
                                    "to an object. Skipping.\n");
            $CPAN::Frontend->mysleep(5);
            CPAN::Queue->delete_first($s);
            next QITEM;
        }
        $obj->{reqtype} ||= "";
        {
            # force debugging because CPAN::SQLite somehow delivers us
            # an empty object;

            # local $CPAN::DEBUG = 1024; # Shell; probably fixed now

            CPAN->debug("s[$s]obj-reqtype[$obj->{reqtype}]".
                        "q-reqtype[$reqtype]") if $CPAN::DEBUG;
        }
        if ($obj->{reqtype}) {
            if ($obj->{reqtype} eq "b" && $reqtype =~ /^[rc]$/) {
                $obj->{reqtype} = $reqtype;
                if (
                    exists $obj->{install}
                    &&
                    (
                     UNIVERSAL::can($obj->{install},"failed") ?
                     $obj->{install}->failed :
                     $obj->{install} =~ /^NO/
                    )
                   ) {
                    delete $obj->{install};
                    $CPAN::Frontend->mywarn
                        ("Promoting $obj->{ID} from 'build_requires' to 'requires'");
                }
            }
        } else {
            $obj->{reqtype} = $reqtype;
        }

        for my $pragma (@pragma) {
            if ($pragma
                &&
                $obj->can($pragma)) {
                $obj->$pragma($meth);
            }
        }
        if (UNIVERSAL::can($obj, 'called_for')) {
            $obj->called_for($s);
        }
        CPAN->debug(qq{pragma[@pragma]meth[$meth]}.
                    qq{ID[$obj->{ID}]}) if $CPAN::DEBUG;

        push @qcopy, $obj;
        if ($meth =~ /^(report)$/) { # they came here with a pragma?
            $self->$meth($obj);
        } elsif (! UNIVERSAL::can($obj,$meth)) {
            # Must never happen
            my $serialized = "";
            if (0) {
            } elsif ($CPAN::META->has_inst("YAML::Syck")) {
                $serialized = YAML::Syck::Dump($obj);
            } elsif ($CPAN::META->has_inst("YAML")) {
                $serialized = YAML::Dump($obj);
            } elsif ($CPAN::META->has_inst("Data::Dumper")) {
                $serialized = Data::Dumper::Dumper($obj);
            } else {
                require overload;
                $serialized = overload::StrVal($obj);
            }
            CPAN->debug("Going to panic. meth[$meth]s[$s]") if $CPAN::DEBUG;
            $CPAN::Frontend->mydie("Panic: obj[$serialized] cannot meth[$meth]");
        } elsif ($obj->$meth()) {
            CPAN::Queue->delete($s);
            CPAN->debug("From queue deleted. meth[$meth]s[$s]") if $CPAN::DEBUG;
        } else {
            CPAN->debug("Failed. pragma[@pragma]meth[$meth]") if $CPAN::DEBUG;
        }

        $obj->undelay;
        for my $pragma (@pragma) {
            my $unpragma = "un$pragma";
            if ($obj->can($unpragma)) {
                $obj->$unpragma();
            }
        }
        if ($CPAN::Config->{halt_on_failure}
                &&
                    CPAN::Distrostatus::something_has_just_failed()
              ) {
            $CPAN::Frontend->mywarn("Stopping: '$meth' failed for '$s'.\n");
            CPAN::Queue->nullify_queue;
            last QITEM;
        }
        CPAN::Queue->delete_first($s);
    }
    if ($meth =~ /^($needs_recursion_protection)$/) {
        for my $obj (@qcopy) {
            $obj->color_cmd_tmps(0,0);
        }
    }
}

#-> sub CPAN::Shell::recent ;
sub recent {
  my($self) = @_;
  if ($CPAN::META->has_inst("XML::LibXML")) {
      my $url = $CPAN::Defaultrecent;
      $CPAN::Frontend->myprint("Going to fetch '$url'\n");
      unless ($CPAN::META->has_usable("LWP")) {
          $CPAN::Frontend->mydie("LWP not installed; cannot continue");
      }
      CPAN::LWP::UserAgent->config;
      my $Ua;
      eval { $Ua = CPAN::LWP::UserAgent->new; };
      if ($@) {
          $CPAN::Frontend->mydie("CPAN::LWP::UserAgent->new dies with $@\n");
      }
      my $resp = $Ua->get($url);
      unless ($resp->is_success) {
          $CPAN::Frontend->mydie(sprintf "Could not download '%s': %s\n", $url, $resp->code);
      }
      $CPAN::Frontend->myprint("DONE\n\n");
      my $xml = XML::LibXML->new->parse_string($resp->content);
      if (0) {
          my $s = $xml->serialize(2);
          $s =~ s/\n\s*\n/\n/g;
          $CPAN::Frontend->myprint($s);
          return;
      }
      my @distros;
      if ($url =~ /winnipeg/) {
          my $pubdate = $xml->findvalue("/rss/channel/pubDate");
          $CPAN::Frontend->myprint("    pubDate: $pubdate\n\n");
          for my $eitem ($xml->findnodes("/rss/channel/item")) {
              my $distro = $eitem->findvalue("enclosure/\@url");
              $distro =~ s|.*?/authors/id/./../||;
              my $size   = $eitem->findvalue("enclosure/\@length");
              my $desc   = $eitem->findvalue("description");
              $desc =~ s/.+? - //;
              $CPAN::Frontend->myprint("$distro [$size b]\n    $desc\n");
              push @distros, $distro;
          }
      } elsif ($url =~ /search.*uploads.rdf/) {
          # xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
          # xmlns="http://purl.org/rss/1.0/"
          # xmlns:taxo="http://purl.org/rss/1.0/modules/taxonomy/"
          # xmlns:dc="http://purl.org/dc/elements/1.1/"
          # xmlns:syn="http://purl.org/rss/1.0/modules/syndication/"
          # xmlns:admin="http://webns.net/mvcb/"


          my $dc_date = $xml->findvalue("//*[local-name(.) = 'RDF']/*[local-name(.) = 'channel']/*[local-name(.) = 'date']");
          $CPAN::Frontend->myprint("    dc:date: $dc_date\n\n");
          my $finish_eitem = 0;
          local $SIG{INT} = sub { $finish_eitem = 1 };
        EITEM: for my $eitem ($xml->findnodes("//*[local-name(.) = 'RDF']/*[local-name(.) = 'item']")) {
              my $distro = $eitem->findvalue("\@rdf:about");
              $distro =~ s|.*~||; # remove up to the tilde before the name
              $distro =~ s|/$||; # remove trailing slash
              $distro =~ s|([^/]+)|\U$1\E|; # upcase the name
              my $author = uc $1 or die "distro[$distro] without author, cannot continue";
              my $desc   = $eitem->findvalue("*[local-name(.) = 'description']");
              my $i = 0;
            SUBDIRTEST: while () {
                  last SUBDIRTEST if ++$i >= 6; # half a dozen must do!
                  if (my @ret = $self->globls("$distro*")) {
                      @ret = grep {$_->[2] !~ /meta/} @ret;
                      @ret = grep {length $_->[2]} @ret;
                      if (@ret) {
                          $distro = "$author/$ret[0][2]";
                          last SUBDIRTEST;
                      }
                  }
                  $distro =~ s|/|/*/|; # allow it to reside in a subdirectory
              }

              next EITEM if $distro =~ m|\*|; # did not find the thing
              $CPAN::Frontend->myprint("____$desc\n");
              push @distros, $distro;
              last EITEM if $finish_eitem;
          }
      }
      return \@distros;
  } else {
      # deprecated old version
      $CPAN::Frontend->mydie("no XML::LibXML installed, cannot continue\n");
  }
}

#-> sub CPAN::Shell::smoke ;
sub smoke {
    my($self) = @_;
    my $distros = $self->recent;
  DISTRO: for my $distro (@$distros) {
        next if $distro =~ m|/Bundle-|; # XXX crude heuristic to skip bundles
        $CPAN::Frontend->myprint(sprintf "Going to download and test '$distro'\n");
        {
            my $skip = 0;
            local $SIG{INT} = sub { $skip = 1 };
            for (0..9) {
                $CPAN::Frontend->myprint(sprintf "\r%2d (Hit ^C to skip)", 10-$_);
                sleep 1;
                if ($skip) {
                    $CPAN::Frontend->myprint(" skipped\n");
                    next DISTRO;
                }
            }
        }
        $CPAN::Frontend->myprint("\r  \n"); # leave the dirty line with a newline
        $self->test($distro);
    }
}

{
    # set up the dispatching methods
    no strict "refs";
    for my $command (qw(
                        clean
                        cvs_import
                        dump
                        force
                        fforce
                        get
                        install
                        look
                        ls
                        make
                        notest
                        perldoc
                        readme
                        reports
                        test
                       )) {
        *$command = sub { shift->rematein($command, @_); };
    }
}

package CPAN::LWP::UserAgent;
use strict;

sub config {
    return if $SETUPDONE;
    if ($CPAN::META->has_usable('LWP::UserAgent')) {
        require LWP::UserAgent;
        @ISA = qw(Exporter LWP::UserAgent);
        $SETUPDONE++;
    } else {
        $CPAN::Frontend->mywarn("  LWP::UserAgent not available\n");
    }
}

sub get_basic_credentials {
    my($self, $realm, $uri, $proxy) = @_;
    if ($USER && $PASSWD) {
        return ($USER, $PASSWD);
    }
    if ( $proxy ) {
        ($USER,$PASSWD) = $self->get_proxy_credentials();
    } else {
        ($USER,$PASSWD) = $self->get_non_proxy_credentials();
    }
    return($USER,$PASSWD);
}

sub get_proxy_credentials {
    my $self = shift;
    my ($user, $password);
    if ( defined $CPAN::Config->{proxy_user} ) {
        $user = $CPAN::Config->{proxy_user};
        $password = $CPAN::Config->{proxy_pass} || "";
        return ($user, $password);
    }
    my $username_prompt = "\nProxy authentication needed!
 (Note: to permanently configure username and password run
   o conf proxy_user your_username
   o conf proxy_pass your_password
     )\nUsername:";
    ($user, $password) =
        _get_username_and_password_from_user($username_prompt);
    return ($user,$password);
}

sub get_non_proxy_credentials {
    my $self = shift;
    my ($user,$password);
    if ( defined $CPAN::Config->{username} ) {
        $user = $CPAN::Config->{username};
        $password = $CPAN::Config->{password} || "";
        return ($user, $password);
    }
    my $username_prompt = "\nAuthentication needed!
     (Note: to permanently configure username and password run
       o conf username your_username
       o conf password your_password
     )\nUsername:";

    ($user, $password) =
        _get_username_and_password_from_user($username_prompt);
    return ($user,$password);
}

sub _get_username_and_password_from_user {
    my $username_message = shift;
    my ($username,$password);

    ExtUtils::MakeMaker->import(qw(prompt));
    $username = prompt($username_message);
        if ($CPAN::META->has_inst("Term::ReadKey")) {
            Term::ReadKey::ReadMode("noecho");
        }
    else {
        $CPAN::Frontend->mywarn(
            "Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"
        );
    }
    $password = prompt("Password:");

        if ($CPAN::META->has_inst("Term::ReadKey")) {
            Term::ReadKey::ReadMode("restore");
        }
        $CPAN::Frontend->myprint("\n\n");
    return ($username,$password);
}

# mirror(): Its purpose is to deal with proxy authentication. When we
# call SUPER::mirror, we relly call the mirror method in
# LWP::UserAgent. LWP::UserAgent will then call
# $self->get_basic_credentials or some equivalent and this will be
# $self->dispatched to our own get_basic_credentials method.

# Our own get_basic_credentials sets $USER and $PASSWD, two globals.

# 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
# although we have gone through our get_basic_credentials, the proxy
# server refuses to connect. This could be a case where the username or
# password has changed in the meantime, so I'm trying once again without
# $USER and $PASSWD to give the get_basic_credentials routine another
# chance to set $USER and $PASSWD.

# mirror(): Its purpose is to deal with proxy authentication. Whe