summaryrefslogtreecommitdiffstats
path: root/preps/perl.d
diff options
context:
space:
mode:
Diffstat (limited to 'preps/perl.d')
-rwxr-xr-xpreps/perl.d/fetchcpan60
-rwxr-xr-xpreps/perl.d/perl-dist617
-rwxr-xr-xpreps/perl.d/perl-pkgbuild120
-rwxr-xr-xpreps/perl.d/scrapecore241
4 files changed, 1038 insertions, 0 deletions
diff --git a/preps/perl.d/fetchcpan b/preps/perl.d/fetchcpan
new file mode 100755
index 0000000..076599b
--- /dev/null
+++ b/preps/perl.d/fetchcpan
@@ -0,0 +1,60 @@
+#!/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/preps/perl.d/perl-dist b/preps/perl.d/perl-dist
new file mode 100755
index 0000000..407403d
--- /dev/null
+++ b/preps/perl.d/perl-dist
@@ -0,0 +1,617 @@
+#!/usr/bin/env perl
+
+use warnings 'FATAL' => 'all';
+use strict;
+
+my $PROG = 'preps/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/preps/perl.d/perl-pkgbuild b/preps/perl.d/perl-pkgbuild
new file mode 100755
index 0000000..80a92e4
--- /dev/null
+++ b/preps/perl.d/perl-pkgbuild
@@ -0,0 +1,120 @@
+#!/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/preps/perl.d/scrapecore b/preps/perl.d/scrapecore
new file mode 100755
index 0000000..25f5c80
--- /dev/null
+++ b/preps/perl.d/scrapecore
@@ -0,0 +1,241 @@
+#!/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"; }