diff options
author | Sandbox <andk@cpan.org> | 2016-06-08 23:15:41 +0200 |
---|---|---|
committer | James E Keenan <jkeenan@cpan.org> | 2016-06-08 18:20:42 -0400 |
commit | 8c4723656080526a8392690f30ec46d642de80ba (patch) | |
tree | bca624a862fbcdd83dad013e8e285c7b944ac4fe /cpan | |
parent | ee072c898947f5fee316f1381b29ad692addcf05 (diff) | |
download | perl-8c4723656080526a8392690f30ec46d642de80ba.tar.gz |
Updates CPAN.pm to ANDK/CPAN-2.14-TRIAL.tar.gz
Diffstat (limited to 'cpan')
-rw-r--r-- | cpan/CPAN/lib/App/Cpan.pm | 224 | ||||
-rw-r--r-- | cpan/CPAN/lib/CPAN.pm | 80 | ||||
-rw-r--r-- | cpan/CPAN/lib/CPAN/Distribution.pm | 172 | ||||
-rw-r--r-- | cpan/CPAN/lib/CPAN/FTP.pm | 14 | ||||
-rw-r--r-- | cpan/CPAN/lib/CPAN/FirstTime.pm | 9 | ||||
-rw-r--r-- | cpan/CPAN/lib/CPAN/HandleConfig.pm | 12 | ||||
-rw-r--r-- | cpan/CPAN/lib/CPAN/Index.pm | 4 | ||||
-rw-r--r-- | cpan/CPAN/lib/CPAN/Mirrors.pm | 6 | ||||
-rw-r--r-- | cpan/CPAN/lib/CPAN/Plugin.pm | 6 | ||||
-rw-r--r-- | cpan/CPAN/lib/CPAN/Shell.pm | 16 | ||||
-rw-r--r-- | cpan/CPAN/scripts/cpan | 106 |
11 files changed, 402 insertions, 247 deletions
diff --git a/cpan/CPAN/lib/App/Cpan.pm b/cpan/CPAN/lib/App/Cpan.pm index e8c9bb78ee..59642ed86f 100644 --- a/cpan/CPAN/lib/App/Cpan.pm +++ b/cpan/CPAN/lib/App/Cpan.pm @@ -6,7 +6,7 @@ use vars qw($VERSION); use if $] < 5.008 => 'IO::Scalar'; -$VERSION = '1.63'; +$VERSION = '1.64'; =head1 NAME @@ -34,7 +34,7 @@ App::Cpan - easily interact with CPAN from the command line cpan # without arguments, but some switches - cpan [-ahpruvACDLOP] + cpan [-ahpruvACDLOPX] =head1 DESCRIPTION @@ -104,7 +104,7 @@ distribution. Print a help message and exit. When you specify C<-h>, it ignores all of the other options and arguments. -=item -i +=item -i module [ module ... ] Install the specified modules. With no other switches, this switch is implied. @@ -164,7 +164,12 @@ session. Recompiles dynamically loaded modules with CPAN::Shell->recompile. -=item -t +=item -s + +Drop in the CPAN.pm shell. This command does this automatically if you don't +specify any arguments. + +=item -t module [ module ... ] Run a `make test` on the specified modules. @@ -192,6 +197,16 @@ UNIMPLEMENTED Turn on cpan warnings. This checks various things, like directory permissions, and tells you about problems you might have. +=item -x module [ module ... ] + +Find close matches to the named modules that you think you might have +mistyped. This requires the optional installation of Text::Levenshtein or +Text::Levenshtein::Damerau. + +=item -X + +Dump all the namespaces to standard output. + =back =head2 Examples @@ -299,7 +314,7 @@ BEGIN { # most of this should be in methods use vars qw( @META_OPTIONS $Default %CPAN_METHODS @CPAN_OPTIONS @option_order %Method_table %Method_table_index ); -@META_OPTIONS = qw( h v V I g G M: C A D O l L a r p P j: J w T); +@META_OPTIONS = qw( h v V I g G M: C A D O l L a r p P j: J w x X ); $Default = 'default'; @@ -312,6 +327,7 @@ $Default = 'default'; 't' => 'test', 'u' => 'upgrade', 'T' => 'notest', + 's' => 'shell', ); @CPAN_OPTIONS = grep { $_ ne $Default } sort keys %CPAN_METHODS; @@ -332,6 +348,7 @@ sub GOOD_EXIT () { 0 } h => [ \&_print_help, NO_ARGS, GOOD_EXIT, 'Printing help' ], v => [ \&_print_version, NO_ARGS, GOOD_EXIT, 'Printing version' ], V => [ \&_print_details, NO_ARGS, GOOD_EXIT, 'Printing detailed version' ], + X => [ \&_list_all_namespaces, NO_ARGS, GOOD_EXIT, 'Listing all namespaces' ], # options that affect other options j => [ \&_load_config, ARGS, GOOD_EXIT, 'Use specified config file' ], @@ -343,8 +360,8 @@ sub GOOD_EXIT () { 0 } w => [ \&_turn_on_warnings, NO_ARGS, GOOD_EXIT, 'Turning on warnings' ], # options that do their one thing - g => [ \&_download, NO_ARGS, GOOD_EXIT, 'Download the latest distro' ], - G => [ \&_gitify, NO_ARGS, GOOD_EXIT, 'Down and gitify the latest distro' ], + g => [ \&_download, ARGS, GOOD_EXIT, 'Download the latest distro' ], + G => [ \&_gitify, ARGS, GOOD_EXIT, 'Down and gitify the latest distro' ], C => [ \&_show_Changes, ARGS, GOOD_EXIT, 'Showing Changes file' ], A => [ \&_show_Author, ARGS, GOOD_EXIT, 'Showing Author' ], @@ -358,7 +375,9 @@ sub GOOD_EXIT () { 0 } r => [ \&_recompile, NO_ARGS, GOOD_EXIT, 'Recompiling' ], u => [ \&_upgrade, NO_ARGS, GOOD_EXIT, 'Running `make test`' ], + 's' => [ \&_shell, NO_ARGS, GOOD_EXIT, 'Running `make test`' ], + 'x' => [ \&_guess_namespace, ARGS, GOOD_EXIT, 'Guessing namespaces' ], c => [ \&_default, ARGS, GOOD_EXIT, 'Running `make clean`' ], f => [ \&_default, ARGS, GOOD_EXIT, 'Installing with force' ], i => [ \&_default, ARGS, GOOD_EXIT, 'Running `make install`' ], @@ -510,7 +529,7 @@ sub run last OPTION; } - $logger->info( "$description -- ignoring other arguments" ) + $logger->info( "[$option] $description -- ignoring other arguments" ) if( @ARGV && ! $takes_args ); $return_value = $sub->( \ @ARGV, $options ); @@ -536,7 +555,7 @@ sub _init_logger unless( $log4perl_loaded ) { - print "Loading internal null logger. Install Log::Log4perl for logging messages\n"; + print STDERR "Loading internal null logger. Install Log::Log4perl for logging messages\n"; $logger = Local::Null::Logger->new; return $logger; } @@ -597,6 +616,12 @@ sub _default foreach my $arg ( @$args ) { + # check the argument and perhaps capture typos + my $module = _expand_module( $arg ) or do { + $logger->error( "Skipping $arg because I couldn't find a matching namespace." ); + next; + }; + _clear_cpanpm_output(); $action->( $arg ); @@ -785,8 +810,7 @@ HERE $CPAN::Frontend->myprint("\n"); } - my $mirrors = CPAN::Mirrors->new( ); - $mirrors->parse_mirrored_by( File::Spec->catfile($CPAN::Config->{keep_source_where},'MIRRORED.BY') ); + my $mirrors = CPAN::Mirrors->new( _mirror_file() ); my @continents = $mirrors->find_best_continents; my @mirrors = $mirrors->get_mirrors_by_continents( $continents[0] ); @@ -907,9 +931,7 @@ sub _is_pingable_scheme { $uri->scheme eq 'file' } -sub _find_good_mirrors { - require CPAN::Mirrors; - +sub _mirror_file { my $file = do { my $file = 'MIRRORED.BY'; my $local_path = File::Spec->catfile( @@ -922,7 +944,12 @@ sub _find_good_mirrors { $local_path; } }; - my $mirrors = CPAN::Mirrors->new( $file ); + } + +sub _find_good_mirrors { + require CPAN::Mirrors; + + my $mirrors = CPAN::Mirrors->new( _mirror_file() ); my @mirrors = $mirrors->best_mirrors( how_many => 5, @@ -1044,6 +1071,15 @@ sub _upgrade return HEY_IT_WORKED; } +sub _shell + { + $logger->info( "Dropping into shell" ); + + CPAN::shell(); + + return HEY_IT_WORKED; + } + sub _load_config # -j { my $file = shift || ''; @@ -1102,14 +1138,17 @@ sub _download my %paths; - foreach my $module ( @$args ) - { - $logger->info( "Checking $module" ); - my $path = CPAN::Shell->expand( "Module", $module )->cpan_file; + foreach my $arg ( @$args ) { + $logger->info( "Checking $arg" ); + + my $module = _expand_module( $arg ) or next; + my $path = $module->cpan_file; $logger->debug( "Inst file would be $path\n" ); - $paths{$module} = _get_file( _make_path( $path ) ); + $paths{$arg} = _get_file( _make_path( $path ) ); + + $logger->info( "Downloaded [$arg] to [$paths{$module}]" ); } return \%paths; @@ -1149,16 +1188,14 @@ sub _gitify my $starting_dir = cwd(); - foreach my $module ( @$args ) + foreach my $arg ( @$args ) { - $logger->info( "Checking $module" ); - my $path = CPAN::Shell->expand( "Module", $module )->cpan_file; - - my $store_paths = _download( [ $module ] ); - $logger->debug( "gitify Store path is $store_paths->{$module}" ); - my $dirname = dirname( $store_paths->{$module} ); + $logger->info( "Checking $arg" ); + my $store_paths = _download( [ $arg ] ); + $logger->debug( "gitify Store path is $store_paths->{$arg}" ); + my $dirname = dirname( $store_paths->{$arg} ); - my $ae = Archive::Extract->new( archive => $store_paths->{$module} ); + my $ae = Archive::Extract->new( archive => $store_paths->{$arg} ); $ae->extract( to => $dirname ); chdir $ae->extract_path; @@ -1186,7 +1223,8 @@ sub _show_Changes { $logger->info( "Checking $arg\n" ); - my $module = eval { CPAN::Shell->expand( "Module", $arg ) }; + my $module = _expand_module( $arg ) or next; + my $out = _get_cpanpm_output(); next unless eval { $module->inst_file }; @@ -1233,7 +1271,8 @@ sub _show_Author foreach my $arg ( @$args ) { - my $module = CPAN::Shell->expand( "Module", $arg ); + my $module = _expand_module( $arg ) or next; + unless( $module ) { $logger->info( "Didn't find a $arg module, so no author!" ); @@ -1257,7 +1296,7 @@ sub _show_Details foreach my $arg ( @$args ) { - my $module = CPAN::Shell->expand( "Module", $arg ); + my $module = _expand_module( $arg ) or next; my $author = CPAN::Shell->expand( "Author", $module->userid ); next unless $module->userid; @@ -1279,14 +1318,23 @@ sub _show_Details return HEY_IT_WORKED; } +BEGIN { +my $modules; +sub _get_all_namespaces + { + return $modules if $modules; + $modules = [ map { $_->id } CPAN::Shell->expand( "Module", "/./" ) ]; + } +} + sub _show_out_of_date { - my @modules = CPAN::Shell->expand( "Module", "/./" ); + my $modules = _get_all_namespaces(); printf "%-40s %6s %6s\n", "Module Name", "Local", "CPAN"; print "-" x 73, "\n"; - foreach my $module ( @modules ) + foreach my $module ( @$modules ) { next unless $module->inst_file; next if $module->uptodate; @@ -1305,10 +1353,9 @@ sub _show_author_mods my %hash = map { lc $_, 1 } @$args; - my @modules = CPAN::Shell->expand( "Module", "/./" ); + my $modules = _get_all_namespaces(); - foreach my $module ( @modules ) - { + foreach my $module ( @$modules ) { next unless exists $hash{ lc $module->userid }; print $module->id, "\n"; } @@ -1428,6 +1475,107 @@ sub _path_to_module return $module_name; } + +sub _expand_module + { + my( $module ) = @_; + + my $expanded = CPAN::Shell->expand( "Module", $module ); + unless( defined $expanded ) { + $logger->error( "Could not expand [$module]. Check the module name." ); + my $threshold = ( + grep { int } + sort { length $a <=> length $b } + length($module)/4, 4 + )[0]; + + my $guesses = _guess_at_module_name( $module, $threshold ); + if( defined $guesses and @$guesses ) { + $logger->info( "Perhaps you meant one of these:" ); + foreach my $guess ( @$guesses ) { + $logger->info( "\t$guess" ); + } + } + return; + } + + return $expanded; + } + +my $guessers = [ + [ qw( Text::Levenshtein::XS distance 7 ) ], + [ qw( Text::Levenshtein::Damerau::XS xs_edistance 7 ) ], + + [ qw( Text::Levenshtein distance 7 ) ], + [ qw( Text::Levenshtein::Damerau::PP pp_edistance 7 ) ], + + ]; + +# for -x +sub _guess_namespace + { + my $args = shift; + + foreach my $arg ( @$args ) + { + $logger->debug( "Checking $arg" ); + my $guesses = _guess_at_module_name( $arg ); + + foreach my $guess ( @$guesses ) { + print $guess, "\n"; + } + } + + return HEY_IT_WORKED; + } + +sub _list_all_namespaces { + my $modules = _get_all_namespaces(); + + foreach my $module ( @$modules ) { + print $module, "\n"; + } + } + +BEGIN { +my $distance; +sub _guess_at_module_name + { + my( $target, $threshold ) = @_; + + unless( defined $distance ) { + foreach my $try ( @$guessers ) { + my $can_guess = eval "require $try->[0]; 1" or next; + + no strict 'refs'; + $distance = \&{ join "::", @$try[0,1] }; + $threshold ||= $try->[2]; + } + } + + unless( $distance ) { + my $modules = join ", ", map { $_->[0] } @$guessers; + substr $modules, rindex( $modules, ',' ), 1, ', and'; + + $logger->info( "I can suggest names if you install one of $modules" ); + return; + } + + my $modules = _get_all_namespaces(); + $logger->info( "Checking " . @$modules . " namespaces for close match suggestions" ); + + my %guesses; + foreach my $guess ( @$modules ) { + my $distance = $distance->( $target, $guess ); + next if $distance > $threshold; + $guesses{$guess} = $distance; + } + + my @guesses = sort { $guesses{$a} <=> $guesses{$b} } keys %guesses; + return [ grep { defined } @guesses[0..9] ]; + } +} + 1; =back @@ -1460,8 +1608,6 @@ report them to the user. * Check then exit -* no test option - =head1 BUGS * none noted @@ -1497,7 +1643,7 @@ brian d foy, C<< <bdfoy@cpan.org> >> =head1 COPYRIGHT -Copyright (c) 2001-2014, brian d foy, All Rights Reserved. +Copyright (c) 2001-2015, brian d foy, All Rights Reserved. You may redistribute this under the same terms as Perl itself. diff --git a/cpan/CPAN/lib/CPAN.pm b/cpan/CPAN/lib/CPAN.pm index 6096916bd9..ab2d00f06a 100644 --- a/cpan/CPAN/lib/CPAN.pm +++ b/cpan/CPAN/lib/CPAN.pm @@ -2,7 +2,7 @@ # vim: ts=4 sts=4 sw=4: use strict; package CPAN; -$CPAN::VERSION = '2.11'; +$CPAN::VERSION = '2.14'; $CPAN::VERSION =~ s/_//; # we need to run chdir all over and we would get at wrong libraries @@ -14,6 +14,7 @@ BEGIN { $inc = File::Spec->rel2abs($inc) unless ref $inc; } } + $SIG{WINCH} = 'IGNORE' if exists $SIG{WINCH}; } use CPAN::Author; use CPAN::HandleConfig; @@ -460,7 +461,7 @@ Enter 'h' for help. } for my $class (qw(Module Distribution)) { # again unsafe meta access? - for my $dm (keys %{$CPAN::META->{readwrite}{"CPAN::$class"}}) { + for my $dm (sort 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}; @@ -708,13 +709,14 @@ sub checklock { my $otherpid = <$fh>; my $otherhost = <$fh>; $fh->close; - if (defined $otherpid && $otherpid) { + if (defined $otherpid && length $otherpid) { chomp $otherpid; } - if (defined $otherhost && $otherhost) { + if (defined $otherhost && length $otherhost) { chomp $otherhost; } my $thishost = hostname(); + my $ask_if_degraded_wanted = 0; if (defined $otherhost && defined $thishost && $otherhost ne '' && $thishost ne '' && $otherhost ne $thishost) { @@ -732,31 +734,7 @@ 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 downgraded }. - qq{mode? (Y/n)},"y"); - if ($ans =~ /^y/i) { - $CPAN::Frontend->mywarn("Running in downgraded 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! - $_->{auto_commit} = 0; # we are violent, do not persist - $_->{test_report} = 0; # Oliver Paukstadt had sent wrong reports in degraded mode - } - } else { - $CPAN::Frontend->mydie(" -You may want to kill the other job and delete the lockfile. On UNIX try: - kill $otherpid - rm $lockfile -"); - } + $ask_if_degraded_wanted = 1; } elsif (-w $lockfile) { my($ans) = CPAN::Shell::colorable_makemaker_prompt @@ -773,10 +751,46 @@ You may want to kill the other job and delete the lockfile. On UNIX try: qq{ and then rerun us.\n} ); } + } elsif ($^O eq "MSWin32") { + $CPAN::Frontend->mywarn( + qq{ +There seems to be running another CPAN process according to '$lockfile'. +}); + $ask_if_degraded_wanted = 1; } else { $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Found invalid lockfile ". "'$lockfile', please remove. Cannot proceed.\n")); } + if ($ask_if_degraded_wanted) { + my($ans) = + CPAN::Shell::colorable_makemaker_prompt + (qq{Shall I try to run in downgraded }. + qq{mode? (Y/n)},"y"); + if ($ans =~ /^y/i) { + $CPAN::Frontend->mywarn("Running in downgraded 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! + $_->{auto_commit} = 0; # we are violent, do not persist + $_->{test_report} = 0; # Oliver Paukstadt had sent wrong reports in degraded mode + } + } else { + my $msg = "You may want to kill the other job and delete the lockfile."; + if (defined $otherpid) { + $msg .= " Something like: + kill $otherpid + rm $lockfile +"; + } + $CPAN::Frontend->mydie("\n$msg"); + } + } } my $dotcpan = $CPAN::Config->{cpan_home}; eval { File::Path::mkpath($dotcpan);}; @@ -1352,8 +1366,8 @@ sub _list_sorted_descending_is_tested { keys %{$self->{is_tested}}; if ($foul) { $CPAN::Frontend->mywarn("Lost build_dir detected ($foul), giving up all cached test results of currently running session.\n"); - for my $dbd (keys %{$self->{is_tested}}) { # distro-build-dir - SEARCH: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) { + for my $dbd (sort keys %{$self->{is_tested}}) { # distro-build-dir + SEARCH: for my $d (sort { $a->id cmp $b->id } $CPAN::META->all_objects("CPAN::Distribution")) { if ($d->{build_dir} && $d->{build_dir} eq $dbd) { $CPAN::Frontend->mywarn(sprintf "Flushing cache for %s\n", $d->pretty_id); $d->fforce(""); @@ -1969,6 +1983,10 @@ the form Modulename=arg0,arg1,arg2,arg3,... +eg: + + CPAN::Plugin::Flurb=dir,/opt/pkgs/flurb/raw,verbose,1 + At run time, each listed plugin is instantiated as a singleton object by running the equivalent of this pseudo code: diff --git a/cpan/CPAN/lib/CPAN/Distribution.pm b/cpan/CPAN/lib/CPAN/Distribution.pm index 092b781ac2..1ec84a7ce6 100644 --- a/cpan/CPAN/lib/CPAN/Distribution.pm +++ b/cpan/CPAN/lib/CPAN/Distribution.pm @@ -8,7 +8,7 @@ use CPAN::InfoObj; use File::Path (); @CPAN::Distribution::ISA = qw(CPAN::InfoObj); use vars qw($VERSION); -$VERSION = "2.04"; +$VERSION = "2.12"; # no prepare, because prepare is not a command on the shell command line # TODO: clear instance cache on reload @@ -214,10 +214,10 @@ sub color_cmd_tmps { if (defined $prereq_pm) { # XXX also optional_req & optional_breq? -- xdg, 2012-04-01 # A: no, optional deps may recurse -- ak, 2014-05-07 - PREREQ: for my $pre ( + PREREQ: for my $pre (sort( keys %{$prereq_pm->{requires}||{}}, keys %{$prereq_pm->{build_requires}||{}}, - ) { + )) { next PREREQ if $pre eq "perl"; my $premo; unless ($premo = CPAN::Shell->expand("Module",$pre)) { @@ -251,7 +251,7 @@ sub as_string { #-> sub CPAN::Distribution::containsmods ; sub containsmods { my $self = shift; - return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS}; + return sort keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS}; my $dist_id = $self->{ID}; for my $mod ($CPAN::META->all_objects("CPAN::Module")) { my $mod_file = $mod->cpan_file or next; @@ -264,7 +264,7 @@ sub containsmods { } $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id; } - keys %{$self->{CONTAINSMODS}||={}}; + sort keys %{$self->{CONTAINSMODS}||={}}; } #-> sub CPAN::Distribution::upload_date ; @@ -517,105 +517,59 @@ See also http://rt.cpan.org/Ticket/Display.html?id=38932\n"); @readdir = grep { $_ ne "pax_global_header" } @readdir; } $dh->close; - my ($packagedir); - # XXX here we want in each branch File::Temp to protect all build_dir directories - if (CPAN->has_usable("File::Temp")) { - my $tdir_base; - my $from_dir; - my @dirents; - if (@readdir == 1 && -d $readdir[0]) { - $tdir_base = $readdir[0]; - $from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]); - my $dh2; - unless ($dh2 = DirHandle->new($from_dir)) { - my($mode) = (stat $from_dir)[2]; - my $why = sprintf - ( - "Couldn't opendir '%s', mode '%o': %s", - $from_dir, - $mode, - $!, - ); - $CPAN::Frontend->mywarn("$why\n"); - $self->{writemakefile} = CPAN::Distrostatus->new("NO -- $why"); - return; - } - @dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC?? - } else { - my $userid = $self->cpan_userid; - CPAN->debug("userid[$userid]"); - if (!$userid or $userid eq "N/A") { - $userid = "anon"; - } - $tdir_base = $userid; - $from_dir = File::Spec->curdir; - @dirents = @readdir; + my $tdir_base; + my $from_dir; + my @dirents; + if (@readdir == 1 && -d $readdir[0]) { + $tdir_base = $readdir[0]; + $from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]); + my $dh2; + unless ($dh2 = DirHandle->new($from_dir)) { + my($mode) = (stat $from_dir)[2]; + my $why = sprintf + ( + "Couldn't opendir '%s', mode '%o': %s", + $from_dir, + $mode, + $!, + ); + $CPAN::Frontend->mywarn("$why\n"); + $self->{writemakefile} = CPAN::Distrostatus->new("NO -- $why"); + return; } - eval { File::Path::mkpath $builddir; }; - if ($@) { - $CPAN::Frontend->mydie("Cannot create directory $builddir: $@"); + @dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC?? + } else { + my $userid = $self->cpan_userid; + CPAN->debug("userid[$userid]"); + if (!$userid or $userid eq "N/A") { + $userid = "anon"; } - $packagedir = File::Temp::tempdir( - "$tdir_base-XXXXXX", - DIR => $builddir, - CLEANUP => 0, - ); - chmod 0777 &~ umask, $packagedir; # may fail - my $f; - for $f (@dirents) { # is already without "." and ".." - my $from = File::Spec->catfile($from_dir,$f); - my $to = File::Spec->catfile($packagedir,$f); - unless (File::Copy::move($from,$to)) { - my $err = $!; - $from = File::Spec->rel2abs($from); - Carp::confess("Couldn't move $from to $to: $err"); - } + $tdir_base = $userid; + $from_dir = File::Spec->curdir; + @dirents = @readdir; + } + eval { File::Path::mkpath $builddir; }; + if ($@) { + $CPAN::Frontend->mydie("Cannot create directory $builddir: $@"); + } + my $packagedir; + my $eexist = $CPAN::META->has_usable("Errno") ? &Errno::EEXIST : undef; + for(my $suffix = 0; ; $suffix++) { + $packagedir = File::Spec->catdir($builddir, "$tdir_base-$suffix"); + my $parent = $builddir; + mkdir($packagedir, 0777) and last; + if((defined($eexist) && $! != $eexist) || $suffix == 999) { + $CPAN::Frontend->mydie("Cannot create directory $packagedir: $!\n"); } - } else { # older code below, still better than nothing when there is no File::Temp - my($distdir); - if (@readdir == 1 && -d $readdir[0]) { - $distdir = $readdir[0]; - $packagedir = File::Spec->catdir($builddir,$distdir); - $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]") - if $CPAN::DEBUG; - -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ". - "$packagedir\n"); - File::Path::rmtree($packagedir); - unless (File::Copy::move($distdir,$packagedir)) { - $CPAN::Frontend->unrecoverable_error(<<EOF); -Couldn't move '$distdir' to '$packagedir': $! - -Cannot continue: Please find the reason why I cannot move -$builddir/tmp-$$/$distdir -to -$packagedir -and fix the problem, then retry - -EOF - } - $self->debug(sprintf("moved distdir[%s] to packagedir[%s] -e[%s]-d[%s]", - $distdir, - $packagedir, - -e $packagedir, - -d $packagedir, - )) if $CPAN::DEBUG; - } else { - my $userid = $self->cpan_userid; - CPAN->debug("userid[$userid]") if $CPAN::DEBUG; - if (!$userid or $userid eq "N/A") { - $userid = "anon"; - } - my $pragmatic_dir = $userid . '000'; - $pragmatic_dir =~ s/\W_//g; - $pragmatic_dir++ while -d "../$pragmatic_dir"; - $packagedir = File::Spec->catdir($builddir,$pragmatic_dir); - $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG; - File::Path::mkpath($packagedir); - my($f); - for $f (@readdir) { # is already without "." and ".." - my $to = File::Spec->catdir($packagedir,$f); - File::Copy::move($f,$to) or Carp::confess("Couldn't move $f to $to: $!"); - } + } + my $f; + for $f (@dirents) { # is already without "." and ".." + my $from = File::Spec->catfile($from_dir,$f); + my $to = File::Spec->catfile($packagedir,$f); + unless (File::Copy::move($from,$to)) { + my $err = $!; + $from = File::Spec->rel2abs($from); + $CPAN::Frontend->mydie("Couldn't move $from to $to: $err"); } } $self->{build_dir} = $packagedir; @@ -734,7 +688,7 @@ sub satisfy_configure_requires { return 1 unless @prereq; $self->debug(\@prereq) if $CPAN::DEBUG; if ($self->{configure_requires_later}) { - for my $k (keys %{$self->{configure_requires_later_for}||{}}) { + for my $k (sort keys %{$self->{configure_requires_later_for}||{}}) { if ($self->{configure_requires_later_for}{$k}>1) { my $type = ""; for my $p (@prereq) { @@ -2228,7 +2182,7 @@ is part of the perl-%s distribution. To install that, you need to run "system()\n"); } } - my $system_ok; + my ($system_ok, $system_err); if ($want_expect) { # XXX probably want to check _should_report here and # warn about not being able to use CPAN::Reporter with expect @@ -2240,7 +2194,9 @@ is part of the perl-%s distribution. To install that, you need to run $system_ok = ! $ret; } else { - $system_ok = system($system) == 0; + my $rc = system($system); + $system_ok = $rc == 0; + $system_err = $! if $rc == -1; } $self->introduce_myself; if ( $system_ok ) { @@ -2250,6 +2206,7 @@ is part of the perl-%s distribution. To install that, you need to run $self->{writemakefile} ||= CPAN::Distrostatus->new("YES"); $self->{make} = CPAN::Distrostatus->new("NO"); $CPAN::Frontend->mywarn(" $system -- NOT OK\n"); + $CPAN::Frontend->mywarn(" $system_err\n") if defined $system_err; } $self->store_persistent_state; @@ -2855,7 +2812,7 @@ sub unsat_prereq { $CPAN::META->has_usable("CPAN::Meta::Requirements") or die "CPAN::Meta::Requirements not available"; my $merged = CPAN::Meta::Requirements->from_string_hash($merged_hash); - my @merged = $merged->required_modules; + my @merged = sort $merged->required_modules; CPAN->debug("all merged_prereqs[@merged]") if $CPAN::DEBUG; NEED: for my $need_module ( @merged ) { my $need_version = $merged->requirements_for_module($need_module); @@ -3263,7 +3220,8 @@ sub prereq_pm { } my $areq; my $do_replace; - while (my($k,$v) = each %{$req||{}}) { + foreach my $k (sort keys %{$req||{}}) { + my $v = $req->{$k}; next unless defined $v; if ($v =~ /\d/) { $areq->{$k} = $v; @@ -3664,7 +3622,7 @@ sub _make_test_illuminate_prereqs { my @prereq; # local $CPAN::DEBUG = 16; # Distribution - for my $m (keys %{$self->{sponsored_mods}}) { + for my $m (sort keys %{$self->{sponsored_mods}}) { next unless $self->{sponsored_mods}{$m} > 0; my $m_obj = CPAN::Shell->expand("Module",$m) or next; # XXX we need available_version which reflects diff --git a/cpan/CPAN/lib/CPAN/FTP.pm b/cpan/CPAN/lib/CPAN/FTP.pm index 831f234d3c..0c338c51f4 100644 --- a/cpan/CPAN/lib/CPAN/FTP.pm +++ b/cpan/CPAN/lib/CPAN/FTP.pm @@ -14,7 +14,7 @@ use vars qw($connect_to_internet_ok $Ua $Thesite $ThesiteURL $Themethod); use vars qw( $VERSION ); -$VERSION = "5.5006"; +$VERSION = "5.5007"; #-> sub CPAN::FTP::ftp_statistics # if they want to rewrite, they need to pass in a filehandle @@ -35,13 +35,19 @@ sub _ftp_statistics { while (!CPAN::_flock($fh, $locktype|LOCK_NB)) { $waitstart ||= localtime(); if ($sleep>3) { - $CPAN::Frontend->mywarn("Waiting for a read lock on '$file' (since $waitstart)\n"); + my $now = localtime(); + $CPAN::Frontend->mywarn("$now: waiting for read lock on '$file' (since $waitstart)\n"); } - $CPAN::Frontend->mysleep($sleep); + sleep($sleep); # this sleep must not be overridden; + # Frontend->mysleep with AUTOMATED_TESTING has + # provoked complete lock contention on my NFS if ($sleep <= 3) { $sleep+=0.33; - } elsif ($sleep <=6) { + } elsif ($sleep <= 6) { $sleep+=0.11; + } else { + # retry to get a fresh handle. If it is NFS and the handle is stale, we will never get an flock + open $fh, "+>>$file" or $CPAN::Frontend->mydie("Could not open '$file': $!"); } } my $stats = eval { CPAN->_yaml_loadfile($file); }; diff --git a/cpan/CPAN/lib/CPAN/FirstTime.pm b/cpan/CPAN/lib/CPAN/FirstTime.pm index 918e009a2b..fb6b7eb493 100644 --- a/cpan/CPAN/lib/CPAN/FirstTime.pm +++ b/cpan/CPAN/lib/CPAN/FirstTime.pm @@ -10,7 +10,7 @@ use File::Path (); use File::Spec (); use CPAN::Mirrors (); use vars qw($VERSION $auto_config); -$VERSION = "5.5307"; +$VERSION = "5.5309"; =head1 NAME @@ -775,7 +775,7 @@ sub init { } } elsif (0 == length $matcher) { } elsif (0 && $matcher eq "~") { # extremely buggy, but a nice idea - my @unconfigured = grep { not exists $CPAN::Config->{$_} + my @unconfigured = sort grep { not exists $CPAN::Config->{$_} or not defined $CPAN::Config->{$_} or not length $CPAN::Config->{$_} } keys %$CPAN::Config; @@ -1300,8 +1300,9 @@ sub init { $CPAN::Frontend->myprint("\nWriting $configpm for bootstrap...\n"); delete $CPAN::Config->{install_help}; # temporary only CPAN::HandleConfig->commit; - my $dist; - if ( $dist = CPAN::Shell->expand('Module', 'local::lib')->distribution ) { + my($dist, $locallib); + $locallib = CPAN::Shell->expand('Module', 'local::lib'); + if ( $locallib and $dist = $locallib->distribution ) { # this is a hack to force bootstrapping $dist->{prefs}{pl}{commandline} = "$^X Makefile.PL --bootstrap"; # Set @INC for this process so we find things as they bootstrap diff --git a/cpan/CPAN/lib/CPAN/HandleConfig.pm b/cpan/CPAN/lib/CPAN/HandleConfig.pm index e596cbcd6c..bd28948e32 100644 --- a/cpan/CPAN/lib/CPAN/HandleConfig.pm +++ b/cpan/CPAN/lib/CPAN/HandleConfig.pm @@ -12,7 +12,7 @@ CPAN::HandleConfig - internal configuration handling for CPAN.pm =cut -$VERSION = "5.5006"; # see also CPAN::Config::VERSION at end of file +$VERSION = "5.5007"; # see also CPAN::Config::VERSION at end of file %can = ( commit => "Commit changes to disk", @@ -250,7 +250,7 @@ sub prettyprint { sprintf "\t%-18s => %s\n", "[$_]", defined $v->{$_} ? "[$v->{$_}]" : "undef" - } keys %$v; + } sort keys %$v; } $CPAN::Frontend->myprint( join( @@ -384,9 +384,9 @@ sub neatvalue { return join "", @m; } return "$v" unless $t eq 'HASH'; - my(@m, $key, $val); - while (($key,$val) = each %$v) { - last unless defined $key; # cautious programming in case (undef,undef) is true + my @m; + foreach my $key (sort keys %$v) { + my $val = $v->{$key}; push(@m,"q[$key]=>".$self->neatvalue($val)) ; } return "{ ".join(', ',@m)." }"; @@ -769,7 +769,7 @@ sub prefs_lookup { use strict; use vars qw($AUTOLOAD $VERSION); - $VERSION = "5.5006"; + $VERSION = "5.5007"; # formerly CPAN::HandleConfig was known as CPAN::Config sub AUTOLOAD { ## no critic diff --git a/cpan/CPAN/lib/CPAN/Index.pm b/cpan/CPAN/lib/CPAN/Index.pm index 8205d78bd0..59e75dcaee 100644 --- a/cpan/CPAN/lib/CPAN/Index.pm +++ b/cpan/CPAN/lib/CPAN/Index.pm @@ -1,7 +1,7 @@ package CPAN::Index; use strict; use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $HAVE_REANIMATED $VERSION); -$VERSION = "1.9601"; +$VERSION = "2.12"; @CPAN::Index::ISA = qw(CPAN::Debug); $LAST_TIME ||= 0; $DATE_OF_03 ||= 0; @@ -528,7 +528,7 @@ sub rd_modlist { my $until = keys(%$ret); my $painted = 0; CPAN->debug(sprintf "until[%d]", $until) if $CPAN::DEBUG; - for (keys %$ret) { + for (sort keys %$ret) { my $obj = $CPAN::META->instance("CPAN::Module",$_); delete $ret->{$_}{modid}; # not needed here, maybe elsewhere $obj->set(%{$ret->{$_}}); diff --git a/cpan/CPAN/lib/CPAN/Mirrors.pm b/cpan/CPAN/lib/CPAN/Mirrors.pm index 37e7ce0ef9..4ceca0458c 100644 --- a/cpan/CPAN/lib/CPAN/Mirrors.pm +++ b/cpan/CPAN/lib/CPAN/Mirrors.pm @@ -34,7 +34,7 @@ CPAN::Mirrors - Get CPAN mirror information and select a fast one package CPAN::Mirrors; use strict; use vars qw($VERSION $urllist $silent); -$VERSION = "1.9601"; +$VERSION = "2.12"; use Carp; use FileHandle; @@ -82,7 +82,7 @@ Return a list of continents based on those defined in F<MIRRORED.BY>. sub continents { my ($self) = @_; - return keys %{$self->{geography}}; + return sort keys %{$self->{geography}}; } =item countries( [CONTINENTS] ) @@ -99,7 +99,7 @@ sub countries { @continents = $self->continents unless @continents; my @countries; for my $c (@continents) { - push @countries, keys %{ $self->{geography}{$c} }; + push @countries, sort keys %{ $self->{geography}{$c} }; } return @countries; } diff --git a/cpan/CPAN/lib/CPAN/Plugin.pm b/cpan/CPAN/lib/CPAN/Plugin.pm index 646d86b2cc..77ad19b776 100644 --- a/cpan/CPAN/lib/CPAN/Plugin.pm +++ b/cpan/CPAN/lib/CPAN/Plugin.pm @@ -3,7 +3,7 @@ package CPAN::Plugin; use strict; use warnings; -our $VERSION = '0.95'; +our $VERSION = '0.96'; require CPAN; @@ -94,8 +94,8 @@ CPAN::Plugin - Base class for CPAN shell extensions =head1 SYNOPSIS - package My::Plugin; - use base 'CPAN::Plugin'; + package CPAN::Plugin::Flurb; + use parent 'CPAN::Plugin'; sub post_test { my ($self, $distribution_object) = @_; diff --git a/cpan/CPAN/lib/CPAN/Shell.pm b/cpan/CPAN/lib/CPAN/Shell.pm index 43e2fb9fa0..ab2f07e2ce 100644 --- a/cpan/CPAN/lib/CPAN/Shell.pm +++ b/cpan/CPAN/lib/CPAN/Shell.pm @@ -47,7 +47,7 @@ use vars qw( "CPAN/Tarzip.pm", "CPAN/Version.pm", ); -$VERSION = "5.5005"; +$VERSION = "5.5006"; # record the initial timestamp for reload. $reload = { map {$INC{$_} ? ($_,(stat $INC{$_})[9]) : ()} @relo }; @CPAN::Shell::ISA = qw(CPAN::Debug); @@ -174,8 +174,8 @@ Download, Test, Make, Install... 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 installed modules + r WORDs or /REGEXP/ or NONE report updates for some/matching/all upgrade WORDs or /REGEXP/ or NONE upgrade some/matching/all modules Pragmas @@ -517,14 +517,14 @@ sub hosts { $s->{dltime} += $dltime; } my $res; - for my $url (keys %{$S{ok}}) { + for my $url (sort 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}}) { + for my $url (sort keys %{$S{no}}) { push @{$res->{no}}, [$S{no}{$url}, $url, ]; @@ -637,6 +637,10 @@ sub _reload_this { } CPAN->debug(sprintf("reload file[%s] content[%s...]",$file,substr($content,0,128))) if $CPAN::DEBUG; + my $includefile; + if ($includefile = $INC{$f} and -e $includefile) { + $f = $includefile; + } delete $INC{$f}; local @INC = @inc; eval "require '$f'"; @@ -1107,7 +1111,7 @@ sub failed { sub find_failed { my($self,$only_id) = @_; my @failed; - DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) { + DIST: for my $d (sort { $a->id cmp $b->id } $CPAN::META->all_objects("CPAN::Distribution")) { my $failed = ""; NAY: for my $nosayer ( # order matters! "unwrapped", diff --git a/cpan/CPAN/scripts/cpan b/cpan/CPAN/scripts/cpan index 5f4320e284..55550902b1 100644 --- a/cpan/CPAN/scripts/cpan +++ b/cpan/CPAN/scripts/cpan @@ -3,8 +3,8 @@ use strict; use vars qw($VERSION); -use App::Cpan '1.60_02'; -$VERSION = '1.61'; +use App::Cpan '1.64'; +$VERSION = '1.64'; my $rc = App::Cpan->run( @ARGV ); @@ -21,7 +21,13 @@ cpan - easily interact with CPAN from the command line cpan module_name [ module_name ... ] # with switches, installs modules with extra behavior - cpan [-cfgimtTw] module_name [ module_name ... ] + cpan [-cfFimtTw] module_name [ module_name ... ] + + # use local::lib + cpan -I module_name [ module_name ... ] + + # one time mirror override for faster mirrors + cpan -p ... # with just the dot, install from the distribution in the # current directory @@ -30,20 +36,8 @@ cpan - easily interact with CPAN from the command line # without arguments, starts CPAN.pm shell cpan - # force install modules (usually those that fail tests) - cpan -f module_name [ module_name ... ] - - # install modules but without testing them - cpan -T module_name [ module_name ... ] - - # dump the configuration - cpan -J - - # load a different configuration to install Module::Foo - cpan -j some/other/file Module::Foo - # without arguments, but some switches - cpan [-ahrvACDlLO] + cpan [-ahpruvACDLOPX] =head1 DESCRIPTION @@ -73,7 +67,10 @@ Show the F<Changes> files for the specified modules =item -D module [ module ... ] -Show the module details. +Show the module details. This prints one line for each out-of-date module +(meaning, modules locally installed but have newer versions on CPAN). +Each line has three columns: module name, local version, and CPAN +version. =item -f @@ -110,13 +107,15 @@ distribution. Print a help message and exit. When you specify C<-h>, it ignores all of the other options and arguments. -=item -i +=item -i module [ module ... ] -Install the specified modules. +Install the specified modules. With no other switches, this switch +is implied. =item -I -Load C<local::lib> (think like C<-I> for loading lib paths). +Load C<local::lib> (think like C<-I> for loading lib paths). Too bad +C<-l> was already taken. =item -j Config.pm @@ -142,23 +141,38 @@ List the modules by the specified authors. Make the specified modules. +=item -M mirror1,mirror2,... + +A comma-separated list of mirrors to use for just this run. The C<-P> +option can find them for you automatically. + +=item -n + +Do a dry run, but don't actually install anything. (unimplemented) + =item -O Show the out-of-date modules. =item -p -Ping the configured mirrors +Ping the configured mirrors and print a report =item -P -Find the best mirrors you could be using (but doesn't configure them just yet) +Find the best mirrors you could be using and use them for the current +session. =item -r Recompiles dynamically loaded modules with CPAN::Shell->recompile. -=item -t +=item -s + +Drop in the CPAN.pm shell. This command does this automatically if you don't +specify any arguments. + +=item -t module [ module ... ] Run a `make test` on the specified modules. @@ -186,6 +200,16 @@ UNIMPLEMENTED Turn on cpan warnings. This checks various things, like directory permissions, and tells you about problems you might have. +=item -x module [ module ... ] + +Find close matches to the named modules that you think you might have +mistyped. This requires the optional installation of Text::Levenshtein or +Text::Levenshtein::Damerau. + +=item -X + +Dump all the namespaces to standard output. + =back =head2 Examples @@ -211,9 +235,10 @@ and tells you about problems you might have. # force install modules ( must use -i ) cpan -fi CGI::Minimal URI -=head1 ENVIRONMENT VARIABLES + # install modules but without testing them + cpan -Ti CGI::Minimal URI -=over 4 +=head2 Environment variables There are several components in CPAN.pm that use environment variables. The build tools, L<ExtUtils::MakeMaker> and L<Module::Build> use some, @@ -226,11 +251,21 @@ Oslo Concensus: L<https://github.com/Perl-Toolchain-Gang/toolchain-site/blob/mas =over 4 +=item NONINTERACTIVE_TESTING + +Assume no one is paying attention and skips prompts for distributions +that do that correctly. C<cpan(1)> sets this to C<1> unless it already +has a value (even if that value is false). + +=item PERL_MM_USE_DEFAULT + +Use the default answer for a prompted questions. C<cpan(1)> sets this +to C<1> unless it already has a value (even if that value is false). + =item CPAN_OPTS -C<cpan> splits this variable on whitespace and prepends that list to C<@ARGV> -before it processes the command-line arguments. For instance, if you always -want to use C<local:lib>, you can set C<CPAN_OPTS> to C<-I>. +As with C<PERL5OPTS>, a string of additional C<cpan(1)> options to +add to those you specify on the command line. =item CPANSCRIPT_LOGLEVEL @@ -244,19 +279,6 @@ C<ERROR>, and C<FATAL>. The default is C<INFO>. The path to the C<git> binary to use for the Git features. The default is C</usr/local/bin/git>. -=item NONINTERACTIVE_TESTING - -Assume no one is paying attention and skips prompts for distributions -that do that correctly. C<cpan(1)> sets this to C<1> unless it already -has a value (even if that value is false). - -=item PERL_MM_USE_DEFAULT - -Use the default answer for a prompted questions. C<cpan(1)> sets this -to C<1> unless it already has a value (even if that value is false). - -=back - =back =head1 EXIT VALUES @@ -312,7 +334,7 @@ brian d foy, C<< <bdfoy@cpan.org> >> =head1 COPYRIGHT -Copyright (c) 2001-2014, brian d foy, All Rights Reserved. +Copyright (c) 2001-2015, brian d foy, All Rights Reserved. You may redistribute this under the same terms as Perl itself. |