CPAN::Mini::Visit::Simple::Auxiliary - Helper functions for CPAN::Mini::Visit::Simple

    use CPAN::Mini::Visit::Simple::Auxiliary qw(
        $ARCHIVE_REGEX
        dedupe_superseded
        get_lookup_table
        normalize_version_number
    );

    James E Keenan
    CPAN ID: jkeenan
    Perl Seminar NY
    jkeenan@cpan.org
    http://thenceforward.net/perl/modules/CPAN-Mini-Visit-Simple/

package CPAN::Mini::Visit::Simple::Auxiliary;
use 5.010;
use strict;
use warnings;
our @ISA       = qw( Exporter );
our @EXPORT_OK = qw(
    $ARCHIVE_REGEX
    dedupe_superseded
    get_lookup_table
    normalize_version_number
    create_minicpan_for_testing
    create_one_new_distro_version
    create_file
);
use Carp;
use File::Basename;
use File::Path qw( make_path );
use File::Spec;
use File::Temp qw( tempdir );
use Scalar::Util qw( looks_like_number );

our $ARCHIVE_REGEX = qr{\.(
        ?:tar\.(?:bz2|gz|Z) |
        t(?:gz|bz)          |
        zip                 |
        gz
)$}ix;

sub dedupe_superseded {
    my $listref = shift;
    my (%version_seen, @newlist);
    foreach my $distro (@$listref) {
        my $dir   = dirname($distro);
        my $base  = basename($distro);
        if ($base =~ m/^(.*)-([\d\.]+)(?:$ARCHIVE_REGEX)/) {
            my ($stem, $version) = ($1,$2);
            my $k = File::Spec->catfile($dir, $stem);
            if ( not $version_seen{$k}{version} ) {
                $version_seen{$k} = {
                    distro => $distro,
                    version => normalize_version_number($version),
                };
            }
            else {
                my $norm_current =
                    normalize_version_number($version_seen{$k}{version});
                my $norm_new = normalize_version_number($version);
                if ( $norm_new > $norm_current ) {
                    $version_seen{$k} = {
                        distro => $distro,
                        version => $norm_new,
                    };
                }
            }
        }
        else {
            push @newlist, $distro;
        }
    }
    foreach my $k (keys %version_seen) {
        push @newlist, $version_seen{$k}{distro};
    }
    return [ sort @newlist ];
}

sub get_lookup_table {
    my $distributions_ref = shift;
    my %lookup_table = ();
    foreach my $distro ( @{$distributions_ref} ) {
        my $dir   = dirname($distro);
        my $base  = basename($distro);
        if ($base =~ m/^(.*)-([\d\.]+)(?:$ARCHIVE_REGEX)/) {
            my ($stem, $version) = ($1,$2);
            my $k = File::Spec->catfile($dir, $stem);
            $lookup_table{$k} = {
                distro => $distro,
                version => normalize_version_number($version),
            };
        }
        else {
            # Since we don't have any authoritative way to compare version
            # numbers that can't be normalized, we will (for now) pass over
            # distributions with non-standard version numbers.
        }
    }
    return \%lookup_table;
}

sub normalize_version_number {
    my $v = shift;
    my @captures = split /\./, $v;
    $captures[0] =~ s/^v//;
    my $normalized;
    if ( $captures[0] eq q{} ) {
        $normalized = 0;
    }
    else {
        $normalized = 0+$captures[0];
    }

    $normalized .= '.';
    for my $cap (@captures[1..$#captures]) {
        $normalized .= sprintf("%05d", $cap);
    }
    $normalized =~ s/-//g;
    return $normalized;
}

sub create_minicpan_for_testing {
    my ( $tdir, $id_dir, $author_dir );
    my ( @source_list );
    # Prepare the test by creating a minicpan in a temporary directory.
    $tdir = tempdir();
    $id_dir = File::Spec->catdir($tdir, qw/authors id/);
    make_path($id_dir, { mode => 0711 });
    Test::More::ok( -d $id_dir, "'authors/id' directory created for testing" );
    $author_dir = File::Spec->catdir($id_dir, qw( A AA AARDVARK ) );
    make_path($author_dir, { mode => 0711 });
    Test::More::ok( -d $author_dir, "'author's directory created for testing" );

    @source_list = qw(
        Alpha-Beta-0.01.tar.gz
        Gamma-Delta-0.02.tar.gz
        Epsilon-Zeta-0.03.tar.gz
    );
    foreach my $distro (@source_list) {
        my $fulldistro = File::Spec->catfile($author_dir, $distro);
        create_file($fulldistro);
        Test::More::ok( ( -f $fulldistro ), "$fulldistro created" );
    }
    return ($tdir, $author_dir);
}

sub create_one_new_distro_version {
    my ($author_dir) = @_;
    # Bump up the version number of one distro in the minicpan
    my $remove = q{Epsilon-Zeta-0.03.tar.gz};
    my $removed_file = File::Spec->catfile($author_dir, $remove);
    Test::More::is( unlink($removed_file), 1, "$removed_file deleted" );

    my $update = q{Epsilon-Zeta-0.04.tar.gz};
    my $updated_file = File::Spec->catfile($author_dir, $update);
    create_file($updated_file);
    Test::More::ok( ( -f $updated_file ), "$updated_file created" );
}

sub create_file {
    my $file = shift;
    open my $FH, '>', $file
        or croak "Unable to open handle to $file for writing";
    say $FH q{};
    close $FH or croak "Unable to close handle to $file after writing";
}

1;