diff options
| -rwxr-xr-x | preps/perl.d/scrapecore | 67 |
1 files changed, 36 insertions, 31 deletions
diff --git a/preps/perl.d/scrapecore b/preps/perl.d/scrapecore index c8bdac5..8fe1530 100755 --- a/preps/perl.d/scrapecore +++ b/preps/perl.d/scrapecore @@ -56,7 +56,7 @@ sub maindistfile my @paths = ($libpath, $dumbpath); # Some modules (with simple names like XSLoader, lib, etc) are # generated by Makefile.PL. Search through their generating code. - push(@paths, "${dist}_pm.PL") if($dist =~ tr/-/-/ == 0); + push @paths, "${dist}_pm.PL" if($dist =~ tr/-/-/ == 0); for my $path (map { "$dir/$_" } @paths){ return $path if(-f $path); } return undef; @@ -71,7 +71,7 @@ sub module_ver my $mod = modname($dist); my $ver = Common::evalver($path, $mod); unless($ver){ - warn("failed to find version in module file $path\n"); + warn "failed to find version in module file $path\n"; return undef; } @@ -89,12 +89,12 @@ sub changelog_ver return undef unless($path); my $mod = modname($dist); - open(my $fh, '<', $path) or die("open: $!"); + open my $fh, '<', $path or die"open: $!"; while(<$fh>){ return [ $mod, $1 ] if(/\A\s*(?:$dist[ \t]*)?([0-9._]+)/); return [ $mod, $1 ] if(/\A\s*version\s+([0-9._]+)/i); } - close($fh); + close $fh; return undef; } @@ -102,7 +102,7 @@ sub changelog_ver # for some reason podlators has a VERSION file with perl code in it sub verfile_ver { - my ($dist, $dir) = @_; + my($dist, $dir) = @_; my $path = "$dir/VERSION"; return undef unless(-f $path); # no warning, only podlaters has it @@ -114,26 +114,28 @@ sub verfile_ver sub scan_distroot { my ($distroot) = @_; - opendir(my $cpand, "$distroot") or die("failed to open $distroot"); - my @dists = grep { !/^\./ && -d "$distroot/$_" } readdir($cpand); - closedir($cpand); + opendir my $cpand, "$distroot" or die("failed to open $distroot"); + my @dists = grep { !/^\./ && -d "$distroot/$_" } readdir $cpand; + closedir $cpand; my @found; for my $dist (@dists){ my $distdir = "$distroot/$dist"; my $mv = (module_ver($dist, $distdir) - || changelog_ver($dist, $distdir) - || verfile_ver($dist, $distdir)); - - if($mv){ push @found, $mv; } - else { warn "failed to find version for $dist\n"; } + || changelog_ver($dist, $distdir) + || verfile_ver($dist, $distdir)); + if($mv){ + push @found, $mv; + }else{ + warn "failed to find version for $dist\n"; + } } return @found; } sub findmods { - my ($srcdir) = @_; + my($srcdir) = @_; return map { scan_distroot($_) } glob "$srcdir/{cpan,dist,ext}"; } @@ -148,7 +150,7 @@ use File::stat; sub findmods { - my ($srcdir) = @_; + my($srcdir) = @_; my $libdir = "$srcdir/lib/"; die "failed to find $libdir directory" unless(-d $libdir); @@ -175,7 +177,7 @@ sub findmods # few seconds after that. Process the rest. my @mods; for my $modfile (@modfiles){ - my ($mod, $ctime) = @$modfile; + my($mod, $ctime) = @$modfile; next if $ctime - $oldest > 5; # ignore newer files my $path = $mod; @@ -183,8 +185,12 @@ sub findmods $mod =~ s{\A$libdir}{}; $mod =~ s{/}{::}g; - my $ver = Common::evalver($path, $mod) || q{}; - push @mods, [ $mod, $ver ]; + my $ver = Common::evalver($path, $mod); + if($ver){ + push @mods, [ $mod, $ver ]; + }else{ + warn "failed to find version in module file $path\n"; + } } return @mods; } @@ -195,10 +201,10 @@ package main; sub _delmatch { - my ($mvs, $findus) = @_; - for (@$mvs){ - my ($m) = split; - delete($findus->{$m}); + my($mvs, $findus) = @_; + for(@$mvs){ + my($m) = split; + delete $findus->{$m}; } return; } @@ -211,34 +217,33 @@ sub coreonly unless(-f $path){ die "$0: $path is missing. Generate it with fetchcpan.\n"; } - open(my $if, '<', $path) or die("open $path failed: $!"); + open my $if, '<', $path or die "open $path failed: $!"; my @dists; local $/ = qq{\n\n}; while(<$if>){ last unless(%mods); - my ($dist, @dms) = split(/\n/); + my($dist, @dms) = split /\n/; next if(defined delete $mods{$dist}); _delmatch(\@dms, \%mods); } - close($if); + close $if; my @core; - for my $k (keys %mods) { + for my $k (keys %mods){ push(@core, [ $k, $mods{$k} ]); } return sort { $a->[0] cmp $b->[0] } @core; } -my $perldir = shift or die("Usage: $0 [path to perl source directory]\n"); -die("$perldir is not a valid directory.\n") unless(-d $perldir); +my $perldir = shift or die"Usage: $0 [path to perl source directory]\n"; +die "$perldir is not a valid directory.\n" unless(-d $perldir); my @mods = (CoreDist::findmods($perldir), CoreLib::findmods($perldir)); ## Embedded modules without any files... -push @mods, [qw/ Config 1/]; +push @mods, [ 'Config' => 1 ]; -@mods = coreonly(@mods); -for my $mv (@mods){ print "@$mv\n"; } +print "@$_\n" for(coreonly(@mods)); |