#!/usr/bin/perl

# <short description of program>

    use strict;
    use warnings;

    use LWP::Simple;
    #use IO::Uncompress::Gunzip qw(gunzip);
    use Compress::Zlib;

    use Data::Dumper;
    #use Devel::Comments;           # uncomment this during development to enable the ### debugging statements

my $local = '/var/tmp/backpan.txt.gz';

getstore('http://www.astray.com/tmp/backpan.txt.gz', $local)
    unless (-e $local);


open PIN, "gzip -dc $local|"       or die $!;
#my $index = gunzip(get('http://www.astray.com/tmp/backpan.txt.gz'));
#my $index = uncompress(get('http://www.astray.com/tmp/backpan.txt.gz'));
#vim('', $index); exit;


my @files;
my %whole_line;
while (<PIN>) {
    chomp;
    my ($file, $timestamp, $bytes) = split ' ';
    #print ">>$_\n";

    next if /^modules\//;
    next if /perl-2007-1/;      # this gets parsed below as v2.007_01

    $whole_line{$file} = $_;

    if ($file =~ /
            \/perl                  # the filename must start with perl
            [^a-z0-9\/]*[0-57-9]    # there must be a digit after 'perl' (but not '6', because we're ignoring Perl6 compat modules)...
                                    #       there can be any punctuation between 'perl' and the first digit
            [^a-z0-9\/]*\d          # there must be a second digit somewhere, and there can be punctuation before that too
            [^\/]*$                 # make sure the stuff we were scanning for so far was the FILENAME, not part of the path
            /xi) {
        #print "$file\n";
        push(@files, $file);
    }
}


### sort by version number
my %version_numbers = map {$_ => extract_perl_version($_)} @files;
@files = sort {$version_numbers{$a} cmp $version_numbers{$b}} @files;


#less(join("\n", @files) . "\n"); exit;
#print join("\n", @files), "\n";

my $accum = '';
foreach my $file (@files) {
    #my $version_pretty = 'v' . join('.', map {int($_)} split ' ', $version_numbers{$file});
    my $version_pretty = format_perl_version($version_numbers{$file});

    #$accum .= "$file\t\t\t$version_numbers{$file}\n";
    #$accum .= sprintf("%-20s %s\n", $version_pretty, $file);

    my ($filename, $timestamp, $bytes) = split ' ', $whole_line{$file};

    #$accum .= sprintf("%-20s %s\n", $version_pretty, $whole_line{$file});

    $accum .= sprintf("%-15s %-70s %-25s %12s\n",
                    $version_pretty,
                    $file,
                    scalar(gmtime($timestamp)),
                    commify($bytes));
}
#less($accum); exit;

open POUT, ">backpan_perls.txt" or die "$!";
print POUT <<'EOF';
################################################################################
#
#       Older versions of Perl on BackPAN.
#
#       NOTE:   Version information is a GUESSTIMATE, based only on filename.
#               Data is completely unverified, and probably wrong.  YMMV.
# 
#       Analysis script can be found at:
#               http://paperlined.org/dev/perl/cpan/core_analysis/backpan_perls.update.pl
#
#       See also:
#               http://mirrors.develooper.com/perl/historical-perl/
#               http://mirrors.develooper.com/perl/really-ancient-perls/
#
################################################################################
EOF
print POUT $accum;
exit;



# from a file path, try to guess if there's a Perl version hidden here somewhere
sub extract_perl_version {
    my $filename = shift;
    
    (my $file_only = $filename) =~ s#^.*/##;

    if ($file_only =~ /^perl542b/) {        # hard-code an exception to the below general rules
        return '00005 00004 00002';
    }

    if ($filename =~ /perl((?:[^a-z0-9\/]*\d)*)[^\/]*$/i) {
        # do a natural-sort: # http://www.codinghorror.com/blog/2007/12/sorting-for-humans-natural-sort-order.html
        my @chunks = split /\D+/, $1;
        shift(@chunks)  unless (defined($chunks[0]));
        shift(@chunks)  unless (length($chunks[0]));

        # if the first chunk has several digits, then split it into two chunks  (to deal with things like 'v401')
        if ($chunks[0] =~ s/^(\d)(?=\d)//) {
            unshift(@chunks, $1);
        }

        # if the second chunk looks like this is something like 5.00301, then split the second
        # chunk in two
        if ($chunks[0] == 5 && $chunks[1] =~ s/^(00\d)(?=\d)//) {
            splice(@chunks, 1, 0, $1);      # insert it into $chunks[1]
        }

        my $chunks = join ' ',  map {sprintf "%05d", $_} @chunks;
        return $chunks;
    }
    return undef;
}


# make a human-readable version
sub format_perl_version {
    my $version = shift;
    my @chunks = map {int($_)} split ' ', $version;
    if (        ($chunks[0] == 4 && $chunks[1] >= 35)
             || ($chunks[0] == 5 && $chunks[1] < 6)) {
        $chunks[1] = sprintf "%03d", $chunks[1];
        if (exists $chunks[2]) {
            $chunks[2] = sprintf "%02d", $chunks[2];
        }
        splice(@chunks, 1, 2,   $chunks[1] . '_' . $chunks[2])
                if (@chunks > 2);
    }
    return join(".", @chunks);
}




# display a string to the user, via vim    (note: first arg is a .vimrc command;  use the empty-string if it's unneeded)
sub vim {my$pid=open my$vim,"|-",'vim','-R','-c',shift,'-';print$vim @_;close$vim;waitpid$pid,0}

# display a string to the user, via 'less'
sub less {my$pid=open my$less,"|less";print$less @_;close$less;waitpid$pid,0}

# add commas to a number
sub commify {(my$text=reverse$_[0])=~s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;scalar reverse$text}