use v5.18;
use warnings;

use CPANPLUS::Backend;
use Storable              qw(nstore);
use Data::Dumper          qw(Dumper);
use Getopt::Long          qw(:config gnu_getopt no_ignore_case);

warn ">> started '$0'\n";

# parse commandline options
my @spec = (
    'url=s',
    'out_dumper=s',
    'out_nstore=s',
);
GetOptions(\my %opts, @spec) or die ">> invalid option(s)";

# set defaults
$opts{url}        //= 'http://cpan.strawberryperl.com';
$opts{out_dumper} //= 'upgrade-list.dumper.txt';
$opts{out_nstore} //= 'upgrade-list.nstore.txt';

### SUBROUTINES

sub get_cpanplus_backend {
    my %args = @_;

    warn ">> creating CPANPLUS::Backend\n";
    my $cb = CPANPLUS::Backend->new;
    my $conf = $cb->configure_object;

    if ($args{url}) {
        my $url = $args{url};
        $url = "$url/" unless $url =~ m|/$|;
        warn ">> using cpan mirror '$url'\n";
        my ($scheme, $host, $path) = $url =~ m|(.*?)://(.*?)(/.*)|;
        $conf->set_conf('hosts', [ {scheme=>$scheme, path=>$path, host=>$host} ]);
    }

    return $cb;
}

sub save_output {
    my ($data, $out_nstore, $out_dumper) = @_;

    if ($out_nstore) {
        warn ">> storing results via Storable to '$out_nstore'\n";
        nstore($data, $out_nstore) or die ">> store failed";;
    }

    if ($out_dumper) {
        warn ">> storing results via Data::Dumper to '$out_nstore'\n";
        open my $fh, ">", $out_dumper or die ">> open: $!";
        print $fh Dumper($data) or die ">> print: $!";
        close $fh or die ">> close: $!";
    }
}

sub modinfo2hash {
    my $mod = shift;
    return unless $mod && ref $mod eq 'CPANPLUS::Module';
    return {
        local_version => $mod->installed_version,
        cpan_version  => $mod->version,
        module        => $mod->module,
        distribution  => $mod->package_name,
        cpan_file     => $mod->author->cpanid . '/' . $mod->package,
        core_module   => $mod->module_is_supplied_with_perl_core ? 1 : 0,
    };
}

sub get_upgrade_list {
    my $cb = shift;
    die ">> no cpanplus backend" unless $cb;
  
    # get info about all installed modules
    warn ">> loading info about installed modules\n";
    my @all = $cb->installed;
    die ">> FATAL: cannot list installed modules via CPANPLUS\n" unless scalar(@all) > 0;

    # select modules that need upgrade
    my @to_upgrade = ();
    my @trouble_makers = ();

    my %seen;
    for my $mod (@all) {
        next if $mod->is_uptodate;           # skip this mod if it's up to date
        next if $mod->package_is_perl_core;  # skip this mod if it's core
        next if $seen{$mod->package}++;
        if ($mod->installed_version && $mod->version) {
            push @to_upgrade, $mod;
        }
        else {
            # undefined or '0' version
            push @trouble_makers, $mod;
        }
    }
    @to_upgrade = sort { $a->module cmp $b->module } @to_upgrade;
    @trouble_makers = sort { $a->module cmp $b->module } @trouble_makers;

    my $rv = { to_upgrade=>[], trouble_makers=>[], method=>'CPANPLUS', timestamp=>time };
    push @{$rv->{to_upgrade}}, modinfo2hash($_) for (@to_upgrade);
    push @{$rv->{trouble_makers}}, modinfo2hash($_) for (@trouble_makers);

    warn ">> count of all            = ", scalar(@all), "\n";
    warn ">> count of trouble_makers = ", scalar(@trouble_makers), "\n";
    warn ">> * $_->{cpan_file}\n" for (@{$rv->{trouble_makers}});
    warn ">> count of to_upgrade     = ", scalar(@to_upgrade), "\n";
    warn ">> * $_->{cpan_file}\n" for (@{$rv->{to_upgrade}});
    warn ">> get_upgrade_list finished\n";

    return $rv;
}

### MAIN

my $cb = get_cpanplus_backend(url=>$opts{url});
my $data = get_upgrade_list($cb);
save_output($data, $opts{out_nstore}, $opts{out_dumper});

warn ">> done!\n";
exit 0;
