Update CPAN to CPAN version 1.9800

  [DELTA]

  2011-08-07  Andreas J. Koenig  <andk@cpan.org>

  * release 1.9800

  * RT #69463: fix memory leak in CacheMgr (Serguei Trouchelle)

  2011-06-27  Andreas J. Koenig  <andk@cpan.org>

  * release 1.97_51

  * address #68835: Changed read_meta to ignore dynamic_config (David Golden)

  * bugfix: refuse to store_persistent if the own build_dir is not
  available (Andreas Koenig)

  * cosmetics: remove "Going to" from the beginning of user-visible
  strings (Jesse Vincent)

  * flock adjustments for Win32 from activestate (Christian Walde)

15 files changed, 764 insertions, 411 deletions

diff --git a/cpan/CPAN/Changes b/cpan/CPAN/Changes
index 0c1776a4e6..7c4e56ed90 100644
--- a/cpan/CPAN/Changes
+++ b/cpan/CPAN/Changes
@@ -1,3 +1,23 @@
+2011-08-07  Andreas J. Koenig  <andk@cpan.org>
+
+	* release 1.9800
+
+	* RT #69463: fix memory leak in CacheMgr (Serguei Trouchelle)
+
+2011-06-27  Andreas J. Koenig  <andk@cpan.org>
+
+	* release 1.97_51
+
+	* address #68835: Changed read_meta to ignore dynamic_config (David Golden)
+
+	* bugfix: refuse to store_persistent if the own build_dir is not
+	available (Andreas Koenig)
+
+	* cosmetics: remove "Going to" from the beginning of user-visible
+	strings (Jesse Vincent)
+
+	* flock adjustments for Win32 from activestate (Christian Walde)
+
 2011-03-12  Andreas J. Koenig  <andk@cpan.org>
 
 	* release 1.9600
diff --git a/cpan/CPAN/lib/App/Cpan.pm b/cpan/CPAN/lib/App/Cpan.pm
index cfc12908e5..0fce3d3ec1 100644
--- a/cpan/CPAN/lib/App/Cpan.pm
+++ b/cpan/CPAN/lib/App/Cpan.pm
@@ -19,11 +19,11 @@ App::Cpan - easily interact with CPAN from the command line
 
 	# use local::lib
 	cpan -l module_name [ module_name ... ]
-	
+
 	# with just the dot, install from the distribution in the
 	# current directory
 	cpan .
-	
+
 	# without arguments, starts CPAN.pm shell
 	cpan
 
@@ -73,7 +73,7 @@ to install a module even if its tests fail. When you use this option,
 
 =item -F
 
-Turn off CPAN.pm's attempts to lock anything. You should be careful with 
+Turn off CPAN.pm's attempts to lock anything. You should be careful with
 this since you might end up with multiple scripts trying to muck in the
 same directory. This isn't so much of a concern if you're loading a special
 config with C<-j>, and that config sets up its own work directories.
@@ -105,7 +105,7 @@ Install the specified modules.
 =item -j Config.pm
 
 Load the file that has the CPAN configuration data. This should have the
-same format as the standard F<CPAN/Config.pm> file, which defines 
+same format as the standard F<CPAN/Config.pm> file, which defines
 C<$CPAN::Config> as an anonymous hash.
 
 =item -J
@@ -188,27 +188,27 @@ use File::Basename;
 
 use Getopt::Std;
 
-# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 # Internal constants
 use constant TRUE  => 1;
 use constant FALSE => 0;
 
 
-# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 # The return values
-use constant HEY_IT_WORKED              =>   0; 
+use constant HEY_IT_WORKED              =>   0;
 use constant I_DONT_KNOW_WHAT_HAPPENED  =>   1; # 0b0000_0001
 use constant ITS_NOT_MY_FAULT           =>   2;
 use constant THE_PROGRAMMERS_AN_IDIOT   =>   4;
 use constant A_MODULE_FAILED_TO_INSTALL =>   8;
 
 
-# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 # set up the order of options that we layer over CPAN::Shell
 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 g G C A D O l L a r j: J );
 
 $Default = 'default';
@@ -227,7 +227,7 @@ $Default = 'default';
 @option_order = ( @META_OPTIONS, @CPAN_OPTIONS );
 
 
-# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 # map switches to the subroutines in this script, along with other information.
 # use this stuff instead of hard-coded indices and values
 sub NO_ARGS   () { 0 }
@@ -249,7 +249,7 @@ sub GOOD_EXIT () { 0 }
 	# 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' ],
-	
+
 	C =>  [ \&_show_Changes,         ARGS, GOOD_EXIT, 'Showing Changes file'         ],
 	A =>  [ \&_show_Author,          ARGS, GOOD_EXIT, 'Showing Author'               ],
 	D =>  [ \&_show_Details,         ARGS, GOOD_EXIT, 'Showing Details'              ],
@@ -278,7 +278,7 @@ sub GOOD_EXIT () { 0 }
 	);
 }
 
-# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 # finally, do some argument processing
 
 sub _stupid_interface_hack_for_non_rtfmers
@@ -286,17 +286,17 @@ sub _stupid_interface_hack_for_non_rtfmers
 	no warnings 'uninitialized';
 	shift @ARGV if( $ARGV[0] eq 'install' and @ARGV > 1 )
 	}
-	
+
 sub _process_options
 	{
 	my %options;
-	
+
 	# if no arguments, just drop into the shell
 	if( 0 == @ARGV ) { CPAN::shell(); exit 0 }
 	else
 		{
 		Getopt::Std::getopts(
-		  join( '', @option_order ), \%options );    
+		  join( '', @option_order ), \%options );
 		 \%options;
 		}
 	}
@@ -304,7 +304,7 @@ sub _process_options
 sub _process_setup_options
 	{
 	my( $class, $options ) = @_;
-	
+
 	if( $options->{j} )
 		{
 		$Method_table{j}[ $Method_table_index{code} ]->( $options->{j} );
@@ -318,7 +318,7 @@ sub _process_setup_options
 			write_file => 0,
 			);
 		}
