summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJustin Davis <jrcd83@gmail.com>2012-06-06 18:29:00 +0200
committerJustin Davis <jrcd83@gmail.com>2012-06-06 18:29:00 +0200
commitf96e1dc226501b4b1ff8b1e4086db01861804cc9 (patch)
tree56d16af954bc761289123221c4f76cda09d64ff6
parent0330fadcf7a3475c8c213907426da1ad5f24bdc9 (diff)
downloadgenpkg-f96e1dc226501b4b1ff8b1e4086db01861804cc9.tar.gz
genpkg-f96e1dc226501b4b1ff8b1e4086db01861804cc9.tar.xz
Search for package names when parsing VERSIONs.
-rwxr-xr-xmisc/perlcore85
1 files changed, 56 insertions, 29 deletions
diff --git a/misc/perlcore b/misc/perlcore
index 1e7df58..8787369 100755
--- a/misc/perlcore
+++ b/misc/perlcore
@@ -12,7 +12,7 @@ package CoreDist;
use File::Basename qw(basename);
use File::Find qw();
*findfile = *File::Find::find;
-*findver = *main::findver;
+*grokver = *main::grokver;
sub pathmod
{
@@ -25,24 +25,44 @@ sub pathmod
return $p;
}
-sub findpms # a foolhardy task!
+sub findpmfiles
{
my($ddir) = @_;
- my @modpaths;
-
$ddir = "$ddir/lib" if(-d "$ddir/lib");
+
+ my @modpaths;
my $finder = sub {
return unless(/[.]pm$/);
return if(m{/t/});
-
+
my $p = $_;
s{^\Q$ddir\E/}{};
my $m = pathmod($_);
push @modpaths, [ $m, $p ];
};
+
findfile({ 'no_chdir' => 1, 'wanted' => $finder }, $ddir);
+ return @modpaths;
+}
+
+sub solopm
+{
+ my($ddir) = @_;
+ my $p = $ddir;
+ $p =~ s{.+/}{};
- return @modpaths;
+ my $m = $p;
+ $m =~ s{-}{::}g;
+ $p =~ s{.+-}{};
+ $p = "$ddir/$p.pm";
+
+ return (-f $p ? [ $m, $p ] : undef);
+}
+
+sub findpms # a foolhardy task!
+{
+ my($ddir) = @_;
+ return solopm($ddir) || findpmfiles($ddir);
}
sub findpl
@@ -74,9 +94,9 @@ sub scan_distroot
} map { "$distroot/$_" } @dists;
return map {
- my($m, $p) = @$_;
- my $v = findver($p, $m);
- ($v ? [ $m, $v ] : ());
+ my(undef, $p) = @$_;
+ my($m, $v) = grokver($p);
+ ($m ? [ $m, $v ] : ());
} @found;
}
@@ -94,7 +114,7 @@ use File::Find qw();
use File::stat;
*findfile = *File::Find::find;
-*findver = *main::findver;
+*grokver = *main::grokver;
sub findmods
{
@@ -126,16 +146,16 @@ sub findmods
# few seconds after that. Process the rest.
my @mods;
for my $modfile (@modfiles){
- my($mod, $ctime) = @$modfile;
+ my($path, $ctime) = @$modfile;
next if $ctime - $oldest > 5; # ignore newer files
- my $path = $mod;
- $mod =~ s{[.]pm\z}{};
- $mod =~ s{\A$libdir}{};
- $mod =~ s{/}{::}g;
+# my $mod = $path;
+# $mod =~ s{[.]pm\z}{};
+# $mod =~ s{\A$libdir}{};
+# $mod =~ s{/}{::}g;
- my $ver = findver($path, $mod);
- if($ver){
+ my($mod, $ver) = grokver($path);
+ if($mod){
push @mods, [ $mod, $ver ];
}else{
warn "failed to find version in $path\n";
@@ -148,26 +168,33 @@ sub findmods
package main;
-sub findver
+sub grokver
{
- my($path, $mod) = @_;
+ my($path) = @_;
open(my $fh, '<', $path) or die("open $path: $!");
- my $m = ($mod
- ? qr/(?:\$${mod}::VERSION|\$VERSION)/
- : qr/\$VERSION/);
-
+ my $m = qr/\$VERSION/;
+ my $pkg;
while(<$fh>){
- next unless(/\s*$m\s*=\s*.+/);
- chomp;
- my $ver = do { no strict; eval };
- return $ver unless($@);
- die qq{$path:$. bad version string "$_"\n};
+ if(/^\s*package\s+([\w:_-]+)\s*;/){
+ $pkg = $1;
+ $m = qr/\$${pkg}::VERSION|\$VERSION/;
+ }elsif($pkg && /\s*$m\s*=\s*.+/){
+ chomp;
+ my $ver = do { no strict; eval };
+ if($@ || !defined $ver || $ver eq q{}){
+ warn qq{$path:$.: bad version string: $_\n};
+ return ();
+ }else{
+ #print STDERR "DBG: grokked $pkg - $ver from $path\n";
+ return ($pkg, $ver);
+ }
+ }
}
close($fh);
- return undef;
+ return ();
}
sub delmods