File Coverage

blib/lib/CPAN/Flatten.pm

Criterion	Covered	Total	%
statement	17	78	21.7
branch	0	28	0.0
condition	0	7	0.0
subroutine	6	13	46.1
pod	0	6	0.0
total	23	132	17.4

package CPAN::Flatten;

use strict;
use 5.008_005;
our $VERSION = '0.01';

use CPAN::Flatten::Distribution::Factory;
use CPAN::Flatten::Distribution;
use Module::CoreList;
use version;

sub new {
    my ($class, %opt) = @_;
    my $target_perl = delete $opt{target_perl} || $];
    $target_perl = "v$target_perl" if $target_perl =~ /^5\.[1-9]\d*$/;
    $target_perl = version->parse($target_perl)->numify;
    bless {target_perl => $target_perl, %opt}, $class;
}
sub target_perl { shift->{target_perl} }

sub is_core {
    my ($self, $package, $version) = @_;
    $version ||= 0;
    if ($package eq "perl") {
        if ($version > $self->target_perl) {
            my $err = "target perl version is only @{[$self->target_perl]}";
            return (undef, $err);
        } else {
            return (1, undef);
        }
    }
    if (exists $Module::CoreList::version{$self->target_perl}{$package}) {
        return (1, undef);
    } else {
        return (0, undef);
    }
}

sub info_progress {
    my ($self, $depth) = (shift, shift);
    return if $self->{quiet};
    print STDERR "  " x $depth, "@_";
}
sub info_done {
    my $self = shift;
    return if $self->{quiet};
    print STDERR " -> @_\n";
}

sub flatten {
    my ($self, $package, $version) = @_;
    my $distribution = CPAN::Flatten::Distribution->new;
    my $miss = +{};
    $self->_flatten($distribution, $miss, $package, $version);
    my @miss = sort keys %$miss;
    return ($distribution, @miss ? \@miss : undef);
}

sub _flatten {
    my ($self, $distribution, $miss, $package, $version) = @_;
    return 0 if $miss->{$package};
    $version ||= 0;
    my $already = $distribution->root->providing($package, $version);
    if ($already) {
        return 0 if $distribution->is_child($already);
        $distribution->add_child( $already->dummy );
        return 1;
    }

    my ($is_core, $err) = $self->is_core($package, $version);
    if (!defined $is_core) {
        $miss->{$package}++;
        $self->info_progress($distribution->depth, "$package ($version)");
        $self->info_done("\e[31m$err\e[m");
        return 0;
    } elsif ($is_core) {
        if ($self->{verbose}) {
            $self->info_progress($distribution->depth, "$package ($version)");
            $self->info_done("core");
        }
        return 0;
    }

    $self->info_progress($distribution->depth, "$package ($version)");
    my ($found, $reason) = CPAN::Flatten::Distribution::Factory->from_pacakge($package, $version);
    if (!$found) {
        $miss->{$package}++;
        $self->info_done("\e[31m$reason\e[m");
        return 0;
    }
    $self->info_done("@{[$found->name]}");
    $distribution->add_child($found);
    my $count = 0;
    for my $requirement (@{$found->requirements}) {
        $count += $self->_flatten($found, $miss, $requirement->{package}, $requirement->{version});
    }
    return $count; # count == 0 means leaf
}

1;
__END__