-		
+
 	if( $options->{F} )
 		{
 		$Method_table{F}[ $Method_table_index{code} ]->( $options->{F} );
@@ -328,7 +328,7 @@ sub _process_setup_options
 	my $option_count = grep { $options->{$_} } @option_order;
 	no warnings 'uninitialized';
 	$option_count -= $options->{'f'}; # don't count force
-	
+
 	# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 	# if there are no options, set -i (this line fixes RT ticket 16915)
 	$options->{i}++ unless $option_count;
@@ -339,7 +339,7 @@ sub _process_setup_options
 
 Just do it.
 
-The C<run> method returns 0 on success and a postive number on 
+The C<run> method returns 0 on success and a postive number on
 failure. See the section on EXIT CODES for details on the values.
 
 =cut
@@ -367,10 +367,10 @@ sub run
 	$class->_process_setup_options( $options );
 
 	OPTION: foreach my $option ( @option_order )
-		{	
+		{
 		next unless $options->{$option};
 
-		my( $sub, $takes_args, $description ) = 
+		my( $sub, $takes_args, $description ) =
 			map { $Method_table{$option}[ $Method_table_index{$_} ] }
 			qw( code takes_args );
 
@@ -382,7 +382,7 @@ sub run
 
 		$logger->info( "$description -- ignoring other arguments" )
 			if( @ARGV && ! $takes_args );
-		
+
 		$return_value = $sub->( \ @ARGV, $options );
 
 		last;
@@ -402,33 +402,33 @@ sub DESTROY { 1 }
 sub _init_logger
 	{
 	my $log4perl_loaded = eval "require Log::Log4perl; 1";
-	
+
     unless( $log4perl_loaded )
         {
         $logger = Local::Null::Logger->new;
         return $logger;
         }
-	
+
 	my $LEVEL = $ENV{CPANSCRIPT_LOGLEVEL} || 'INFO';
-	
+
 	Log::Log4perl::init( \ <<"HERE" );
 log4perl.rootLogger=$LEVEL, A1
 log4perl.appender.A1=Log::Log4perl::Appender::Screen
 log4perl.appender.A1.layout=PatternLayout
 log4perl.appender.A1.layout.ConversionPattern=%m%n
 HERE
-	
+
 	$logger = Log::Log4perl->get_logger( 'App::Cpan' );
 	}
-	
-# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
- # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
-# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
+
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+ # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 
 sub _default
 	{
 	my( $args, $options ) = @_;
-	
+
 	my $switch = '';
 
 	# choose the option that we're going to use
@@ -458,12 +458,12 @@ sub _default
 		if( $options->{f} ) { sub { CPAN::Shell->force( $method, @_ ) } }
 		else                { sub { CPAN::Shell->$method( @_ )        } }
 		};
-	
+
 	# How do I handle exit codes for multiple arguments?
 	my $errors = 0;
-	
-	foreach my $arg ( @$args ) 
-		{		
+
+	foreach my $arg ( @$args )
+		{
 		_clear_cpanpm_output();
 		$action->( $arg );
 
@@ -473,7 +473,7 @@ sub _default
 	$errors ? I_DONT_KNOW_WHAT_HAPPENED : HEY_IT_WORKED;
 	}
 
-# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 
 =for comment
 
@@ -488,7 +488,7 @@ my $scalar = '';
 sub _hook_into_CPANpm_report
 	{
 	no warnings 'redefine';
-	
+
 	*CPAN::Shell::myprint = sub {
 		my($self,$what) = @_;
 		$scalar .= $what if defined $what;
@@ -500,15 +500,15 @@ sub _hook_into_CPANpm_report
 	*CPAN::Shell::mywarn = sub {
 		my($self,$what) = @_;
 		$scalar .= $what if defined $what;
-		$self->print_ornamented($what, 
+		$self->print_ornamented($what,
 			$CPAN::Config->{colorize_warn}||'bold red on_white'
 			);
 		};
 
 	}
-	
+
 sub _clear_cpanpm_output { $scalar = '' }
-	
+
 sub _get_cpanpm_output   { $scalar }
 
 BEGIN {
@@ -522,9 +522,9 @@ my @skip_lines = (
 sub _get_cpanpm_last_line
 	{
 	open my($fh), "<", \ $scalar;
-	
+
 	my @lines = <$fh>;
-	
+
     # This is a bit ugly. Once we examine a line, we have to
     # examine the line before it and go through all of the same
     # regexes. I could do something fancy, but this works.
@@ -538,9 +538,9 @@ sub _get_cpanpm_last_line
             }
 		}
     }
-    
+
     $logger->debug( "Last interesting line of CPAN.pm output is:\n\t$lines[-1]" );
-    
+
 	$lines[-1];
 	}
 }
@@ -548,28 +548,28 @@ sub _get_cpanpm_last_line
 BEGIN {
 my $epic_fail_words = join '|',
 	qw( Error stop(?:ping)? problems force not unsupported fail(?:ed)? );
-	
+
 sub _cpanpm_output_indicates_failure
 	{
 	my $last_line = _get_cpanpm_last_line();
-	
+
 	my $result = $last_line =~ /\b(?:$epic_fail_words)\b/i;
 	$result || ();
 	}
 }
-	
+
 sub _cpanpm_output_indicates_success
 	{
 	my $last_line = _get_cpanpm_last_line();
-	
+
 	my $result = $last_line =~ /\b(?:\s+-- OK|PASS)\b/;
 	$result || ();
 	}
-	
+
 sub _cpanpm_output_is_vague
 	{
-	return FALSE if 
-		_cpanpm_output_indicates_failure() || 
+	return FALSE if
+		_cpanpm_output_indicates_failure() ||
 		_cpanpm_output_indicates_success();
 
 	return TRUE;
@@ -577,24 +577,24 @@ sub _cpanpm_output_is_vague
 
 }
 
-# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 sub _print_help
 	{
 	$logger->info( "Use perldoc to read the documentation" );
 	exec "perldoc $0";
 	}
-	
+
 sub _print_version
 	{
-	$logger->info( 
+	$logger->info(
 		"$0 script version $VERSION, CPAN.pm version " . CPAN->VERSION );
 
 	return HEY_IT_WORKED;
 	}
-	
+
 sub _create_autobundle
 	{
-	$logger->info( 
+	$logger->info(
 		"Creating autobundle in $CPAN::Config->{cpan_home}/Bundle" );
 
 	CPAN::Shell->autobundle;
@@ -621,24 +621,24 @@ sub _upgrade
 	}
 
 sub _load_config # -j
-	{	
+	{
 	my $file = shift || '';
-	
+
 	# should I clear out any existing config here?
 	$CPAN::Config = {};
 	delete $INC{'CPAN/Config.pm'};
 	croak( "Config file [$file] does not exist!\n" ) unless -e $file;
-	
+
 	my $rc = eval "require '$file'";
 
 	# CPAN::HandleConfig::require_myconfig_or_config looks for this
 	$INC{'CPAN/MyConfig.pm'} = 'fake out!';
-	
+
 	# CPAN::HandleConfig::load looks for this
 	$CPAN::Config_loaded = 'fake out';
-	
+
 	croak( "Could not load [$file]: $@\n") unless $rc;
-	
+
 	return HEY_IT_WORKED;
 	}
 
@@ -646,60 +646,60 @@ sub _dump_config
 	{
 	my $args = shift;
 	require Data::Dumper;
-	
+
 	my $fh = $args->[0] || \*STDOUT;
-		
-	my $dd = Data::Dumper->new( 
-		[$CPAN::Config], 
-		['$CPAN::Config'] 
+
+	my $dd = Data::Dumper->new(
+		[$CPAN::Config],
+		['$CPAN::Config']
 		);
-		
+
 	print $fh $dd->Dump, "\n1;\n__END__\n";
-	
+
 	return HEY_IT_WORKED;
 	}
 
 sub _lock_lobotomy
 	{
 	no warnings 'redefine';
-	
+
 	*CPAN::_flock    = sub { 1 };
 	*CPAN::checklock = sub { 1 };
 
 	return HEY_IT_WORKED;
 	}
-	
+
 sub _download
-	{	
+	{
 	my $args = shift;
-	
+
 	local $CPAN::DEBUG = 1;
-	
+
 	my %paths;
-	
+
 	foreach my $module ( @$args )
 		{
 		$logger->info( "Checking $module" );
 		my $path = CPAN::Shell->expand( "Module", $module )->cpan_file;
-		
+
 		$logger->debug( "Inst file would be $path\n" );
-		
+
 		$paths{$module} = _get_file( _make_path( $path ) );
 		}
-		
+
 	return \%paths;
 	}
 
 sub _make_path { join "/", qw(authors id), $_[0] }
-	
+
 sub _get_file
 	{
 	my $path = shift;
-	
+
 	my $loaded = eval "require LWP::Simple; 1;";
 	croak "You need LWP::Simple to use features that fetch files from CPAN\n"
 		unless $loaded;
-	
+
 	my $file = substr $path, rindex( $path, '/' ) + 1;
 	my $store_path = catfile( cwd(), $file );
 	$logger->debug( "Store path is $store_path" );
@@ -717,13 +717,13 @@ sub _get_file
 sub _gitify
 	{
 	my $args = shift;
-	
+
 	my $loaded = eval "require Archive::Extract; 1;";
 	croak "You need Archive::Extract to use features that gitify distributions\n"
 		unless $loaded;
-	
+
 	my $starting_dir = cwd();
-	
+
 	foreach my $module ( @$args )
 		{
 		$logger->info( "Checking $module" );
@@ -731,23 +731,23 @@ sub _gitify
 
 		my $store_paths = _download( [ $module ] );
 		$logger->debug( "gitify Store path is $store_paths->{$module}" );
-		my $dirname = dirname( $store_paths->{$module} );	
-	
+		my $dirname = dirname( $store_paths->{$module} );
+
 		my $ae = Archive::Extract->new( archive => $store_paths->{$module} );
 		$ae->extract( to => $dirname );
-		
+
 		chdir $ae->extract_path;
-		
+
 		my $git = $ENV{GIT_COMMAND} || '/usr/local/bin/git';
 		croak "Could not find $git"    unless -e $git;
 		croak "$git is not executable" unless -x $git;
-		
+
 		# can we do this in Pure Perl?
 		system( $git, 'init'    );
 		system( $git, qw( add . ) );
 		system( $git, qw( commit -a -m ), 'initial import' );
 		}
-	
+
 	chdir $starting_dir;
 
 	return HEY_IT_WORKED;
@@ -756,42 +756,42 @@ sub _gitify
 sub _show_Changes
 	{
 	my $args = shift;
-	
+
 	foreach my $arg ( @$args )
 		{
 		$logger->info( "Checking $arg\n" );
-		
+
 		my $module = eval { CPAN::Shell->expand( "Module", $arg ) };
 		my $out = _get_cpanpm_output();
-		
+
 		next unless eval { $module->inst_file };
 		#next if $module->uptodate;
-	
+
 		( my $id = $module->id() ) =~ s/::/\-/;
-	
+
 		my $url = "http://search.cpan.org/~" . lc( $module->userid ) . "/" .
 			$id . "-" . $module->cpan_version() . "/";
-	
+
 		#print "URL: $url\n";
 		_get_changes_file($url);
 		}
 
 	return HEY_IT_WORKED;
-	}	
-	
+	}
+
 sub _get_changes_file
 	{
 	croak "Reading Changes files requires LWP::Simple and URI\n"
 		unless eval "require LWP::Simple; require URI; 1";
-	
+
     my $url = shift;
 
     my $content = LWP::Simple::get( $url );
     $logger->info( "Got $url ..." ) if defined $content;
 	#print $content;
-	
+
 	my( $change_link ) = $content =~ m|<a href="(.*?)">Changes</a>|gi;
-	
+
 	my $changes_url = URI->new_abs( $change_link, $url );
  	$logger->debug( "Change link is: $changes_url" );
 
@@ -801,11 +801,11 @@ sub _get_changes_file
 
 	return HEY_IT_WORKED;
 	}
-	
+
 sub _show_Author
-	{	
+	{
 	my $args = shift;
-	
+
 	foreach my $arg ( @$args )
 		{
 		my $module = CPAN::Shell->expand( "Module", $arg );
@@ -814,29 +814,29 @@ sub _show_Author
 			$logger->info( "Didn't find a $arg module, so no author!" );
 			next;
 			}
-			
+
 		my $author = CPAN::Shell->expand( "Author", $module->userid );
-	
+
 		next unless $module->userid;
-	
-		printf "%-25s %-8s %-25s %s\n", 
+
+		printf "%-25s %-8s %-25s %s\n",
 			$arg, $module->userid, $author->email, $author->fullname;
 		}
 
 	return HEY_IT_WORKED;
-	}	
+	}
 
 sub _show_Details
 	{
 	my $args = shift;
-	
+
 	foreach my $arg ( @$args )
 		{
 		my $module = CPAN::Shell->expand( "Module", $arg );
 		my $author = CPAN::Shell->expand( "Author", $module->userid );
-	
+
 		next unless $module->userid;
-	
+
 		print "$arg\n", "-" x 73, "\n\t";
 		print join "\n\t",
 			$module->description ? $module->description : "(no description)",
@@ -848,26 +848,26 @@ sub _show_Details
 			$author->fullname . " (" . $module->userid . ")",
 			$author->email;
 		print "\n\n";
-		
+
 		}
-		
+
 	return HEY_IT_WORKED;
-	}	
+	}
 
 sub _show_out_of_date
 	{
 	my @modules = CPAN::Shell->expand( "Module", "/./" );
-		
+
 	printf "%-40s  %6s  %6s\n", "Module Name", "Local", "CPAN";
 	print "-" x 73, "\n";
-	
+
 	foreach my $module ( @modules )
 		{
 		next unless $module->inst_file;
 		next if $module->uptodate;
 		printf "%-40s  %.4f  %.4f\n",
-			$module->id, 
-			$module->inst_version ? $module->inst_version : '', 
+			$module->id,
+			$module->inst_version ? $module->inst_version : '',
 			$module->cpan_version;
 		}
 
@@ -879,71 +879,71 @@ sub _show_author_mods
 	my $args = shift;
 
 	my %hash = map { lc $_, 1 } @$args;
-	
+
 	my @modules = CPAN::Shell->expand( "Module", "/./" );
-	
+
 	foreach my $module ( @modules )
 		{
 		next unless exists $hash{ lc $module->userid };
 		print $module->id, "\n";
 		}
-	
+
 	return HEY_IT_WORKED;
 	}
-	
+
 sub _list_all_mods
 	{
 	require File::Find;
-	
+
 	my $args = shift;
-	
-	
+
+
 	my $fh = \*STDOUT;
-	
+
 	INC: foreach my $inc ( @INC )
-		{		
+		{
 		my( $wanted, $reporter ) = _generator();
 		File::Find::find( { wanted => $wanted }, $inc );
-		
+
 		my $count = 0;
 		FILE: foreach my $file ( @{ $reporter->() } )
 			{
 			my $version = _parse_version_safely( $file );
-			
+
 			my $module_name = _path_to_module( $inc, $file );
 			next FILE unless defined $module_name;
-			
+
 			print $fh "$module_name\t$version\n";
-			
+
 			#last if $count++ > 5;
 			}
 		}
 
 	return HEY_IT_WORKED;
 	}
-	
+
 sub _generator
-	{			
+	{
 	my @files = ();
-	
-	sub { push @files, 
-		File::Spec->canonpath( $File::Find::name ) 
+
+	sub { push @files,
+		File::Spec->canonpath( $File::Find::name )
 		if m/\A\w+\.pm\z/ },
 	sub { \@files },
 	}
-	
+
 sub _parse_version_safely # stolen from PAUSE's mldistwatch, but refactored
 	{
 	my( $file ) = @_;
-	
+
 	local $/ = "\n";
 	local $_; # don't mess with the $_ in the map calling this
-	
+
 	return unless open FILE, "<$file";
 
 	my $in_pod = 0;
 	my $version;
-	while( <FILE> ) 
+	while( <FILE> )
 		{
 		chomp;
 		$in_pod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $in_pod;
@@ -951,22 +951,22 @@ sub _parse_version_safely # stolen from PAUSE's mldistwatch, but refactored
 
 		next unless /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/;
 		my( $sigil, $var ) = ( $1, $2 );
-		
+
 		$version = _eval_version( $_, $sigil, $var );
 		last;
 		}
 	close FILE;
 
 	return 'undef' unless defined $version;
-	
+
 	return $version;
 	}
 
 sub _eval_version
 	{
 	my( $line, $sigil, $var ) = @_;
-	
-	my $eval = qq{ 
+
+	my $eval = qq{
 		package ExtUtils::MakeMaker::_version;
 
 		local $sigil$var;
@@ -974,7 +974,7 @@ sub _eval_version
 			$line
 			}; \$$var
 		};
-		
+
 	my $version = do {
 		local $^W = 0;
 		no strict;
@@ -988,16 +988,16 @@ sub _path_to_module
 	{
 	my( $inc, $path ) = @_;
 	return if length $path< length $inc;
-	
+
 	my $module_path = substr( $path, length $inc );
 	$module_path =~ s/\.pm\z//;
-	
+
 	# XXX: this is cheating and doesn't handle everything right
 	my @dirs = grep { ! /\W/ } File::Spec->splitdir( $module_path );
 	shift @dirs;
-	
+
 	my $module_name = join "::", @dirs;
-	
+
 	return $module_name;
 	}
 
@@ -1007,7 +1007,7 @@ sub _path_to_module
 
 =head1 EXIT VALUES
 
-The script exits with zero if it thinks that everything worked, or a 
+The script exits with zero if it thinks that everything worked, or a
 positive number if it thinks that something failed. Note, however, that
 in some cases it has to divine a failure by the output of things it does
 not control. For now, the exit codes are vague:
diff --git a/cpan/CPAN/lib/CPAN.pm b/cpan/CPAN/lib/CPAN.pm
index e36cf09e31..4e1f2a3018 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 = '1.9600';
+$CPAN::VERSION = '1.9800';
 $CPAN::VERSION =~ s/_//;
 
 # we need to run chdir all over and we would get at wrong libraries
@@ -37,6 +37,7 @@ use CPAN::Shell;
 use CPAN::LWP::UserAgent;
 use CPAN::Exception::RecursiveDependency;
 use CPAN::Exception::yaml_not_installed;
+use CPAN::Exception::yaml_process_error;
 
 use Carp ();
 use Config ();
@@ -1069,7 +1070,7 @@ sub has_usable {
                                             # don't die, because we may need
                                             # Archive::Tar to upgrade
                                             }
-                                            
+
                                        }
                                   },
                                  ],
@@ -1469,14 +1470,14 @@ mentioned four. Each of the four entities is implemented as a class
 with slightly differing methods for displaying an object.
 
 Arguments to these commands are either strings exactly matching
-the identification string of an object, or regular expressions 
+the identification string of an object, or regular expressions
 matched case-insensitively against various attributes of the
 objects. The parser only recognizes a regular expression when you
 enclose it with slashes.
 
 The principle is that the number of objects found influences how an
 item is displayed. If the search finds one item, the result is
-displayed with the rather verbose method C<as_string>, but if 
+displayed with the rather verbose method C<as_string>, but if
 more than one is found, each object is displayed with the terse method
 C<as_glimpse>.
 
@@ -1588,7 +1589,7 @@ being executed within the distribution file's working directory.
 C<readme> displays the README file of the associated distribution.
 C<Look> gets and untars (if not yet done) the distribution file,
 changes to the appropriate directory and opens a subshell process in
-that directory. C<perldoc> displays the module's pod documentation 
+that directory. C<perldoc> displays the module's pod documentation
 in html or plain text format.
 
 =item C<ls> author
@@ -1699,8 +1700,11 @@ literal backslash.
 C<autobundle> writes a bundle file into the
 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
 a list of all modules that are both available from CPAN and currently
-installed within @INC. The name of the bundle file is based on the
-current date and a counter.
+installed within @INC. Duplicates of each distribution are suppressed.
+The name of the bundle file is based on the current date and a
+counter.
+
+Return value: path to the written file.
 
 =head2 hosts
 
@@ -1718,10 +1722,35 @@ mkmyconfig() writes your own CPAN::MyConfig file into your C<~/.cpan/>
 directory so that you can save your own preferences instead of the
 system-wide ones.
 
+=head2 r [Module|/Regexp/]...
+
+scans current perl installation for modules that have a newer version
+available on CPAN and provides a list of them. If called without
+argument, all potential upgrades are listed; if called with arguments
+the list is filtered to the modules and regexps given as arguments.
+
+The listing looks something like this:
+
+  Package namespace         installed    latest  in CPAN file
+  CPAN                        1.94_64    1.9600  ANDK/CPAN-1.9600.tar.gz
+  CPAN::Reporter               1.1801    1.1902  DAGOLDEN/CPAN-Reporter-1.1902.tar.gz
+  YAML                           0.70      0.73  INGY/YAML-0.73.tar.gz
+  YAML::Syck                     1.14      1.17  AVAR/YAML-Syck-1.17.tar.gz
+  YAML::Tiny                     1.44      1.50  ADAMK/YAML-Tiny-1.50.tar.gz
+  CGI                            3.43      3.55  MARKSTOS/CGI.pm-3.55.tar.gz
+  Module::Build::YAML            1.40      1.41  DAGOLDEN/Module-Build-0.3800.tar.gz
+  TAP::Parser::Result::YAML      3.22      3.23  ANDYA/Test-Harness-3.23.tar.gz
+  YAML::XS                       0.34      0.35  INGY/YAML-LibYAML-0.35.tar.gz
+
+It suppresses duplicates in the column C<in CPAN file> such that
+distributions with many upgradeable modules are listed only once.
+
+Note that the list is not sorted.
+
 =head2 recent ***EXPERIMENTAL COMMAND***
 
 The C<recent> command downloads a list of recent uploads to CPAN and
-displays them I<slowly>. While the command is running, a $SIG{INT} 
+displays them I<slowly>. While the command is running, a $SIG{INT}
 exits the loop after displaying the current item.
 
 B<Note>: This command requires XML::LibXML installed.
@@ -1776,7 +1805,7 @@ approach will likely remain.
 
 B<Note>: See also L<recent>
 
-=head2 upgrade [Module|/Regex/]...
+=head2 upgrade [Module|/Regexp/]...
 
 The C<upgrade> command first runs an C<r> command with the given
 arguments and then installs the newest versions of all modules that
@@ -1895,7 +1924,7 @@ Example:
   o conf shell
 
 If KEY starts and ends with a slash, the string in between is
-treated as a regular expression and only keys matching this regex
+treated as a regular expression and only keys matching this regexp
 are displayed
 
 Example:
@@ -1998,7 +2027,7 @@ currently defined:
   inactivity_timeout breaks interactive Makefile.PLs or Build.PLs
                      after this many seconds inactivity. Set to 0 to
                      disable timeouts.
-  index_expire       refetch index files after this many days 
+  index_expire       refetch index files after this many days
   inhibit_startup_message
                      if true, suppress the startup message
   keep_source_where  directory in which to keep the source (if we do)
@@ -2192,7 +2221,7 @@ randomness into the URL selection.
 Since CPAN.pm version 1.88_51 modules declared as C<build_requires> by
 a distribution are treated differently depending on the config
 variable C<build_requires_install_policy>. By setting
-C<build_requires_install_policy> to C<no>, such a module is not 
+C<build_requires_install_policy> to C<no>, such a module is not
 installed. It is only built and tested, and then kept in the list of
 tested but uninstalled modules. As such, it is available during the
 build of the dependent module by integrating the path to the
@@ -2246,7 +2275,7 @@ temporarily override assorted C<CPAN.pm> configuration variables
 
 =item
 
-specify dependencies the original maintainer forgot 
+specify dependencies the original maintainer forgot
 
 =item
 
@@ -2583,7 +2612,7 @@ needs. You have been warned:-)
 
 =head1 PROGRAMMER'S INTERFACE
 
-If you do not enter the shell, shell commands are 
+If you do not enter the shell, shell commands are
 available both as methods (C<CPAN::Shell-E<gt>install(...)>) and as
 functions in the calling package (C<install(...)>).  Before calling low-level
 commands, it makes sense to initialize components of CPAN you need, e.g.:
@@ -2596,9 +2625,20 @@ High-level commands do such initializations automatically.
 
 There's currently only one class that has a stable interface -
 CPAN::Shell. All commands that are available in the CPAN shell are
-methods of the class CPAN::Shell. Each of the commands that produce
-listings of modules (C<r>, C<autobundle>, C<u>) also return a list of
-the IDs of all modules within the list.
+methods of the class CPAN::Shell. The arguments on the commandline are
+passed as arguments to the method.
+
+So if you take for example the shell command
+
+  notest install A B C
+
+the actually executed command is
+
+  CPAN::Shell->notest("install","A","B","C");
+
+Each of the commands that produce listings of modules (C<r>,
+C<autobundle>, C<u>) also return a list of the IDs of all modules
+within the list.
 
 =over 2
 
@@ -2650,7 +2690,7 @@ all modules that need updating. First a quick and dirty way:
 If you don't want any output should all modules be
 up to date, parse the output of above command for the regular
 expression C</modules are up to date/> and decide to mail the output
-only if it doesn't match. 
+only if it doesn't match.
 
 If you prefer to do it more in a programmerish style in one single
 process, something like this may better suit you:
@@ -2837,7 +2877,7 @@ cancellation can be avoided by letting C<force> run the C<install> for
 you.
 
 This install method only has the power to install the distribution if
-there are no dependencies in the way. To install an object along with all 
+there are no dependencies in the way. To install an object along with all
 its dependencies, use CPAN::Shell->install.
 
 Note that install() gives no meaningful return value. See uptodate().
@@ -3231,7 +3271,7 @@ the software producing the indices on CPAN, the mirroring process on CPAN,
 packaging, configuration, synchronicity, and even (gasp!) due to bugs
 within the CPAN.pm module itself.
 
-For debugging the code of CPAN.pm itself in interactive mode, some 
+For debugging the code of CPAN.pm itself in interactive mode, some
 debugging aid can be turned on for most packages within
 CPAN.pm with one of
 
@@ -3387,7 +3427,7 @@ Maintaining a bundle definition file means keeping track of two
 things: dependencies and interactivity. CPAN.pm sometimes fails on
 calculating dependencies because not all modules define all MakeMaker
 attributes correctly, so a bundle definition file should specify
-prerequisites as early as possible. On the other hand, it's 
+prerequisites as early as possible. On the other hand, it's
 annoying that so many distributions need some interactive configuring. So
 what you can try to accomplish in your private bundle file is to have the
 packages that need to be configured early in the file and the gentle
@@ -3432,7 +3472,7 @@ need Net::FTP.
 
 =item One-way visibility
 
-One-way visibility means these firewalls try to make themselves 
+One-way visibility means these firewalls try to make themselves
 invisible to users inside the firewall. An FTP data connection is
 normally created by sending your IP address to the remote server and then
 listening for the return connection. But the remote server will not be able to
diff --git a/cpan/CPAN/lib/CPAN/CacheMgr.pm b/cpan/CPAN/lib/CPAN/CacheMgr.pm
index b9b4eeb32b..23e756e75b 100644
--- a/cpan/CPAN/lib/CPAN/CacheMgr.pm
+++ b/cpan/CPAN/lib/CPAN/CacheMgr.pm
@@ -49,6 +49,7 @@ sub tidyup {
     $self->_clean_cache($toremove);
     return if $CPAN::Signal;
   }
+  $self->{FIFO} = [];
 }
 
 #-> sub CPAN::CacheMgr::dir ;
diff --git a/cpan/CPAN/lib/CPAN/Distribution.pm b/cpan/CPAN/lib/CPAN/Distribution.pm
index b39e723fd2..32648ecc1f 100644
--- a/cpan/CPAN/lib/CPAN/Distribution.pm
+++ b/cpan/CPAN/lib/CPAN/Distribution.pm
@@ -158,7 +158,7 @@ sub tested_ok_but_not_installed {
             ||
             $self->{install}->failed
            )
-    ); 
+    );
 }
 
 
@@ -584,7 +584,8 @@ EOF
 
 #-> sub CPAN::Distribution::pick_meta_file ;
 sub pick_meta_file {
-    my($self, $yaml) = @_;
+    my($self, $filter) = @_;
+    $filter = '.' unless defined $filter;
 
     my $build_dir;
     unless ($build_dir = $self->{build_dir}) {
@@ -602,7 +603,7 @@ sub pick_meta_file {
     push @choices, 'META.json' if $has_cm;
     push @choices, 'META.yml' if $has_cm || $has_pcm;
 
-    for my $file ( @choices ) {
+    for my $file ( grep { /$filter/ } @choices ) {
         my $path = File::Spec->catdir( $build_dir, $file );
         return $path if -f $path
     }
@@ -740,7 +741,7 @@ sub choose_MM_or_MB {
                 $prefer_installer = CPAN::HandleConfig->prefs_lookup(
                   $self, q{prefer_installer}
                 );
-                # M::B <= 0.35 left a DATA handle open that 
+                # M::B <= 0.35 left a DATA handle open that
                 # causes problems upgrading M::B on Windows
                 close *Module::Build::Version::DATA
                   if fileno *Module::Build::Version::DATA;
@@ -776,6 +777,12 @@ sub choose_MM_or_MB {
 sub store_persistent_state {
     my($self) = @_;
     my $dir = $self->{build_dir};
+    unless (defined $dir && length $dir) {
+        my $id = $self->id;
+        $CPAN::Frontend->mywarnonce("build_dir of $id is not known, ".
+                                    "will not store persistent state\n");
+        return;
+    }
     unless (File::Spec->canonpath(File::Basename::dirname($dir))
             eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
         $CPAN::Frontend->mywarnonce("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
@@ -858,7 +865,7 @@ sub try_download {
                 }
             }
             my $countedpatches = @$patches == 1 ? "1 patch" : (scalar @$patches . " patches");
-            $CPAN::Frontend->myprint("Going to apply $countedpatches:\n");
+            $CPAN::Frontend->myprint("Applying $countedpatches:\n");
             my $patches_dir = $CPAN::Config->{patches_dir};
             for my $patch (@$patches) {
                 if ($patches_dir && !File::Spec->file_name_is_absolute($patch)) {
@@ -1844,7 +1851,7 @@ is part of the perl-%s distribution. To install that, you need to run
         delete $self->{force_update};
         return;
     }
-    $CPAN::Frontend->myprint("\n  CPAN.pm: Going to build ".$self->id."\n\n");
+    $CPAN::Frontend->myprint("\n  CPAN.pm: Building ".$self->id."\n\n");
     $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
 
     if ($^O eq 'MacOS') {
@@ -2843,8 +2850,7 @@ sub _fulfills_all_version_rqs {
 }
 
 #-> sub CPAN::Distribution::read_meta
-# read any sort of meta files, return CPAN::Meta object if no errors and
-# dynamic_config = 0
+# read any sort of meta files, return CPAN::Meta object if no errors
 sub read_meta {
     my($self) = @_;
     my $meta_file = $self->pick_meta_file
@@ -2862,9 +2868,6 @@ sub read_meta {
         return if $eummv < 6.2501;
     }
 
-    # META/MYMETA is only authoritative if dynamic_config is false
-    return if $meta->dynamic_config;
-
     return $meta;
 }
 
@@ -2889,8 +2892,8 @@ sub read_yaml {
         if $CPAN::DEBUG;
     $self->debug($yaml) if $CPAN::DEBUG && $yaml;
     # MYMETA.yml is static and authoritative by definition
-    if ( $meta_file =~ /MYMETA\.yml/ ) { 
-      return $yaml; 
+    if ( $meta_file =~ /MYMETA\.yml/ ) {
+      return $yaml;
     }
     # META.yml is authoritative only if dynamic_config is defined and false
     if ( defined $yaml->{dynamic_config} && ! $yaml->{dynamic_config} ) {
@@ -2903,7 +2906,7 @@ sub read_yaml {
 #-> sub CPAN::Distribution::configure_requires ;
 sub configure_requires {
     my($self) = @_;
-    return unless my $meta_file = $self->pick_meta_file;
+    return unless my $meta_file = $self->pick_meta_file('^META');
     if (my $meta_obj = $self->read_meta) {
         my $prereqs = $meta_obj->effective_prereqs;
         my $cr = $prereqs->requirements_for(qw/configure requires/);
@@ -2929,7 +2932,9 @@ sub prereq_pm {
                 $self->{modulebuild}||"",
                ) if $CPAN::DEBUG;
     my($req,$breq);
-    if (my $meta_obj = $self->read_meta) {
+    my $meta_obj = $self->read_meta;
+    # META/MYMETA is only authoritative if dynamic_config is false
+    if ($meta_obj && ! $meta_obj->dynamic_config) {
         my $prereqs = $meta_obj->effective_prereqs;
         my $requires = $prereqs->requirements_for(qw/runtime requires/);
         my $build_requires = $prereqs->requirements_for(qw/build requires/);
@@ -3168,7 +3173,7 @@ sub test {
         # bypass actual tests if "trust_test_report_history" and have a report
         my $have_tested_fcn;
         if (   $CPAN::Config->{trust_test_report_history}
-            && $CPAN::META->has_inst("CPAN::Reporter::History") 
+            && $CPAN::META->has_inst("CPAN::Reporter::History")
             && ( $have_tested_fcn = CPAN::Reporter::History->can("have_tested" ))) {
             if ( my @reports = $have_tested_fcn->( dist => $self->base_id ) ) {
                 # Do nothing if grade was DISCARD
@@ -3288,43 +3293,43 @@ sub test {
 
 sub _make_test_illuminate_prereqs {
     my($self) = @_;
-            my @prereq;
-
-            # local $CPAN::DEBUG = 16; # Distribution
-            for my $m (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
-                # $ENV{PERL5LIB} so that already tested but not yet
-                # installed modules are counted.
-                my $available_version = $m_obj->available_version;
-                my $available_file = $m_obj->available_file;
-                if ($available_version &&
-                    !CPAN::Version->vlt($available_version,$self->{prereq_pm}{$m})
-                   ) {
-                    CPAN->debug("m[$m] good enough available_version[$available_version]")
-                        if $CPAN::DEBUG;
-                } elsif ($available_file
-                         && (
-                             !$self->{prereq_pm}{$m}
-                             ||
-                             $self->{prereq_pm}{$m} == 0
-                            )
-                        ) {
-                    # lex Class::Accessor::Chained::Fast which has no $VERSION
-                    CPAN->debug("m[$m] have available_file[$available_file]")
-                        if $CPAN::DEBUG;
-                } else {
-                    push @prereq, $m;
-                }
-            }
+    my @prereq;
+
+    # local $CPAN::DEBUG = 16; # Distribution
+    for my $m (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
+        # $ENV{PERL5LIB} so that already tested but not yet
+        # installed modules are counted.
+        my $available_version = $m_obj->available_version;
+        my $available_file = $m_obj->available_file;
+        if ($available_version &&
+            !CPAN::Version->vlt($available_version,$self->{prereq_pm}{$m})
+           ) {
+            CPAN->debug("m[$m] good enough available_version[$available_version]")
+                if $CPAN::DEBUG;
+        } elsif ($available_file
+                 && (
+                     !$self->{prereq_pm}{$m}
+                     ||
+                     $self->{prereq_pm}{$m} == 0
+                    )
+                ) {
+            # lex Class::Accessor::Chained::Fast which has no $VERSION
+            CPAN->debug("m[$m] have available_file[$available_file]")
+                if $CPAN::DEBUG;
+        } else {
+            push @prereq, $m;
+        }
+    }
     my $but;
-            if (@prereq) {
-                my $cnt = @prereq;
-                my $which = join ",", @prereq;
+    if (@prereq) {
+        my $cnt = @prereq;
+        my $which = join ",", @prereq;
         $but = $cnt == 1 ? "one dependency not OK ($which)" :
-                    "$cnt dependencies missing ($which)";
-            }
+            "$cnt dependencies missing ($which)";
+    }
     $but;
 }
 
@@ -3670,7 +3675,7 @@ sub perldoc {
             $CPAN::Frontend->myprint(qq{
     Function system("@args")
     returned status $estatus (wstat $wstatus)
-    });	
+    });
         }
     }
     else {
diff --git a/cpan/CPAN/lib/CPAN/Distroprefs.pm b/cpan/CPAN/lib/CPAN/Distroprefs.pm
index e1be9cdf74..61c389ed2d 100644
--- a/cpan/CPAN/lib/CPAN/Distroprefs.pm
+++ b/cpan/CPAN/lib/CPAN/Distroprefs.pm
@@ -169,7 +169,7 @@ sub find {
             file => $_, ext => $ext, dir => $dir
         });
         # copied from CPAN.pm; is this ever actually possible?
-        redo unless -f $result->abs; 
+        redo unless -f $result->abs;
 
         my $load_method = $self->_load_method($loader, $result);
         my @prefs = eval { $self->$load_method($loader, $result) };
@@ -314,7 +314,7 @@ __END__
 
 CPAN::Distroprefs -- read and match distroprefs
 
-=head1 SYNOPSIS 
+=head1 SYNOPSIS
 
     use CPAN::Distroprefs;
 
@@ -381,7 +381,7 @@ All results share some common attributes:
 
 C<success>, C<warning>, or C<fatal>
 
-=head3 file 
+=head3 file
 
 the file from which these prefs were read, or to which this error refers (relative filename)
 
@@ -413,7 +413,7 @@ Success results contain:
 
 an arrayref of CPAN::Distroprefs::Pref objects
 
-=head1 PREFS 
+=head1 PREFS
 
 CPAN::Distroprefs::Pref objects represent individual distroprefs documents.
 They are constructed automatically as part of C<success> results from C<find()>.
diff --git a/cpan/CPAN/lib/CPAN/Exception/yaml_not_installed.pm b/cpan/CPAN/lib/CPAN/Exception/yaml_not_installed.pm
index e1259e5397..1e7fa83a53 100644
--- a/cpan/CPAN/lib/CPAN/Exception/yaml_not_installed.pm
+++ b/cpan/CPAN/lib/CPAN/Exception/yaml_not_installed.pm
@@ -20,54 +20,4 @@ sub as_string {
     "'$self->{module}' not installed, cannot $self->{during} '$self->{file}'\n";
 }
 
-package CPAN::Exception::yaml_process_error;
-use strict;
-use overload '""' => "as_string";
-
-use vars qw(
-            $VERSION
-);
-$VERSION = "5.5";
-
-
-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";
-    }
-}
-
 1;
diff --git a/cpan/CPAN/lib/CPAN/Exception/yaml_process_error.pm b/cpan/CPAN/lib/CPAN/Exception/yaml_process_error.pm
new file mode 100644
index 0000000000..ae8c14ebeb
--- /dev/null
+++ b/cpan/CPAN/lib/CPAN/Exception/yaml_process_error.pm
@@ -0,0 +1,53 @@
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
+# vim: ts=4 sts=4 sw=4:
+package CPAN::Exception::yaml_process_error;
+use strict;
+use overload '""' => "as_string";
+
+use vars qw(
+            $VERSION
+);
+$VERSION = "5.5";
+
+
+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";
+    }
+}
+
+1;
diff --git a/cpan/CPAN/lib/CPAN/FTP.pm b/cpan/CPAN/lib/CPAN/FTP.pm
index 4f233814e5..997e141be5 100644
--- a/cpan/CPAN/lib/CPAN/FTP.pm
+++ b/cpan/CPAN/lib/CPAN/FTP.pm
@@ -21,6 +21,11 @@ $VERSION = "5.5005";
 sub _ftp_statistics {
     my($self,$fh) = @_;
     my $locktype = $fh ? LOCK_EX : LOCK_SH;
+    # XXX On Windows flock() implements mandatory locking, so we can
+    # XXX only use shared locking to still allow _yaml_load_file() to
+    # XXX read from the file using a different filehandle.
+    $locktype = LOCK_SH if $^O eq "MSWin32";
+
     $fh ||= FileHandle->new;
     my $file = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
     mkpath dirname $file;
@@ -56,6 +61,7 @@ sub _ftp_statistics {
             $CPAN::Frontend->mydie($@);
         }
     }
+    CPAN::_flock($fh, LOCK_UN);
     return $stats->[0];
 }
 
@@ -567,7 +573,7 @@ sub hostdleasy { #called from hostdlxxx
                 $ThesiteURL = $ro_url;
                 return $l;
             }
-            # If request is for a compressed file and we can find the 
+            # If request is for a compressed file and we can find the
             # uncompressed file also, return the path of the uncompressed file
             # otherwise, decompress it and return the resulting path
             if ($l =~ /(.+)\.gz$/) {
@@ -975,7 +981,7 @@ ftp config variable with
   Trying with external ftp to get
     '$url'
   $netrc_explain
-  Going to send the dialog
+  Sending the dialog
 $dialog
 }
                 );
@@ -1014,7 +1020,7 @@ $dialog
         $CPAN::Frontend->myprint(qq{
   Trying with external ftp to get
     $url
-  Going to send the dialog
+  Sending the dialog
 $dialog
 }
         );
diff --git a/cpan/CPAN/lib/CPAN/FirstTime.pm b/cpan/CPAN/lib/CPAN/FirstTime.pm
index 667bdca2f9..5030ef9b83 100644
--- a/cpan/CPAN/lib/CPAN/FirstTime.pm
+++ b/cpan/CPAN/lib/CPAN/FirstTime.pm
@@ -202,8 +202,8 @@ Preferred method for determining the current working directory?
 =item halt_on_failure
 
 Normally, CPAN.pm continues processing the full list of targets and
-dependencies, even if one of them fails.  However, you can specify 
-that CPAN should halt after the first failure. 
+dependencies, even if one of them fails.  However, you can specify
+that CPAN should halt after the first failure.
 
 Do you want to halt on failure (yes/no)?
 
@@ -339,7 +339,7 @@ Your choice:
 Parameters for the './Build install' command? Typical frequently used
 setting:
 
-    --uninst 1                           # uninstall conflicting files
+    --uninst 1       # uninstall conflicting files
                      # (but do NOT use with local::lib or INSTALL_BASE)
 
 Your choice:
@@ -781,8 +781,8 @@ sub init {
     if ( $args{autoconfig} ) {
         $auto_config = 1;
     } elsif ($matcher) {
-            $auto_config = 0;
-        } else {
+        $auto_config = 0;
+    } else {
         my $_conf = prompt($prompts{auto_config}, "yes");
         $auto_config = ($_conf and $_conf =~ /^y/i) ? 1 : 0;
     }
@@ -795,7 +795,7 @@ sub init {
             my $i_am_mad = 0;
             # silent prompting -- just quietly use default
             *_real_prompt = sub { return $_[1] };
-        }
+    }
 
     #
     # bootstrap local::lib or sudo
@@ -993,8 +993,8 @@ sub init {
         my_dflt_prompt(makepl_arg => "", $matcher);
         my_dflt_prompt(make_arg => "", $matcher);
         if ( $CPAN::Config->{makepl_arg} =~ /LIBS=|INC=/ ) {
-            $CPAN::Frontend->mywarn( 
-                "Warning: Using LIBS or INC in makepl_arg will likely break distributions\n" . 
+            $CPAN::Frontend->mywarn(
+                "Warning: Using LIBS or INC in makepl_arg will likely break distributions\n" .
                 "that specify their own LIBS or INC options in Makefile.PL.\n"
             );
         }
@@ -1224,9 +1224,9 @@ sub init {
             );
         }
         else {
-          $CPAN::Frontend->myprint(
-            "Autoconfigured everything but 'urllist'.\n"
-          );
+            $CPAN::Frontend->myprint(
+                "Autoconfigured everything but 'urllist'.\n"
+            );
             _do_pick_mirrors();
         }
     }
@@ -1247,8 +1247,8 @@ sub init {
             $CPAN::Frontend->myprint(
                 "Skipping local::lib bootstrap because 'urllist' is not configured.\n"
             );
-          }
-          else {
+        }
+        else {
             $CPAN::Frontend->myprint("\nAttempting to bootstrap local::lib...\n");
             $CPAN::Frontend->myprint("\nWriting $configpm for bootstrap...\n");
             delete $CPAN::Config->{install_help}; # temporary only
@@ -1268,11 +1268,11 @@ sub init {
                 $CPAN::Frontend->myprint("From the CPAN Shell, you might try 'look local::lib' and \n"
                     . "run 'perl Makefile --bootstrap' and see if that is successful.  Then\n"
                     . "restart your CPAN client\n"
-            );
+                );
             }
             else {
                 _local_lib_config();
-          }
+            }
         }
     }
 
@@ -1515,7 +1515,7 @@ ALERT: 'make' is an essential tool for building perl Modules.
 Please make sure you have 'make' (or some equivalent) working.
 
 HERE
-                    if ($^O eq "MSWin32") {
+  if ($^O eq "MSWin32") {
     $CPAN::Frontend->mywarn(<<"HERE");
 Windows users may want to follow this procedure when back in the CPAN shell:
 
@@ -1528,7 +1528,7 @@ substitute. You can then revisit this dialog with
     o conf init make
 
 HERE
-    }
+  }
 }
 
 sub init_cpan_home {
@@ -1657,7 +1657,7 @@ sub my_prompt_loop {
 # (2) We don't have a copy at all
 #   (2a) If we are allowed to connect, we try to get a new copy.  If it succeeds,
 #        we use it, otherwise, we warn about failure
-#   (2b) If we aren't allowed to connect, 
+#   (2b) If we aren't allowed to connect,
 
 sub conf_sites {
     my %args = @_;
@@ -1732,7 +1732,7 @@ HERE
       }
       else {
         $CPAN::Frontend->mywarn(<<'HERE');
-You will need to provide CPAN mirror URLs yourself or set 
+You will need to provide CPAN mirror URLs yourself or set
 'o conf connect_to_internet_ok 1' and try again.
 HERE
       }
@@ -1851,7 +1851,9 @@ sub auto_mirrored_by {
     my $local = shift or return;
     local $|=1;
     $CPAN::Frontend->myprint("Looking for CPAN mirrors near you (please be patient)\n");
-    my $mirrors = CPAN::Mirrors->new($local);
+    my $mirrors = CPAN::Mirrors->new;
+    $mirrors->parse_mirrored_by($local);
+
     my $cnt = 0;
     my @best = $mirrors->best_mirrors(
       how_many => 3,
@@ -1860,9 +1862,11 @@ sub auto_mirrored_by {
           if ($cnt++>60) { $cnt=0; $CPAN::Frontend->myprint("\n"); }
       },
     );
+
     my $urllist = [ map { $_->http } @best ];
     push @$urllist, grep { /^file:/ } @{$CPAN::Config->{urllist}};
     $CPAN::Frontend->myprint(" done!\n\n");
+
     return $urllist
 }
 
@@ -1998,8 +2002,8 @@ later if you\'re sure it\'s right.\n},
 sub _print_urllist {
     my ($which) = @_;
     $CPAN::Frontend->myprint("$which urllist\n");
-    for ( @{$CPAN::Config->{urllist} || []} ) { 
-      $CPAN::Frontend->myprint("  $_\n") 
+    for ( @{$CPAN::Config->{urllist} || []} ) {
+      $CPAN::Frontend->myprint("  $_\n")
     };
 }
 
diff --git a/cpan/CPAN/lib/CPAN/HTTP/Client.pm b/cpan/CPAN/lib/CPAN/HTTP/Client.pm
index 52de7fe237..c5eb0f6a43 100644
--- a/cpan/CPAN/lib/CPAN/HTTP/Client.pm
+++ b/cpan/CPAN/lib/CPAN/HTTP/Client.pm
@@ -31,8 +31,8 @@ sub mirror {
     my($self, $uri, $path) = @_;
 
     my $want_proxy = $self->_want_proxy($uri);
-    my $http = HTTP::Tiny->new( 
-        $want_proxy ? (proxy => $self->{proxy}) : () 
+    my $http = HTTP::Tiny->new(
+        $want_proxy ? (proxy => $self->{proxy}) : ()
     );
 
     my ($response, %headers);
@@ -112,7 +112,7 @@ sub _get_challenge {
     my $auth_list = $response->{headers}(lc $auth_header);
     return unless defined $auth_list;
     $auth_list = [$auth_list] unless ref $auth_list;
-    
+
     for my $challenge (@$auth_list) {
         $challenge =~ tr/,/;/;  # "," is used to separate auth-params!!
         ($challenge) = $self->split_header_words($challenge);
diff --git a/cpan/CPAN/lib/CPAN/HandleConfig.pm b/cpan/CPAN/lib/CPAN/HandleConfig.pm
index 58ccbe50e5..09c42efee0 100644
--- a/cpan/CPAN/lib/CPAN/HandleConfig.pm
+++ b/cpan/CPAN/lib/CPAN/HandleConfig.pm
@@ -265,11 +265,11 @@ sub commit {
     my($self,@args) = @_;
     CPAN->debug("args[@args]") if $CPAN::DEBUG;
     if ($CPAN::RUN_DEGRADED) {
-                             $CPAN::Frontend->mydie(
-                                                    "'o conf commit' disabled in ".
-                                                    "degraded mode. Maybe try\n".
-                                                    " !undef \$CPAN::RUN_DEGRADED\n"
-                                                   );
+        $CPAN::Frontend->mydie(
+            "'o conf commit' disabled in ".
+            "degraded mode. Maybe try\n".
+            " !undef \$CPAN::RUN_DEGRADED\n"
+        );
     }
     my ($configpm, $must_reload);
 
@@ -474,13 +474,13 @@ sub init {
 sub require_myconfig_or_config () {
     if (   $INC{"CPAN/MyConfig.pm"} || _try_loading("CPAN::MyConfig", cpan_home())) {
         return $INC{"CPAN/MyConfig.pm"};
-            }
+    }
     elsif ( $INC{"CPAN/Config.pm"} || _try_loading("CPAN::Config") ) {
         return $INC{"CPAN/Config.pm"};
-        }
+    }
     else {
         return q{};
-        }
+    }
 }
 
 # Load a module, but ignore "can't locate..." errors
@@ -495,8 +495,8 @@ sub _try_loading {
         if ( -f File::Spec->catfile($dir, $file) ) {
             unshift @INC, $dir;
             last;
+        }
     }
-      }
 
     eval { require $file };
     my $err_myconfig = $@;
@@ -515,7 +515,7 @@ sub cpan_home_dir_candidates {
         if ($^O ne 'darwin') {
             push @dirs, File::HomeDir->my_data;
             # my_data is ~/Library/Application Support on darwin,
-                                            # which causes issues in the toolchain.
+            # which causes issues in the toolchain.
         }
         push @dirs, File::HomeDir->my_home;
     }
@@ -592,7 +592,7 @@ sub make_new_config {
 Old configuration file $configpm
     moved to $configpm_bak
 END
-    }
+            }
         }
         my $fh = FileHandle->new;
         if ($fh->open(">$configpm")) {
diff --git a/cpan/CPAN/lib/CPAN/Index.pm b/cpan/CPAN/lib/CPAN/Index.pm
index 4fcde8c390..af98d7bf15 100644
--- a/cpan/CPAN/lib/CPAN/Index.pm
+++ b/cpan/CPAN/lib/CPAN/Index.pm
@@ -132,7 +132,7 @@ sub reanimate_build_dir {
         return;
     }
     $CPAN::Frontend->myprint
-        (sprintf("Going to read %d yaml file%s from %s/\n",
+        (sprintf("Reading %d yaml file%s from %s/\n",
                  scalar @candidates,
                  @candidates==1 ? "" : "s",
                  $CPAN::Config->{build_dir}
@@ -231,7 +231,7 @@ sub rd_authindex {
     return unless defined $index_target;
     return if CPAN::_sqlite_running();
     my @lines;
-    $CPAN::Frontend->myprint("Going to read '$index_target'\n");
+    $CPAN::Frontend->myprint("Reading '$index_target'\n");
     local(*FH);
     tie *FH, 'CPAN::Tarzip', $index_target;
     local($/) = "\n";
@@ -271,7 +271,7 @@ sub rd_modpacks {
     my($self, $index_target) = @_;
     return unless defined $index_target;
     return if CPAN::_sqlite_running();
-    $CPAN::Frontend->myprint("Going to read '$index_target'\n");
+    $CPAN::Frontend->myprint("Reading '$index_target'\n");
     my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
     local $_;
     CPAN->debug(sprintf "start[%d]", time) if $CPAN::DEBUG;
@@ -494,7 +494,7 @@ sub rd_modlist {
     my($cl,$index_target) = @_;
     return unless defined $index_target;
     return if CPAN::_sqlite_running();
-    $CPAN::Frontend->myprint("Going to read '$index_target'\n");
+    $CPAN::Frontend->myprint("Reading '$index_target'\n");
     my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
     local $_;
     my $slurp = "";
@@ -556,7 +556,7 @@ sub write_metadata_cache {
     $cache->{last_time} = $LAST_TIME;
     $cache->{DATE_OF_02} = $DATE_OF_02;
     $cache->{PROTOCOL} = PROTOCOL;
-    $CPAN::Frontend->myprint("Going to write $metadata_file\n");
+    $CPAN::Frontend->myprint("Writing $metadata_file\n");
     eval { Storable::nstore($cache, $metadata_file) };
     $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
 }
@@ -569,7 +569,7 @@ sub read_metadata_cache {
     return unless $CPAN::META->has_usable("Storable");
     my $metadata_file = File::Spec->catfile($CPAN::Config->{cpan_home},"Metadata");
     return unless -r $metadata_file and -f $metadata_file;
-    $CPAN::Frontend->myprint("Going to read '$metadata_file'\n");
+    $CPAN::Frontend->myprint("Reading '$metadata_file'\n");
     my $cache;
     eval { $cache = Storable::retrieve($metadata_file) };
     $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
diff --git a/cpan/CPAN/lib/CPAN/Mirrors.pm b/cpan/CPAN/lib/CPAN/Mirrors.pm
index 3582b0acb4..daafc1dbaf 100644
--- a/cpan/CPAN/lib/CPAN/Mirrors.pm
+++ b/cpan/CPAN/lib/CPAN/Mirrors.pm
@@ -1,5 +1,37 @@
 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
 # vim: ts=4 sts=4 sw=4:
+=head1 NAME
+
+CPAN::Mirrors - Get CPAN miror information and select a fast one
+
+=head1 SYNOPSIS
+
+	use CPAN::Mirrors;
+
+	my $mirrors = CPAN::Mirrors->new;
+	$mirrors->parse_from_file( $mirrored_by_file );
+
+	my $seen = {};
+
+	my $best_continent = $mirrors->find_best_continents( { seen => $seen } );
+	my @mirrors        = $mirrors->get_mirrors_by_continents( $best_continent );
+
+	my $callback = sub {
+		my( $m ) = @_;
+		printf "%s = %s\n", $m->hostname, $m->rtt
+		};
+	$mirrors->get_mirrors_timings( \@mirrors, $seen, $callback );
+
+	@mirrors = sort { $a->rtt <=> $b->rtt } @mirrors;
+
+	print "Best mirrors are ", map( { $_->rtt } @mirrors[0..3] ), "\n";
+
+=head1 DESCRIPTION
+
+=over
+
+=cut
+
 package CPAN::Mirrors;
 use strict;
 use vars qw($VERSION $urllist $silent);
@@ -10,31 +42,55 @@ use FileHandle;
 use Fcntl ":flock";
 use Net::Ping ();
 
+=item new( LOCAL_FILE_NAME )
+
+=cut
+
 sub new {
     my ($class, $file) = @_;
-    my $self = bless { 
-        mirrors => [], 
-        geography => {},
+    my $self = bless {
+        mirrors      => [],
+        geography    => {},
     }, $class;
 
+	if( defined $file ) {
+		$self->parse_mirrored_by( $file );
+	}
+
+    return $self
+}
+
+sub parse_mirrored_by {
+	my ($self, $file) = @_;
     my $handle = FileHandle->new;
-    $handle->open($file) 
+    $handle->open($file)
         or croak "Couldn't open $file: $!";
     flock $handle, LOCK_SH;
     $self->_parse($file,$handle);
     flock $handle, LOCK_UN;
     $handle->close;
+}
 
-    # populate continents & countries
+=item continents()
 
-    return $self
-}
+Return a list of continents based on those defined in F<MIRRORED.BY>.
+
+=cut
 
 sub continents {
     my ($self) = @_;
     return keys %{$self->{geography}};
 }
 
+=item countries( [CONTINENTS] )
+
+Return a list of countries based on those defined in F<MIRRORED.BY>.
+It only returns countries for the continents you specify (as defined
+in C<continents>). If you don't specify any continents, it returns all
+of the countries listed in F<MIRRORED.BY>.
+
+=cut
+
 sub countries {
     my ($self, @continents) = @_;
     @continents = $self->continents unless @continents;
@@ -45,6 +101,15 @@ sub countries {
     return @countries;
 }
 
+=item mirrors( [COUNTRIES] )
+
+Return a list of mirrors based on those defined in F<MIRRORED.BY>.
+It only returns mirrors for the countries you specify (as defined
+in C<countries>). If you don't specify any countries, it returns all
+of the mirrors listed in F<MIRRORED.BY>.
+
+=cut
+
 sub mirrors {
     my ($self, @countries) = @_;
     return @{$self->{mirrors}} unless @countries;
@@ -56,118 +121,300 @@ sub mirrors {
     return @found;
 }
 
+=item get_mirrors_by_countries( [COUNTRIES] )
+
+A more sensible synonym for mirrors.
+
+=cut
+
+sub get_mirrors_by_countries { &mirrors }
+
+=item get_mirrors_by_continents( [CONTINENTS] )
+
+Return a list of mirrors for all of continents you specify. If you don't
+specify any continents, it returns all of the mirrors.
+
+=cut
+
+sub get_mirrors_by_continents {
+	my ($self, $continents ) = @_;
+
+	$self->mirrors( $self->get_countries_by_continents( @$continents ) );
+	}
+
+=item get_countries_by_continents( [CONTINENTS] )
+
+A more sensible synonym for countries.
+
+=cut
+sub get_countries_by_continents { &countries }
+
+=item best_mirrors
+
+C<best_mirrors> checks for the best mirrors based on the list of
+continents you pass, or, without that, all continents, as defined
+by C<CPAN::Mirrored::By>. It pings each mirror, up to the value of
+C<how_many>. In list context, it returns up to C<how_many> mirror.
+In scalar context, it returns the single best mirror.
+
+Arguments
+
+	how_many   - the number of mirrors to return. Default: 1
+	callback   - a callback for find_best_continents
+	verbose    - true or false on all the whining and moaning. Default: false
+	continents - an array ref of the continents to check
+
+If you don't specify the continents, C<best_mirrors> calls
+C<find_best_continents> to get the list of continents to check.
+
+=cut
+
 sub best_mirrors {
     my ($self, %args) = @_;
-    my $how_many = $args{how_many} || 1;
-    my $callback = $args{callback};
-    my $verbose = $args{verbose};
-    my $conts = $args{continents} || [];
-    $conts = [$conts] unless ref $conts;
+    my $how_many      = $args{how_many} || 1;
+    my $callback      = $args{callback};
+    my $verbose       = defined $args{verbose} ? $args{verbose} : 0;
+    my $continents    = $args{continents} || [];
+       $continents    = [$continents] unless ref $continents;
 
     # Old Net::Ping did not do timings at all
     return "http://www.cpan.org/" unless Net::Ping->VERSION gt '2.13';
 
     my $seen = {};
 
-    if ( ! @$conts ) {
+    if ( ! @$continents ) {
         print "Searching for the best continent ...\n" if $verbose;
-        my @best = $self->_find_best_continent($seen, $verbose, $callback);
+        my @best_continents = $self->find_best_continents(
+        	seen     => $seen,
+        	verbose  => $verbose,
+        	callback => $callback,
+        	);
 
         # Only add enough continents to find enough mirrors
         my $count = 0;
-        for my $c ( @best ) {
-            push @$conts, $c;
-            $count += $self->mirrors( $self->countries($c) );
+        for my $continent ( @best_continents ) {
+            push @$continents, $continent;
+            $count += $self->mirrors( $self->countries($continent) );
             last if $count >= $how_many;
         }
     }
 
-    print "Scanning " . join(", ", @$conts) . " ...\n" if $verbose;
+    print "Scanning " . join(", ", @$continents) . " ...\n" if $verbose;
+
+	my $trial_mirrors = $self->get_n_random_mirrors_by_continents( 3 * $how_many, $continents->[0] );
+
+    my $timings = $self->get_mirrors_timings( $trial_mirrors, $seen, $callback );
+    return [] unless @$timings;
+
+    $how_many = @$timings if $how_many > @$timings;
+
+    return wantarray ? @{$timings}[0 .. $how_many-1] : $timings->[0];
+}
+
+=item get_n_random_mirrors_by_continents( N, [CONTINENTS]
+
+Returns up to N random mirrors for the specified continents. Specify the
+continents as an array reference.
+
+=cut
+
+sub get_n_random_mirrors_by_continents {
+	my( $self, $n, $continents ) = @_;
+	$n ||= 3;
+	$continents = [ $continents ] unless ref $continents;
 
-    my @timings;
-    my @long_list = $self->mirrors($self->countries(@$conts));
-    my $long_list_size = ( $how_many > 10 ? $how_many : 10 );
-    if ( @long_list > $long_list_size ) {
-        @long_list = map  {$_->[0]}
-                     sort {$a->[1] <=> $b->[1]}
-                     map  {[$_, rand]} @long_list;
-        splice @long_list, $long_list_size; # truncate
+    if ( $n <= 0 ) {
+    	return wantarray ? () : [];
     }
 
-    for my $m ( @long_list ) {
-        next unless $m->http;
-        my $hostname = $m->hostname;
-        if ( $seen->{$hostname}  ) {
-            push @timings, $seen->{$hostname}
-                if defined $seen->{$hostname}[1];
+    my @long_list = $self->get_mirrors_by_continents( $continents );
+
+    if ( $n eq '*' or $n > @long_list ) {
+    	return wantarray ? @long_list : \@long_list;
+    }
+
+	@long_list = map  {$_->[0]}
+	             sort {$a->[1] <=> $b->[1]}
+                 map  {[$_, rand]} @long_list;
+
+	splice @long_list, $n; # truncate
+
+	\@long_list;
+}
+
+=item get_mirrors_timings( MIRROR_LIST, SEEN, CALLBACK );
+
+Pings the listed mirrors and returns a list of mirrors sorted
+in ascending ping times.
+
+=cut
+
+sub get_mirrors_timings {
+	my( $self, $mirror_list, $seen, $callback ) = @_;
+
+	$seen = {} unless defined $seen;
+	croak "The mirror list argument must be an array reference"
+		unless ref $mirror_list eq ref [];
+	croak "The seen argument must be a hash reference"
+		unless ref $seen eq ref {};
+	croak "callback must be a subroutine"
+		if( defined $callback and ref $callback ne ref sub {} );
+
+	my $timings = [];
+    for my $m ( @$mirror_list ) {
+		$seen->{$m->hostname} = $m;
+		next unless eval{ $m->http };
+
+        if( $self->_try_a_ping( $seen, $m, ) ) {
+            my $ping = $m->ping;
+			next unless defined $ping;
+            push @$timings, $m;
+            $callback->( $m ) if $callback;
         }
         else {
-            my $ping = $m->ping;
-            next unless defined $ping;
-            push @timings, [$m, $ping];
-            $callback->($m,$ping) if $callback;
+            push @$timings, $seen->{$m->hostname}
+                if defined $seen->{$m->hostname}->rtt;
         }
     }
-    return unless @timings;
-
-    $how_many = @timings if $how_many > @timings;
-    my @best =
-        map  { $_->[0] }
-        sort { $a->[1] <=> $b->[1] } @timings;
 
-    return wantarray ? @best[0 .. $how_many-1] : $best[0];
+    my @best = sort {
+    	   if( defined $a->rtt and defined $b->rtt )     {
+    		$a->rtt <=> $b->rtt
+    		}
+    	elsif( defined $a->rtt and ! defined $b->rtt )   {
+    		return -1;
+    		}
+    	elsif( ! defined $a->rtt and defined $b->rtt )   {
+    		return 1;
+    		}
+    	elsif( ! defined $a->rtt and ! defined $b->rtt ) {
+    		return 0;
+    		}
+
+    	} @$timings;
+
+    return wantarray ? @best : \@best;
 }
 
-sub _find_best_continent {
-    my ($self, $seen, $verbose, $callback) = @_;
+=item find_best_continents( HASH_REF );
+
+C<find_best_continents> goes through each continent and pings C<N> random
+mirrors on that continent. It then orders the continents by ascending
+median ping time. In list context, it returns the ordered list of
+continent. In scalar context, it returns the same list as an anonymous
+array.
+
+Arguments:
+
+	n        - the number of hosts to ping for each continent. Default: 3
+	seen     - a hashref of cached hostname ping times
+	verbose  - true or false for noisy or quiet. Default: false
+	callback - a subroutine to run after each ping.
+	ping_cache_limit - how long, in seconds, to reuse previous ping times.
+		Default: 1 day
+
+The C<seen> hash has hostnames as keys and anonymous arrays as values. The
+anonymous array is a triplet of a C<CPAN::Mirrored::By> object, a ping
+time, and the epoch time for the measurement.
+
+The callback subroutine gets the C<CPAN::Mirrored::By> object, the ping
+time, and measurement time (the same things in the C<seen> hashref) as arguments.
+C<find_best_continents> doesn't care what the callback does and ignores the return
+value.
 
-    my %median;
+=cut
+
+sub find_best_continents {
+    my ($self, %args) = @_;
+
+	$args{n}     ||=  3;
+	$args{verbose} = 0 unless defined $args{verbose};
+	$args{seen}    = {} unless defined $args{seen};
+	croak "The seen argument must be a hash reference"
+		unless ref $args{seen} eq ref {};
+	$args{ping_cache_limit} = 24 * 60 * 60
+		unless defined $args{ping_cache_time};
+	croak "callback must be a subroutine"
+		if( defined $args{callback} and ref $args{callback} ne ref sub {} );
+
+    my %medians;
     CONT: for my $c ( $self->continents ) {
+    	print "Testing $c\n" if $args{verbose};
         my @mirrors = $self->mirrors( $self->countries($c) );
+
         next CONT unless @mirrors;
-        my $sample = 3;
-        my $n = (@mirrors < $sample) ? @mirrors : $sample;
+        my $n = (@mirrors < $args{n}) ? @mirrors : $args{n};
+
         my @tests;
-        RANDOM: while ( @mirrors && @tests < $n ) {
+        my $tries = 0;
+        RANDOM: while ( @mirrors && @tests < $n && $tries++ < 15 ) {
             my $m = splice( @mirrors, int(rand(@mirrors)), 1 );
-            my $ping = $m->ping;
-            $callback->($m,$ping) if $callback;
-            # record undef so we don't try again
-            $seen->{$m->hostname} = [$m, $ping];
-            next RANDOM unless defined $ping;
-            push @tests, $ping;
-        }
-        next CONT unless @tests;
-        @tests = sort { $a <=> $b } @tests;
-        if ( @tests == 1 ) {
-            $median{$c} = $tests[0];
-        }
-        elsif ( @tests % 2 ) {
-            $median{$c} = $tests[ int(@tests / 2) ];
-        }
-        else {
-            my $mid_high = int(@tests/2);
-            $median{$c} = ($tests[$mid_high-1] + $tests[$mid_high])/2;
+           if( $self->_try_a_ping( $args{seen}, $m, $args{ping_cache_limit} ) ) {
+				$self->get_mirrors_timings( [ $m ], @args{qw(seen callback)} );
+				next RANDOM unless defined $args{seen}{$m->hostname}->rtt;
+            }
+            printf "\t%s -> %0.2f ms\n",
+            	$m->hostname,
+            	join ' ', 1000 * $args{seen}{$m->hostname}->rtt
+            		if $args{verbose};
+
+			push @tests, $args{seen}{$m->hostname}->rtt;
         }
+
+		my $median = $self->_get_median_ping_time( \@tests, $args{verbose} );
+		$medians{$c} = $median if defined $median;
     }
 
-    my @best_cont = sort { $median{$a} <=> $median{$b} } keys %median ;
+    my @best_cont = sort { $medians{$a} <=> $medians{$b} } keys %medians;
 
-    if ( $verbose ) {
+    if ( $args{verbose} ) {
         print "Median result by continent:\n";
         for my $c ( @best_cont ) {
-            printf( "  %d ms  %s\n", int($median{$c}*1000+.5), $c );
+            printf( "  %4d ms  %s\n", int($medians{$c}*1000+.5), $c );
         }
     }
 
     return wantarray ? @best_cont : $best_cont[0];
 }
 
+# retry if
+sub _try_a_ping {
+	my ($self, $seen, $mirror, $ping_cache_limit ) = @_;
+
+	( ! exists $seen->{$mirror->hostname} )
+		or
+	(
+	! defined $seen->{$mirror->hostname}->rtt
+		or
+	time - $seen->{$mirror->hostname}->rtt > $ping_cache_limit
+	)
+}
+
+sub _get_median_ping_time {
+	my ($self, $tests, $verbose ) = @_;
+
+	my @sorted = sort { $a <=> $b } @$tests;
+
+	my $median = do {
+		   if ( @sorted == 0 ) { undef }
+		elsif ( @sorted == 1 ) { $sorted[0] }
+		elsif ( @sorted % 2 )  { $sorted[ int(@sorted / 2) ] }
+		else {
+			my $mid_high = int(@sorted/2);
+			($sorted[$mid_high-1] + $sorted[$mid_high])/2;
+		}
+	};
+
+	printf "\t-->median time: %0.2f ms\n", $median * 1000 if $verbose;
+
+    return $median;
+}
+
 # Adapted from Parse::CPAN::MirroredBy by Adam Kennedy
 sub _parse {
     my ($self, $file, $handle) = @_;
     my $output = $self->{mirrors};
-    my $geo = $self->{geography};
+    my $geo    = $self->{geography};
 
     local $/ = "\012";
     my $line = 0;
@@ -193,7 +440,7 @@ sub _parse {
             $mirror ||= {};
             if ( $prop eq 'dst_location' ) {
                 my (@location,$continent,$country);
-                @location = (split /\s*,\s*/, $value) 
+                @location = (split /\s*,\s*/, $value)
                     and ($continent, $country) = @location[-1,-2];
                 $continent =~ s/\s\(.*//;
                 $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
@@ -244,35 +491,61 @@ sub new {
     $arg ||= {};
     bless $arg, $self;
 }
-sub hostname { shift->{hostname} }
-sub continent { shift->{continent} }
-sub country { shift->{country} }
-sub http { shift->{http} || '' }
-sub ftp { shift->{ftp} || '' }
-sub rsync { shift->{rsync} || '' }
-
-sub url { 
+sub hostname  { shift->{hostname}    }
+sub continent { shift->{continent}   }
+sub country   { shift->{country}     }
+sub http      { shift->{http}  || '' }
+sub ftp       { shift->{ftp}   || '' }
+sub rsync     { shift->{rsync} || '' }
+sub rtt       { shift->{rtt}         }
+sub ping_time { shift->{ping_time}   }
+
+sub url {
     my $self = shift;
     return $self->{http} || $self->{ftp};
 }
 
 sub ping {
     my $self = shift;
+
     my $ping = Net::Ping->new("tcp",1);
     my ($proto) = $self->url =~ m{^([^:]+)};
     my $port = $proto eq 'http' ? 80 : 21;
     return unless $port;
-    if ( $ping->can('port_number') ) {
-    $ping->port_number($port);
+
+	if ( $ping->can('port_number') ) {
+        $ping->port_number($port);
     }
     else {
         $ping->{'port_num'} = $port;
     }
+
     $ping->hires(1) if $ping->can('hires');
     my ($alive,$rtt) = $ping->ping($self->hostname);
-    return $alive ? $rtt : undef;
+
+    $self->{rtt} = $alive ? $rtt : undef;
+    $self->{ping_time} = time;
+
+    $self->rtt;
 }
 
 
 1;
 
+=back
+
+=head1 AUTHOR
+
+Andreas Koenig C<< <andk@cpan.org> >>, David Golden C<< <dagolden@cpan.org> >>,
+brian d foy C<< <bdfoy@cpan.org> >>
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+
+
+=cut
diff --git a/cpan/CPAN/lib/CPAN/Shell.pm b/cpan/CPAN/lib/CPAN/Shell.pm
index 9effb0d2e7..21441df653 100644
--- a/cpan/CPAN/lib/CPAN/Shell.pm
+++ b/cpan/CPAN/lib/CPAN/Shell.pm
@@ -653,7 +653,7 @@ sub mkmyconfig {
             "CPAN::MyConfig already exists as $configpm.\n" .
             "Running configuration again...\n"
         );
-    require CPAN::FirstTime;
+        require CPAN::FirstTime;
         CPAN::FirstTime::init($configpm);
     }
     else {
@@ -1221,6 +1221,7 @@ sub autobundle {
     $fh->close;
     $CPAN::Frontend->myprint("\nWrote bundle file
     $to\n\n");
+    return $to;
 }
 
 #-> sub CPAN::Shell::expandany ;
@@ -1684,7 +1685,7 @@ sub rematein {
             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;
+                CPAN->debug("Testing against recursion") if $CPAN::DEBUG;
                 eval {  $obj->color_cmd_tmps(0,1); };
                 if ($@) {
                     if (ref $@
@@ -1847,7 +1848,7 @@ sub recent {
   my($self) = @_;
   if ($CPAN::META->has_inst("XML::LibXML")) {
       my $url = $CPAN::Defaultrecent;
-      $CPAN::Frontend->myprint("Going to fetch '$url'\n");
+      $CPAN::Frontend->myprint("Fetching '$url'\n");
       unless ($CPAN::META->has_usable("LWP")) {
           $CPAN::Frontend->mydie("LWP not installed; cannot continue");
       }
@@ -1935,7 +1936,7 @@ sub smoke {
     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");
+        $CPAN::Frontend->myprint(sprintf "Downloading and testing '$distro'\n");
         {
             my $skip = 0;
             local $SIG{INT} = sub { $skip = 1 };