view release on metacpan or  search on metacpan

script/cpan-outdated-coro  view on Meta::CPAN

my $index_url = "${mirror}/modules/02packages.details.txt.gz";

my $core_modules = $Module::CoreList::version{$]};

my @libpath = make_inc( $local_lib, $self_contained );

my %prev_path;
my $depth = 2;
my @found;
#### prepare filtering with module path: 'depth='.$depth
my $rule = File::Find::Rule->new;
$rule = $rule->new->relative->maxdepth($depth)->or(
    $rule->new->directory->or(
        $rule->new->name('auto')->prune, $rule->new->name(qr/^(?:\.|\w+)$/),
        $rule->new->prune
    ),
    $rule->new->name('*.pm')
);

for my $p (@libpath) {
    push @found, map lc(), $rule->in($p);
}
@prev_path{@found} = (1) x @found;
#### prev_path: @found+0

#### mktemp
my $tmpfile = File::Temp->new( UNLINK => 1, SUFFIX => '.gz' );

#### fetch 02packages.details.txt
getstore( $index_url, $tmpfile->filename );
#### open gz and skip HEADER
my $fh = zopen($tmpfile) or die "cannot open $tmpfile";
## skip header part
while ( my $line = <$fh> ) {
    last if $line eq "\n";
}

# body part
my %seen;
my %dist_latest_version;

my %ch;
my $cv;

# AnyEvent::Util::fh_nonblocking($fh,1);

#### create channel
my %num = (
    gz => 30,
    scan => 10,
    info => 1,
    rep => 1,
);

for (keys %num) {
    $ch{$_} = [];
}
$cv=AE::cv;
my $cv_main=AE::cv;

#### spawn threads
for my $ref (
#       worker      name
    [ \&_parse_gz, 'gz' ],
    [ \&_scan_inc, 'scan' ],
    [ \&_get_info, 'info' ],
    [ \&_report,   'rep' ],
)
{
    my ( $sub, $name ) = @{$ref};
    my $num = $num{$name};
    ### spawn: $name => $num
    for my $x (1..$num) {
        $cv->begin;
         my $w;$w=AE::timer 0,0.0001, sub{
            ## enter: $name
            if ($sub->()) {
                undef $w;
                $cv->end;
            }
        };
    }
}

### schedule
$cv_main->recv;
close $fh;

exit;

sub _parse_gz {
    local $_=<$fh>;
    unless (defined $_) {
        push @{$ch{scan}}, undef;
        return 1;
    }
    chomp;
    my ( $pkg, $version, $dist ) = split ' ';
## ***PKG: $pkg
    return if $version eq 'undef';

    # $Mail::SpamAssassin::Conf::VERSION is 'bogus'
    # https://rt.cpan.org/Public/Bug/Display.html?id=73465
    return unless $version =~ /[0-9]/;

    # if excluding core modules
    return
    if $exclude_core && exists $core_modules->{$pkg};

    return
    if $dist =~ m{/perl-[0-9._]+\.tar\.(gz|bz2)$};
    my @a = split '::', $pkg . '.pm', $depth + 1;
    pop @a if @a > $depth;
    return unless $prev_path{ lc( join( '/', @a ) ) };
    ### ***PUSH: $pkg
    push @{$ch{scan}}, [ $pkg, $version, $dist, ];
    return;
}

sub _scan_inc {
    return unless @{$ch{scan}}+0;