#!/usr/bin/env perl
use strict;
use warnings;

# Work out the earliest and latest of each version of Perl
# save as seperate json files

use JSON ();
use LWP::Simple qw(get);
use File::Slurp qw(read_file);

my $json = JSON->new->pretty;

# Fetch all perl versions on cpan, perl_testing seperated out
# will exit if the data has not changed
my ( $perl_versions, $perl_testing ) = fetch_perl_version_data();

$perl_versions = sort_versions($perl_versions);

# Earliest
{

    # Reverse to get earliest first
    my $earliest_per_version
        = extract_first_per_version_in_list( [ reverse @{$perl_versions} ] );

    my $earliest = sort_versions( [ values %{$earliest_per_version} ] );
    print_file( "perl_versions_earliest.json", $json->encode($earliest) );
}

# Latest
{

    # List ordered with latest first
    my $latest_per_version
        = extract_first_per_version_in_list($perl_versions);

    my $latest = sort_versions( [ values %{$latest_per_version} ] );
    $latest->[0]->{latest} = 'true';

    print_file( "perl_version_latest_stable.json",
        $json->encode( $latest->[0] ) );

    # Add the latest test so people know what's coming
    # only if:
    # - not of the same version as the latest release
    # - larger number than the previous release (fix for security releases)
    unshift @$latest, $perl_testing->[0]
        if ( $perl_testing->[0]->{version_number} ne
        $latest->[0]->{version_number} )
        && (
        $perl_testing->[0]->{version_minor} > $latest->[0]->{version_minor} );

    print_file( "perl_versions_latest.json", $json->encode($latest) );
}

sub print_file {
    my ( $file, $data ) = @_;

    open my $fh, ">:utf8", "data/$file"
        or die "Could not open data/$file: $!";
    print $fh $data;
    close $fh;

}

sub sort_versions {
    my $list = shift;

    my @sorted = sort {
               $b->{version_major} <=> $a->{version_major}
            || int( $b->{version_minor} ) <=> int( $a->{version_minor} )
            || $b->{version_iota} <=> $a->{version_iota}
    } @{$list};

    return \@sorted;

}

sub extract_first_per_version_in_list {
    my $versions = shift;

    my $lookup = {};
    foreach my $version ( @{$versions} ) {
        my $minor_version = $version->{version_major} . '.'
            . int( $version->{version_minor} );

        $lookup->{$minor_version} = $version
            unless $lookup->{$minor_version};
    }
    return $lookup;
}

sub fetch_perl_version_data {
    my $perl_dist_url = "http://search.cpan.org/api/dist/perl";

    my $filename = 'perl_version_all.json';

    # See what we have on disk
    my $disk_json = '';
    $disk_json = read_file("data/$filename")
        if -r "data/$filename";

    my $cpan_json = get($perl_dist_url);
    die "Unable to fetch $perl_dist_url" unless $cpan_json;

    if ( $cpan_json eq $disk_json ) {

        # Data has not changed so don't need to do anything
        exit;
    } else {

        # Save for next fetch
        print_file( $filename, $cpan_json );
    }

    my $data = eval { $json->decode($cpan_json) };
    if ( my $err = $@ ) {
        die "$err: [$cpan_json]";
    }

    my @perls;
    my @testing;
    foreach my $module ( @{ $data->{releases} } ) {
        next unless $module->{authorized} eq 'true';

        my $version = $module->{version};

        $version =~ s/-(?:RC|TRIAL)\d+$//;
        $module->{version_number} = $version;

        my ( $major, $minor, $iota ) = split( '[\._]', $version );
        $module->{version_major} = $major;
        $module->{version_minor} = int($minor);
        $module->{version_iota}  = int( $iota || '0' );

        # Do not trust the API as it gets it wrong
        delete $module->{latest};

        $module->{type}
            = $module->{status} eq 'testing'
            ? 'Devel'
            : 'Maint';

        # TODO: Ask - please add some validation logic here
        # so that on live it checks this exists
        my $zip_file = $module->{distvname} . '.tar.gz';

        $module->{zip_file} = $zip_file;
        $module->{url} = "http://www.cpan.org/src/5.0/" . $module->{zip_file};

        ( $module->{released_date}, $module->{released_time} )
            = split( 'T', $module->{released} );

        next if $major < 5;

        if ( $module->{status} eq 'stable' ) {
            push @perls, $module;
        } else {
            push @testing, $module;
        }
    }
    return \@perls, \@testing;
}