diff options
Diffstat (limited to 'metas')
| -rwxr-xr-x | metas/perl | 106 | ||||
| -rwxr-xr-x | metas/perl.d/fetchcpan | 60 | ||||
| -rwxr-xr-x | metas/perl.d/perl-dist | 617 | ||||
| -rwxr-xr-x | metas/perl.d/perl-pkgbuild | 120 | ||||
| -rwxr-xr-x | metas/perl.d/scrapecore | 241 |
5 files changed, 0 insertions, 1144 deletions
diff --git a/metas/perl b/metas/perl deleted file mode 100755 index 23f4907..0000000 --- a/metas/perl +++ /dev/null @@ -1,106 +0,0 @@ -#!/usr/bin/env perl - -use warnings 'FATAL' => 'all'; -use strict; - -use File::Fetch; -use IO::Handle; # for autoflush -use Cwd; - -my $PROG = 'metas/perl'; -my %BADNAMES = ('perl-libwww' => 'libwww-perl'); - -sub err -{ - print STDERR "$PROG: ", @_, "\n"; - exit 1; -} - -sub matchdist -{ - my($dist) = @_; - - # Refresh our local list of distributions if needed. - my $var = $ENV{'PKGVAR'} - or err('PKGVAR env variable is unset'); - - if(!-f "$var/cpandists" || -M "$var/cpandists" > 1) { - print STDERR "$PROG: Refreshing local CPAN data... "; - my $cwd = getcwd(); - chdir $var or die "chdir: $!"; - system 'fetchcpan'; - die "FAILED\n" unless($? == 0); - print STDERR "OK\n"; - chdir $cwd or die "chdir: $!"; - } - - open(DISTS, '<', "$var/cpandists") or err("open: $!"); - while(<DISTS>) { - my @f = split; - my $d = lc $f[0]; $d =~ tr/-_/--/s; - next unless($d eq lc($dist)); - close(DISTS); - return ($f[0], $f[2]); - } - close(DISTS); - return (); -} - -sub fetchdist -{ - my($cpath) = @_; - my $file = $cpath; $file =~ s{^.*/}{}; - if(-f $file) { - print STDERR "$file already downloaded.\n"; - return; - } - - my $mirror = $ENV{'CPANMIRROR'} || 'ftp://cpan.pair.com'; - my $url = "${mirror}/authors/id/${cpath}"; - - print STDERR "Downloading $file... "; - my $ff = File::Fetch->new('uri' => $url); - die "FAILED\n" unless($ff->fetch()); - print STDERR "OK\n"; -} - -sub main -{ - my $dist = shift or die "usage: $PROG [package name]\n"; - - my $guess; - if($BADNAMES{$dist}){ - $dist = $BADNAMES{$dist}; - }elsif($dist =~ s/^perl-// == 0){ - $guess = 1; - $dist = "app-$dist"; - } - - STDERR->autoflush(1); - my ($realname, $cpath) = matchdist($dist); - unless($realname){ - if($guess){ - return 2 - }else{ - ## Return a hard error to makepkgmeta if perl- package. - err(qq{failed to find perl dist similar to '$dist'}); - return 1 - } - } - fetchdist($cpath); - - print <<"END_META"; -url -https://metacpan.org/release/$realname - -source -http://search.cpan.org/CPAN/authors/id/$cpath - -END_META - - my $file = $cpath; $file =~ s{.*/}{}; - system 'perl-dist' => $file; - return $? >> 8; -} - -exit main(@ARGV); diff --git a/metas/perl.d/fetchcpan b/metas/perl.d/fetchcpan deleted file mode 100755 index 076599b..0000000 --- a/metas/perl.d/fetchcpan +++ /dev/null @@ -1,60 +0,0 @@ -#!/bin/sh - -mirror=${CPANMIRROR:-ftp://cpan.pair.com} -path=/modules/02packages.details.txt.gz - -curl --silent "$mirror$path" | gzip -dc | awk ' -NR < 10 { next } -{ - file = a[split($3, a, "/")] - - if (!match(file, /[-_][vV]?[0-9]+/)) { - #print "error: failed to grok " $3 | "cat 1>&2" - next - } - ver = substr(file, RSTART+1) - dist = substr(file, 1, RSTART-1) - - sub(/[.]tar[.].*$|[.]zip$/, "", ver) - sub(/^[vV]/, "", ver) - sub(/[.]pm$/, "", dist) - - if(dist == "perl") next - - mods[dist,ver] = mods[dist,ver] $1 " " $2 "\n" - if (lessthan(dists[dist], ver)) { - dists[dist] = ver - paths[dist] = $3 - } -} - -END { - for (dist in dists) { - ver = dists[dist] - print dist, ver, paths[dist] | "sort >cpandists" - } - close("sort >cpandists") - - # Prints modules out in sorted order, too! - while(getline<"cpandists" > 0) { - print $1 "\n" mods[$1,$2] >"cpanmods" - } -} - -function lessthan (l, r) -{ - return decver(l) < decver(r) -} - -function decver (vs) -{ - pcnt = gsub(/[.]/, ".", vs) - if (pcnt < 2) return vs - - len = split(vs, vc, ".") - dec = vc[1] - for (i=2; i<=len; i++) dec += (10 ^ (-i * 3)) * vc[i] - return dec -} - -' diff --git a/metas/perl.d/perl-dist b/metas/perl.d/perl-dist deleted file mode 100755 index b1eedf2..0000000 --- a/metas/perl.d/perl-dist +++ /dev/null @@ -1,617 +0,0 @@ -#!/usr/bin/env perl - -use warnings 'FATAL' => 'all'; -use strict; - -my $PROG = 'metas/perl.d/perl-dist'; -my $PBPROG = 'perl-pkgbuild'; - -sub DBG {} -if(exists $ENV{'GENDBG'}){ - no warnings 'redefine'; - *DBG = sub { print STDERR "$PROG: DBG: ", @_ }; -} - -package Convert; - -*DBG = *main::DBG; - -use Module::CoreList; -use LWP::UserAgent qw(); -use YAML::XS qw(); -use version qw(); - -# Match unpredictible package names . -my %OVERRIDE = - ('libwww-perl' => 'perl-libwww', - 'aceperl' => 'perl-ace', - 'mod_perl' => 'mod_perl', - 'glade-perl-two' => 'perl-glade-two', - 'Gnome2-GConf' => 'gconf-perl', - 'Gtk2-GladeXML' => 'glade-perl', - 'Glib' => 'glib-perl', - 'Gnome2' => 'gnome-perl', - 'Gnome2-VFS' => 'gnome-vfs-perl', - 'Gnome2-Canvas' => 'gnomecanvas-perl', - 'Gnome2-GConf' => 'gconf-perl', - 'Gtk2' => 'gtk2-perl', - 'Cairo' => 'cairo-perl', - 'Pango' => 'pango-perl', - 'Perl-Critic' => 'perl-critic', - 'Perl-Tidy' => 'perl-tidy', - 'App-Ack' => 'ack', - 'TermReadKey' => 'perl-term-readkey'); - -sub dist2pkg -{ - my($name, $ver) = @_; - return dist_pkgname($name), dist_pkgver($ver); -} - -# Copied from CPANPLUS::Dist::Arch -sub dist_pkgname -{ - my($distname) = @_; - - return $OVERRIDE{$distname} if(exists $OVERRIDE{$distname}); - - # Package names should be lowercase and consist of alphanumeric - # characters only (and hyphens!)... - $distname = lc $distname; - $distname =~ tr/_+/--/; - $distname =~ tr/-a-z0-9//cd; # Delete all other chars - $distname =~ tr/-/-/s; - - # Delete leading or trailing hyphens... - $distname =~ s/\A-//; - $distname =~ s/-\z//; - - die qq{Dist name '$distname' completely violates packaging standards} - if(length $distname == 0); - - # Don't prefix the package with perl- if it IS perl... - $distname = "perl-$distname" unless($distname eq 'perl'); - - return $distname; -} - -sub dist_pkgver -{ - my($version) = @_; - - # Remove developer versions because pacman has no special logic - # to handle comparing them to regular versions such as perl uses. - $version =~ s/_[^_]+\z//; - - # Package versions should be numbers and decimal points only... - $version =~ tr/-_/../; - $version =~ tr/0-9.//cd; - - $version =~ tr/././s; - $version =~ s/^[.]|[.]$//g; - - return $version; -} - -#---HELPER FUNCTION--- -# Decide if the dist. is named after the module. -sub _ismainmod -{ - my($mod_name, $dist_name) = @_; - - $mod_name =~ tr/:/-/s; - return lc($mod_name) eq lc($dist_name); -} - -#---HELPER FUNCTION--- -# Merges the right-hand deps into the left-hand deps. -sub _merge -{ - my($left_deps, $right_deps) = @_; - - MERGE_LOOP: - while(my($pkg, $ver) = each %$right_deps){ - if($left_deps->{$pkg}){ - my $leftver = version->parse($left_deps->{$pkg}); - my $rightver = version->parse($ver); - next MERGE_LOOP if $leftver > $rightver; - } - $left_deps->{$pkg} = $ver; - } - - return; -} - -#---HELPER FUNCTION--- -# Merge duplicate deps into $left always storing the greatest version there. -sub _mergedups -{ - my($left, $right) = @_; - - for my $name (keys %$left){ - my $rver = delete $right->{$name} or next; - my $lver = $left->{$name}; - my $lvo = ($lver ? version->parse($lver) : 0); - my $rvo = ($rver ? version->parse($rver) : 0); - $left->{$name} = ($lvo > $rvo ? $lvo : $rvo); - } - - return; -} - -sub _filterdeps(&$) -{ - my($fsub, $deps) = @_; - my %fed; - - my @pkgs = keys(%$deps); - for my $dname (grep { $fsub->() } @pkgs){ - my $dver = delete $deps->{$dname}; - $fed{$dname} = $dver if(defined $dver); - } - - return \%fed; -} - -#---HELPER FUNCTION--- -sub _yankcheckers -{ - _filterdeps { /^perl-pod-coverage$|^perl-test-/ } $_[0] -} - -#---HELPER FUNCTION--- -# Converts a decimal perl version (like $]) into the dotted decimal -# form that the official ArchLinux perl package uses. -sub _perldepver -{ - my($perlver) = @_; - - # Fix perl-style vstrings which have a leading "v". - return $perlver if($perlver =~ s/\Av//); - return $perlver unless($perlver =~ /\A(\d+)[.](\d{3})(\d{1,3})\z/); - - # Re-apply the missing trailing zeroes. - my $patch = $3; - $patch .= q{0} x (3 - length $patch); - return sprintf('%d.%d.%d', $1, $2, $patch); -} - -#---PUBLIC FUNCNTION--- -# Translates CPAN module dependencies into ArchLinux package dependencies. -sub _reqs2deps -{ - my($prereqs) = @_; - my(@mods, %pkgdeps); - - # Filter out deps on 'perl' and any core modules that we can. - while(my ($name, $ver) = each(%$prereqs)) { - DBG("requires $name $ver\n"); - my $cver = $Module::CoreList::version{$]}{$name}; - - if($name eq 'perl') { - $pkgdeps{'perl'} = _perldepver($ver); - }elsif($cver){ - DBG("perl core has $name $cver\n"); - my $vobj = eval { version->parse($ver) }; - $cver = version->parse($cver); - if($vobj > $cver){ - push @mods, $name; - } - }else{ - push @mods, $name; - } - } - - my %dists = _distsofmods(@mods); - while(my ($mod, $dist) = each %dists) { - DBG("$mod is provided by $dist\n"); - my $pkgname = dist_pkgname($dist); - my $ver = $prereqs->{$mod}; - - # If the module is not named after the distribution, ignore its - # version which might not match the distribution. - undef $ver unless(_ismainmod($mod, $dist)); - - # If two module prereqs are in the same CPAN distribution then - # the version required for the main module will override. - # (because versions specified for other modules in the dist - # are 0) - $pkgdeps{$pkgname} ||= ($ver ? dist_pkgver($ver) : 0); - DBG("depends on $pkgname>=$pkgdeps{$pkgname}\n"); - } - - return \%pkgdeps; -} - -sub prereqs -{ - my($pkgname, $prereqs) = @_; - - # maps perl names for different dependencies to ArchLinux's names - my %namemap = ('configure' => 'makedepends', - 'build' => 'makedepends', - 'test' => 'checkdepends', - 'runtime' => 'depends', - ); - - my %pkgdeps; - while (my($perl, $arch) = each(%namemap)) { - my $reqs = $prereqs->{$perl}{'requires'}; - my $deps; $deps = _reqs2deps($reqs) if($reqs); - - next unless(keys %$deps); - if($pkgdeps{$arch}){ - _merge($pkgdeps{$arch}, $deps); - }else{ - $pkgdeps{$arch} = $deps; - } - } - - # ArchLinux now has a separate array for dependencies that we only - # need for checking (aka "testing"). Older perl METAs do not - # have this separated. Force any test modules to be checkdepends. - if(!$pkgdeps{'checkdepends'} && $pkgname !~ /\Aperl-test-/){ - my $checkdeps = {}; - for(qw/makedepends depends/){ - _merge($checkdeps, _yankcheckers($pkgdeps{$_})) - } - $pkgdeps{'checkdepends'} = $checkdeps; - } - - # We at least require perl, if nothing else. - unless(grep { scalar keys %$_ > 0 } values %pkgdeps){ - $pkgdeps{'depends'}{'perl'} = 0; - } - - _mergedups(@pkgdeps{'makedepends', 'checkdepends'}); - _mergedups(@pkgdeps{'depends', 'makedepends'}); - - # Convert all deps into arrays of strings. - for my $deptype (keys(%pkgdeps)){ - $pkgdeps{$deptype} = _stringify($pkgdeps{$deptype}); - } - - return \%pkgdeps; -} - -#---HELPER FUNCTION--- -sub _stringify -{ - my($deps) = @_; - - my @depstrs; - for my $pkg (sort keys %$deps){ - my $ver = $deps->{$pkg}; - my $str = ($ver eq '0' ? $pkg : "$pkg>=$ver"); - push @depstrs, $str; - } - - return \@depstrs; -} - -sub _distsofmods -{ - my(@mods) = @_; - - return () if(@mods == 0); - @mods = _nocore(@mods); - - my $var = _vardir(); - open my $fh, '<', "$var/cpanmods" - or die "$PROG: failed to open $var/cpanmods: $!"; - - my %mods = map { ($_ => 1) } @mods; - my %dists; - local $/ = ''; - - RECLOOP: - while(my $rec = <$fh>){ - last RECLOOP unless(keys %mods > 0); - - my($dist, @mvs) = split(/\n/, $rec); - MODLOOP: - for(@mvs){ - my($m) = split; - my $fnd = delete($mods{$m}) or next; - $dists{$m} = $dist; - } - } - - my @lost = keys %mods; - return %dists unless(@lost); - - for my $m (@lost){ - print STDERR "$PROG: failed to find module $m\n"; - } - exit 1; -} - -sub _nocore -{ - my(@mods) = @_; - - my $path = _vardir() . '/coremods'; - unless(-f $path){ - print STDERR "$PROG: error: $path is missing. -****************************************************************************** - You must generate it with genpkg's metas/perl.d/scrapecore script. Run it - against the source distribution of perl that is currently being packaged. -****************************************************************************** -"; - exit 1; - } - open my $if, '<', $path or die "$PROG: open $path: $!"; - - my %mods = map { ($_ => 1) } @mods; - while(<$if>){ - my($m) = split; - delete $mods{$m}; - } - - close $if; - return keys %mods; -} - -sub _vardir -{ - return $ENV{'PKGVAR'} - or die "$PROG: PKGVAR env variable is unset\n"; -} - -#----------------------------------------------------------------------------- - -package main; - -use File::Basename qw(basename dirname); -use File::Spec::Functions qw(catfile catdir rel2abs); -use File::Find qw(find); - -use JSON::XS qw(decode_json); # for META.json -use YAML::XS (); # for META.yml -use Pod::Select (); # search POD for description - -sub printdata -{ - my($pbvars) = @_; - print "options\n!emptydirs\n\n"; - printmeta($pbvars); - return; -} - -sub writepb -{ - my($ddir) = @_; - my $dtype = (-f "$ddir/Build.PL" ? "MB" : "MM"); - if(system $PBPROG => $dtype){ - return $? >> 8; - }else{ - return 0; - } -} - -sub main -{ - my $distpath = shift or die "Usage: $PROG [path to cpan dist file]\n"; - $distpath = rel2abs($distpath); - my $dir = dirname($distpath); - my $file = basename($distpath); - my $info = distinfo($file); - - chsrcdir(catdir($dir, 'src'), $file); - my $distdir = extractdist($file); - - my $meta = loadmeta($distdir); - my $desc = $meta->{'abstract'}; - if(!$desc || $desc eq '~' || $desc eq 'unknown'){ - $meta->{'abstract'} = distdesc($distdir, $info->{'mod'}); - } - - my($name, $ver) = Convert::dist2pkg(@{$info}{'name', 'ver'}); - my $deps = Convert::prereqs($name, $meta->{'prereqs'}); - - my %pbvars = - ('pkgver' => $ver, - 'pkgdesc' => $meta->{'abstract'}, - 'arch' => (xsdist($distdir) ? ['i686', 'x86_64'] : 'any'), - 'distdir' => $distdir, - %$deps, - ); - - chdir $dir or die "chdir: $!"; - - my $ret = writepb($dir); - if($ret){ - print STDERR "$PROG: failed to write PKGBUILD: error $ret\n"; - return 1; - } - - printdata(\%pbvars); - return 0; -} - -# Create the src/ directory and tarball symlink. Then chdir into it. - -sub chsrcdir -{ - my($srcdir, $distfile) = @_; - - if(-e $srcdir){ - system 'rm' => ('-fr', $srcdir); - die "failed to rm $srcdir\n" unless($? == 0); - } - mkdir $srcdir or die "mkdir $srcdir: $!"; - chdir $srcdir or die "chdir $srcdir: $!"; - unless(-f $distfile) { - symlink(catfile('..', $distfile), $distfile) - or die "symlink $distfile: $!"; - } - - return $srcdir; -} - -sub distinfo -{ - my($distfile) = @_; - - my @c = split /-/, $distfile; - my $ver = pop @c; - my $name = join q{-}, @c; - my $mod = $name; - $mod =~ s/-/::/g; - return { 'name' => $name, 'ver' => $ver, 'mod' => $mod }; -} - -sub extractdist -{ - my($file) = @_; - - system 'bsdtar' => ('-xf', $file); - die "$PROG: bsdtar failed to extract $file\n" unless($? == 0); - - opendir my $srcdir, '.' or die "opendir: $!"; - my @dirs = grep { -d $_ && !/\A[.]/ } readdir $srcdir; - closedir $srcdir; - - die "$PROG: many dirs (@dirs) inside the tarball $file\n" if(@dirs > 1); - die "$PROG: no dirs found in tarball $file\n" if(@dirs == 0); - return $dirs[0]; -} - -sub printmeta -{ - my($pbvars) = @_; - while(my($name, $val) = each %$pbvars) { - if(!defined $val || $val eq q{}) { - warn "$PROG: warning: $name is undefined\n"; - $val = q{}; - } - print $name, "\n"; - print "$_\n" for (ref $val ? @$val : $val); - print "\n"; - } - - # TODO: autodetect license type - printf("license\n%s\n\n", join "\n", qw/PerlArtistic GPL/); -} - -sub loadmeta -{ - my($distdir) = @_; - - for my $metaext (qw/json yml/){ - my $path = "$distdir/META.$metaext"; - next unless(-f $path); - - open my $metafh, '<', $path or die "open: $!"; - my $meta = do { local $/; <$metafh> }; - close $metafh; - - $meta = ($metaext eq 'json' ? decode_json($meta) : - $metaext eq 'yml' ? YAML::XS::Load($meta) : - die "internal error: unknown \$metaext: $metaext"); - - upgrademeta($meta); - return $meta; - } - - return undef; -} - -sub upgrademeta -{ - my($meta) = @_; - - return if(exists $meta->{'prereqs'}); - - my $prereqs; - $prereqs->{'configure'}{'requires'} - = delete $meta->{'configure_requires'}; - $prereqs->{'build'}{'requires'} = delete($meta->{'build_requires'}); - $prereqs->{'runtime'}{'requires'} = delete($meta->{'requires'}); - - $meta->{'prereqs'} = $prereqs; - return; -} - -sub xsdist -{ - my($dir) = @_; - my $isxs; - find({ 'wanted' => sub { $isxs = 1 if(/[.]xs$/) }, 'no_chdir' => 1 }, - $dir); - return $isxs; -} - -#----------------------------------------------------------------------------- - -sub distdesc -{ - my($dir, $modname) = @_; - return _poddesc($dir, $modname) || _readmedesc($dir, $modname); -} - -sub _poddesc -{ - my($dir, $modname) = @_; - - my $podselect = Pod::Select->new; - $podselect->select('NAME'); - - my $modpath = $modname; $modpath =~ s{::}{/}g; - my $moddir = dirname($modpath); - my $modfile = basename($modpath); - - # First check under lib/ for a "properly" pathed module, with - # nested directories. Then search desperately for a .pm file that - # matches the module's last name component. - - my @possible = glob("$dir/{lib/,}{$moddir/,}$modfile.{pod,pm}"); - - PODSEARCH: - for my $podpath (@possible){ - next PODSEARCH unless(-f $podpath); - - # Read the NAME section of the POD into a scalar. - my $namesect = q{}; - open my $podfile, '<', $podpath or next PODSEARCH; - open my $podout, '>', \$namesect or die "open: $!"; - - $podselect->parse_from_filehandle($podfile, $podout); - - close $podfile; - close $podout or die "close: $!"; - - next PODSEARCH unless($namesect); - - # Remove formatting codes. - $namesect =~ s{ [IBCLEFSXZ] <(.*?)> }{$1}gxms; - $namesect =~ s{ [IBCLEFSXZ] <<(.*?)>> }{$1}gxms; - - # The short desc is on a line beginning with 'Module::Name - ' - return $1 if($namesect =~ / ^ \s* $modname [ -]+ ([^\n]+) /xms); - } - - return undef; -} - -#---HELPER FUNCTION--- -sub _readmedesc -{ - my($dir, $modname) = @_; - - my $path = catfile($dir, 'README'); - return undef unless(-f $path); - open my $fh, '<', $path or die "open: $!"; - - while(<$fh>){ - chomp; - next unless((/\ANAME/ ... /\A[A-Z]+/) - && / \A \s* ${modname} [\s\-]+ (.+) \z /x); - return $1; - } - - close $fh; - return undef; -} - -exit main(@ARGV); diff --git a/metas/perl.d/perl-pkgbuild b/metas/perl.d/perl-pkgbuild deleted file mode 100755 index 80a92e4..0000000 --- a/metas/perl.d/perl-pkgbuild +++ /dev/null @@ -1,120 +0,0 @@ -#!/usr/bin/env perl - -use warnings 'FATAL' => 'all'; -use strict; - -my $PROG = 'perl-pkgbuild'; - -sub putpkgbuild -{ - my($sect, $subsect, $text) = @_; - open my $pipe, '|-', 'putpkgtree' => 'PKGBUILD', $sect, $subsect - or die "open putpkgtree: $!"; - print $pipe $text; - close $pipe or exit $? >> 8; -} - -sub putfuncs -{ - my($funcs) = @_; - for my $f (keys %$funcs){ - my $sects = $funcs->{$f}; - while(my ($s, $txt) = each %$sects){ - putpkgbuild($f, $s, $txt); - } - } -} - -sub startfunc -{ - my($name) = @_; - return <<"ENDTXT"; -${name}() -( - cd "\$_distdir" -ENDTXT -} - -sub functxt -{ - my $fmt = shift; - $fmt .= "\n" unless($fmt =~ /\n\z/); - my $txt = sprintf $fmt, @_; - $txt =~ s/^/ /gm; - return $txt; -} - -sub main -{ - if(@_ == 0 || ($_[0] ne 'MM' && $_[0] ne 'MB')){ - print STDERR qq{usage: $PROG ["MM" or "MB"]\n}; - return 1; - } - - my $type = shift; - my($script, $make, $iargs); - my @badenv = qw/PERL5LIB/; - my @exports = qw/PERL_MM_USE_DEFAULT=1/; - if($type eq 'MM'){ - $script = 'Makefile.PL'; - $make = 'make'; - $iargs = q{INSTALLDIRS=vendor DESTDIR="$pkgdir"}; - push @exports, 'PERL_AUTOINSTALL=--skipdeps'; - push @badenv, 'PERL_MM_OPT'; - }else{ - $script = 'Build.PL'; - $make = './Build'; - $iargs = q{installdirs=vendor destdir="$pkgdir"}; - push @badenv, 'PERL_MB_OPT', 'MODULEBUILDRC=/dev/null'; - } - - my %funcs; - my @fnames = qw/build check package/; - for my $f (@fnames){ - $funcs{$f}{'beg'} = startfunc($f); - # Module::Build uses env vars for each stage of Build - if($type eq 'MB'){ - $funcs{$f}{'beg'} = <<"ENDTXT"; -export @exports -unset @badenv -ENDTXT - } - } - - # ExtUtils::MakeMaker only uses env vars for Makefile.PL - if($type eq 'MM'){ - $funcs{'build'}{'beg'} .= functxt(<<'ENDTXT', "@exports", "@badenv"); -export %s -unset %s -ENDTXT - } - - $funcs{'build'}{'body'} = functxt(<<'ENDTXT', $script, $make); -/usr/bin/perl %s -%s -ENDTXT - - $funcs{'check'}{'body'} = functxt("%s test", $make); - - $funcs{'package'}{'body'} = functxt(<<'ENDTXT', $make, $iargs); -%s install %s -find "$pkgdir" -name .packlist -o -name perllocal.pod -delete -ENDTXT - - for my $f (@fnames){ - $funcs{$f}{'end'} = ")\n"; - } - putfuncs(\%funcs); - - putpkgbuild('suffix', 'body', <<'ENDTXT'); -# Local Variables: -# mode: shell-script -# sh-basic-offset: 2 -# End: -# vim:set ts=2 sw=2 et: -ENDTXT - - return 0; -} - -exit main(@ARGV); diff --git a/metas/perl.d/scrapecore b/metas/perl.d/scrapecore deleted file mode 100755 index 25f5c80..0000000 --- a/metas/perl.d/scrapecore +++ /dev/null @@ -1,241 +0,0 @@ -#!/usr/bin/env perl - -use warnings 'FATAL' => 'all'; -use strict; - -package Common; - -sub evalver -{ - my($path, $mod) = @_; - - open(my $fh, '<', $path) or die("open $path: $!"); - - my $m = ($mod - ? qr/(?:\$${mod}::VERSION|\$VERSION)/ - : qr/\$VERSION/); - - while(<$fh>){ - next unless(/\s*$m\s*=\s*.+/); - chomp; - my $ver = do { no strict; eval }; - return $ver unless($@); - warn(qq{$path:$. bad version string "$_"\n}); - } - - close($fh); - return undef; -} - -# ---------------------------------------- - -package CoreDist; -use File::Basename qw(basename); - -sub modname -{ - my($dist) = @_; - $dist =~ s/-+/::/g; - return $dist; -} - -sub maindistfile -{ - my($dist, $dir) = @_; - - # libpath is the modern style, installing modules under lib/ - # with dirs matching the name components. - my $libpath = join(q{/}, 'lib', split(/-/, "${dist}.pm")); - - # dumbpath is an old style where there's no subdirs and just - # a .pm file. - my $dumbpath = $dist; - $dumbpath =~ s/\A.+-//; - $dumbpath .= ".pm"; - - 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); - - for my $path (map { "$dir/$_" } @paths){ return $path if(-f $path); } - return undef; -} - -sub module_ver -{ - my($dist, $dir) = @_; - - my $path = maindistfile($dist, $dir) or return undef; - - my $mod = modname($dist); - my $ver = Common::evalver($path, $mod); - unless($ver){ - warn("failed to find version in module file $path\n"); - return undef; - } - - return [ $mod, $ver ]; -} - -sub changelog_ver -{ - my($dist, $dir) = @_; - - my $path; - for my $tmp (glob "$dir/{Changes,ChangeLog}"){ - if(-f $tmp){ $path = $tmp; last; } - } - return undef unless($path); - - my $mod = modname($dist); - 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); - - return undef; -} - -# for some reason podlators has a VERSION file with perl code in it -sub verfile_ver -{ - my ($dist, $dir) = @_; - my $path = "$dir/VERSION"; - return undef unless(-f $path); # no warning, only podlaters has it - - my $v = Common::evalver($path); - return ($v ? [ modname($dist), $v ] : undef); -} - -# scans a directory full of nicely separated dist. directories. -sub scan_distroot -{ - my ($distroot) = @_; - 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"; } - } - return @found; -} - -sub findmods -{ - my ($srcdir) = @_; - return map { scan_distroot($_) } glob "$srcdir/{cpan,dist,ext}"; -} - -# ---------------------------------------- - -package CoreLib; - -use File::Find qw(); -use File::stat; - -*findfile = *File::Find::find; - -sub findmods -{ - my ($srcdir) = @_; - my $libdir = "$srcdir/lib/"; - die "failed to find $libdir directory" unless(-d $libdir); - - # Find only the module files that have not changed since perl - # was extracted. We don't want the files perl just recently - # installed into lib/. We processed those already. - my @modfiles; - my $finder = sub { - return unless(/[.]pm\z/); - push @modfiles, $_; - }; - findfile({ 'no_chdir' => 1, 'wanted' => $finder }, $libdir); - - # First we have to find what the oldest ctime actually is. - my $oldest = time; - @modfiles = map { - my $modfile = $_; - my $ctime = (stat $modfile)->ctime; - $oldest = $ctime if($ctime < $oldest); - [ $modfile, $ctime ]; # save ctime for later - } @modfiles; - - # Then we filter out any file that was created more than a - # few seconds after that. Process the rest. - my @mods; - for my $modfile (@modfiles){ - my ($mod, $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 $ver = Common::evalver($path, $mod) || q{}; - push @mods, [ $mod, $ver ]; - } - return @mods; -} - -# ---------------------------------------- - -package main; - -sub _delmatch -{ - my ($mvs, $findus) = @_; - for (@$mvs){ - my ($m) = split; - delete($findus->{$m}); - } - return; -} - -sub coreonly -{ - my %mods = map { @$_ } @_; - my $var = $ENV{'PKGVAR'} || "$ENV{'HOME'}/.genpkg/var"; - my $path = "$var/cpanmods"; - 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/); - next if(defined delete $mods{$dist}); - _delmatch(\@dms, \%mods); - } - - close($if); - my @core; - 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 @mods = - (CoreDist::findmods($perldir), - CoreLib::findmods($perldir)); - -## Embedded modules without any files... -push @mods, [qw/ Config 1/]; - -@mods = coreonly(@mods); -for my $mv (@mods){ print "@$mv\n"; } |