| Subject: | [New feature] Automate the selection of mirrors (with patch) |
Hi,
I was recently inspired by the "rankmirrors" script that is part of Arch
Linux to automate the CPAN mirror selection process. It was actually
pretty quick feature to add so I have included a patch. The patch is
pretty straight forward and constrained to changes in one place in
CPANPLUS::Configure::Setup. It works very well in my limited testing,
but it is not perfect. The included comments highlight the couple of
areas that need to be addressed before this is production worthy.
I would be happy to continue to clean it up, but I wanted to solicit
some feedback before burning any more calories on it.
Hope others find this interesting.
Regards,
Mark
| Subject: | cpanplus-0.84-autoselect-mirror.patch |
diff -Naur CPANPLUS-0.84/lib/CPANPLUS/Configure/Setup.pm CPANPLUS-mvg/lib/CPANPLUS/Configure/Setup.pm
--- CPANPLUS-0.84/lib/CPANPLUS/Configure/Setup.pm 2007-06-20 06:54:32.000000000 -0700
+++ CPANPLUS-mvg/lib/CPANPLUS/Configure/Setup.pm 2008-09-23 19:45:32.927731500 -0700
@@ -1171,6 +1171,97 @@
}
CHOICE: {
+
+ # Download the README file from the hosts in the selected
+ # country and compare download speed. Pick the fasted 5
+ # mirrors.
+ # TODO: only offer this if we have LWP installed, if
+ # File::Fetch tries more than one method, the timeout
+ # feature doesn't work and this could take way too long
+ SCAN: {
+
+ print loc( sprintf( "
+Would you like me to scan the %d mirrors in the selected country to
+see which are the fasted? This might take a while.
+", scalar keys %map) );
+ my $yn = $term->ask_yn(
+ prompt => loc("Network scan?"),
+ default => 'y',
+ );
+ last SCAN unless $yn;
+
+ # These are either core or already a prereq (I believe)
+ # They should probably be moved to the top of the file,
+ # but I have kept them here so everything is in one place
+ use File::Fetch;
+ use Time::HiRes;
+ use File::Temp;
+
+ $|++; # turn off buffering so the user can monitor
+ my %speed; # hash to hold speeds for each host
+ my $count = 0; # number of hosts examined, debug only
+
+ print loc( "\nExamining download speed for: (errors can be ignored)\n" );
+ while( my ($mirror, $con) = each %map ){
+ print "$mirror....";
+
+ # TODO: these should be saved first and reset
+ # this may not be portable, see C..::Internals::Fetch
+ $File::Fetch::TIMEOUT = 5;
+ $File::Fetch::WARN = 0;
+ # remove all but lwp so we don't try multiple methods
+ $File::Fetch::BLACKLIST = [qw{file wget curl lynx netftp ncftp ftp rsync}];
+
+ my $uri = sprintf "%s://%s%s%s",
+ @{$con}{ 'scheme', 'host', 'path' }, 'README';
+ my $fetcher = File::Fetch->new( uri => $uri );
+ my $tmp_dir = File::Temp::tempdir();
+ my $tmp_file = File::Spec->catfile( $tmp_dir, 'README' );
+
+ # Download the README file and calculate elapsed time
+ my $start = Time::HiRes::time;
+ my $result;
+ eval { $result = $fetcher->fetch( to => $tmp_dir ) }
+ or $result = undef;
+ my $elapsed = Time::HiRes::time - $start;
+ my $size = -s $tmp_file;
+
+ # Check both result and size to make sure we didn't
+ # d/l an empty file
+ if( $result and $size > 1024 ){
+ my $bps = $size / $elapsed;
+ printf "%.2f b/s", $bps;
+ $speed{$mirror} = $bps;
+ } else {
+ if( $result ){
+ print loc( "error in download size" );
+ } else {
+ print loc( "error\n " ) . $fetcher->error;
+ }
+ }
+
+ unlink $tmp_file;
+ rmdir $tmp_dir;
+
+ print "\n";
+ last if $count++ > 10; # debuging only
+ }
+
+ # Sort %speed highest to lowest by value
+ my @fastest = sort { $speed{$b} <=> $speed{$a} }
+ keys %speed;
+
+ # Use the top 5 fastest or all if there are less than 5
+ if( scalar @fastest > 4 ){
+ @hosts = map { $map{$_} } @fastest[0..4];
+ } else {
+ @hosts = map { $map{$_} } @fastest;
+ }
+
+ $self->_view_hosts(@hosts);
+ last CHOICE;
+ }
+
### doesn't play nice with Term::UI :(
### should make t::ui figure out pager opens