#!/usr/bin/perl
# NOTE: This fixes the brain-dead ActiveState dependency problems.
#
# What's brain-dead?  They use the dist-name of modules instead of the module
# name and they do it very poorly.  Example: build a Test-Harness ppd and it
# requires File::Spec.  Try to install Test-Harness and PPM tries to pull in
# File::Spec 0.82 (with a warning) without the ability to realize it really
# wants PathTools.  QED.  (This program is a partial fix.)

our $CPAN_MIRROR = 'https://voltar.org/cpm/'; # select a mirror please

use strict;
use Compress::Zlib;
use WWW::Mechanize;
use Term::GentooFunctions qw(:all);
use version;

my ($m_db, $v_db);

&fetch; &parse; &scan;

for my $dist (keys %$v_db) {
    my $lhs = $v_db->{$dist};
    my $rhs = $m_db->{$dist};

    ewarn "$dist appears to need an upgrade ($lhs vs $rhs)" if $lhs>$rhs;
}

# fetch {{{
sub fetch {
    my $mech;

    if( not -f "02packages.details.txt.gz" or (stat _)[9]<(time-86400) ) {
        ebegin "fetching 02packages.details.txt.gz";
        $mech ||= new WWW::Mechanize;
        $mech->get($CPAN_MIRROR . "modules/02packages.details.txt.gz", ":content_file" => "02packages.details.txt.gz");
        eend (my $s = -s "02packages.details.txt.gz");
        edie "not enough file" unless $s;
    }
}
# }}}
# parse {{{
sub parse {
    my $gz = Compress::Zlib::gzopen("02packages.details.txt.gz", "rb") or die "couldn't open 02packages.details.txt.gz file: $!";
    my $line;
    my $status_line_count = undef;
    my $my_line_count = 0;
    my %mod_db;

    $m_db = \%mod_db;

    ebegin "parsing modules.txt.gz";
    while( my $bytes = $gz->gzreadline($line) ) {
        chomp $line;

        if( my ($package, $version, $author_plus_dir, $dist_fname) = $line =~ m/^(\S+)\s+(\S+)\s+(\w\/\w{2}\/[\w\-]+)\/(\S+)/ ) {
            $version = undef if $version =~ m/undef/;

            if( my ($dist,$v) = $dist_fname =~ m/^(.+?)-(v?[\d\.]+(?:[a-z]|E\d+)?)\.(?:tar\.gz|tgz|zip|pm\.gz)$/) {
                # warn "$dist_fname $dist $v" if $dist =~ m/BigRat/;

                my $subdir;
                if( (my @s = split m/\//, $dist) == 2 ) {
                    $subdir = $s[0];
                    $dist   = $s[1];
                }

                $v = version->new($v);
                $mod_db{$dist} = $v unless exists $mod_db{$dist} and $mod_db{$dist} >= $v;
            }

            $my_line_count ++;


        } elsif ( $line =~ m/[A-Z][\w\-]+:\s*\S/ and not $line =~ m/::/ ) { 
            # prolly a status line
            $status_line_count = $1 if $line =~ /^Line-Count:\s+(\d+)/;

        } elsif ( $line =~ m/^\s*$/ ) {
            # yawn

        } else {
            edie "ERROR PARSING LINE $.: $line";
        }
    }

    ewarn "my_line_count: $my_line_count; status_line_count: $status_line_count" if $my_line_count != $status_line_count;
    eend( $my_line_count == $status_line_count );
}
# }}}
# scan {{{
sub scan {
    local $/ = undef;
    my %v_db; $v_db = \%v_db;

    ebegin "parsing ppd files";
    for my $file (glob "*.ppd") {
        open my $fh, $file or die "error opening $file: $!";
        my $entire_file = <$fh>;
        close $fh;

        my ($dist_name, $version) = $entire_file =~ m/SOFTPKG NAME="([^"]+)" VERSION="([^"]+)"/;

        $version =~ s/,/./g;
        $version =~ s/(?:\.0)+$// if $dist_name =~ m/(:?POE|PathTools|Text-Tabs)/;

        my $v = version->new($version);

        $v_db{$dist_name} = $version;
    }
    eend (keys %v_db);
}
# }}}