Import get from LWP::Simple

[gitmo/moose-presentations.git] / moose-class / exercises / update-moosepan

#!/usr/bin/env perl

use strict;
use warnings;

use CPAN::FindDependencies qw( finddeps );
use CPAN::Mini;
use List::AllUtils qw( any );
use Module::CoreList;
use version;


{
    package CPAN::FindDependencies;

    use LWP::Simple qw( get );

    no warnings 'redefine';
    # The real function assumes that if you provide an argument it's a
    # local file, not a URI.
    sub _get02packages {
        my $file = shift;

        get($file) ||
            die(__PACKAGE__.": Couldn't fetch 02packages index file\n");
    }
}


sub main {
    # If this isn't fetched fresh each time, then CPAN::Mini gets
    # confused (maybe it's a timestamp issue because of git?)
    unlink './moosepan/modules/02packages.details.txt.gz'
        or die $!;

    my @deps
        = grep { is_real_dep($_) }
        finddeps( 'Moose',
        '02packages' =>
            'http://mirrors.kernel.org/cpan/modules/02packages.details.txt.gz'
        );

    my @distros = map { $_->distribution() } @deps;

    my $filter_sub = sub {
        return !any { $_[0] eq $_ } @distros;
    };

    CPAN::Mini->update_mirror(
        remote       => 'http://mirrors.kernel.org/cpan/',
        local        => './moosepan',
        path_filters => $filter_sub,
        trace        => 1,
        skip_perl    => 1,
    );
}

my %skip_deps = map { $_ => 1 } qw(
    ExtUtils::MakeMaker
    Archive::Tar
    Compress::Zlib
    Compress::Raw::Bzip2
    Compress::Raw::Zlib
    IO::Zlib
    Package::Constants
    ExtUtils::CBuilder
    Pod::Simple
    Pod::Escapes
    Task::Weaken
    Module::Build
);

my $min_perl = version->new('5.8.5');
sub is_real_dep {
    my $dep = shift;

    # Include this just to make sure the user gets a version with
    # weaken available.
    return 1 if $dep->name eq 'Scalar::Util';

    return if $skip_deps{ $dep->name() };

    my $perl = Module::CoreList->first_release( $dep->name() );

    return if defined $perl && version->new($perl) le $min_perl;

    return 1;
}

main();