Skip Menu |
 

This queue is for tickets about the CPANPLUS CPAN distribution.

Report information
The Basics
Id: 39566
Status: stalled
Priority: 0/
Queue: CPANPLUS

People
Owner: Nobody in particular
Requestors: mgrimes [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Normal
Broken in: (no value)
Fixed in: (no value)

Attachments


Subject: [New feature] Automate the selection of mirrors (with patch)
Download (untitled) / with headers
text/plain 664b
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
RT-Send-CC: adamk [...] cpan.org
Download (untitled) / with headers
text/plain 1.3k
Hi Mark, On Tue Sep 23 23:12:52 2008, MGRIMES wrote: Show quoted text
> 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.
Actually, that's a really cool feature and I'd love to have something like that. In fact, Adam Kennedy has been working on something similar (cc'd for this purpose): http://search.cpan.org/~adamk/Mirror-YAML-0.03/lib/Mirror/YAML.pm Which he's hoping to introduce into strawberry perl and perl-5.10, making both CPAN & CPANPLUS use it. The work left on M::Yaml is to reduce the dependencies to stuff only in core. Perhaps there's mileage in getting together with Adam and fleshing out this module. I for one would happily bundle it and welcome it to core, and i think so would Andreas. Thanks for a great idea, and I hope we can apply this soon. Cheers,


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.