summaryrefslogtreecommitdiffstats
path: root/preps
diff options
context:
space:
mode:
authorJustin Davis <jrcd83@gmail.com>2012-06-01 18:04:56 +0200
committerJustin Davis <jrcd83@gmail.com>2012-06-01 18:04:56 +0200
commit6b62423d4108c551ce1240926ca14a7e667b71d1 (patch)
tree28e9f5fba0dd05da7cc0d4103c1fee7aa4277719 /preps
parent5aaba77d45e9b1e3f1297d3093fce1c4b260e8be (diff)
downloadgenpkg-6b62423d4108c551ce1240926ca14a7e667b71d1.tar.gz
genpkg-6b62423d4108c551ce1240926ca14a7e667b71d1.tar.xz
Update style of scrapecore (again) and warn on missing versions.
Diffstat (limited to 'preps')
-rwxr-xr-xpreps/perl.d/scrapecore67
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));