#!/usr/bin/perl ########################################## ## ## ## NOTE: This is just a prototype for ## ## the "real" program to do this ## ## crazy thing. ## ## ## ########################################## # abigail@www.iaf.nl says # time^$$ sometimes equals (time + 1)^($$ + 1). srand (time^(($$ << 15) + 3 * $$ + 1)); @ARGV = '/CPAN/CPAN.html' unless @ARGV; #($path = $ENV{PATH_INFO} || '') =~ s,^/,,; #$\ = "$path\n"; $\ = "\n"; while (<>) { next unless /Registered CPAN sites/ .. /<\/PRE/; while (/< \s* A \s+ HREF \s* = \s* (["']) (.*?) \1 > /gsix) { print $ARGV if substr($2, 0, 1) eq '#'; $site = $2; $site =~ s/(ftp.leo.org)/$1.de/; push @sites, $site; $sites{$site} = $count++; } } unless ( $host = $ENV{REMOTE_HOST} ) { for (reverse @sites) { fix_n_print($_); } exit; } while ($host) { $host =~ s/\w+\.// || ($host = 'com'); if ($host =~ /^(com|edu|org|net)$/ ) { $host = '(com|edu|org|net)'; } if (@found = grep m($host/), @sites) { @sites = @found; last; } } if (!@found) { @found = @sites } # randomize anyway if (@found > 1) { @unsort = (); while (@sites) { push @unsort, splice(@sites, $i = int rand @sites, 1); } @sites = @unsort; } if (@found) { delete $sites{$sites[0]}; fix_n_print(shift @sites); } # only the first is randomized for (reverse(@sites)) { fix_n_print($_); delete $sites{$_}; } #for (sortbyend (keys %sites)) { for (sort { $sites{$b} <=> $sites{$a} } keys %sites) { fix_n_print($_); } sub sortbyend { my @list = @_; my @index = (); for (@list) { my @names = reverse split /\./; push @index, uc sprintf "%-20s " x @names, @names; } return @list[ sort { $index[$a] cmp $index[$b] } 0 .. $#list ]; } sub fix_n_print { local $_ = shift; s/(ftp.leo.org)\.de/$1/; print; }