From 879bbf01560e348d93c6903786fabae0607a59e6 Mon Sep 17 00:00:00 2001 From: Justin Davis Date: Fri, 21 Oct 2011 16:46:21 -0400 Subject: Create lib/ directory for meta generator and template scripts. --- lib/metas/perl | 94 ++++++++ lib/metas/perl.d/cpandists | 66 ++++++ lib/metas/perl.d/perl-dist | 561 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 721 insertions(+) create mode 100755 lib/metas/perl create mode 100755 lib/metas/perl.d/cpandists create mode 100755 lib/metas/perl.d/perl-dist (limited to 'lib/metas') diff --git a/lib/metas/perl b/lib/metas/perl new file mode 100755 index 0000000..2f341e5 --- /dev/null +++ b/lib/metas/perl @@ -0,0 +1,94 @@ +#!/usr/bin/env perl + +use warnings 'FATAL' => 'all'; +use strict; + +use File::Fetch; +use IO::Handle; # for autoflush +use Cwd; + +my $PROG = 'perl'; + +sub err +{ + print STDERR @_, "\n"; + exit 2; +} + +sub matchdist +{ + my ($dist) = @_; + + # Refresh our local list of distributions if needed. + my $var = $ENV{'PKGVAR'} + or err("$PROG: PKGVAR env variable is unset\n"); + + if(!-f "$var/cpandists" || -M "$var/cpandists" > 1) { + print STDERR "Refreshing local CPAN distribution list..."; + my $cwd = getcwd(); + chdir($var) or die "chdir: $!"; + system('cpandists'); + err("FAILED") unless($? == 0); + print STDERR "OK\n"; + chdir($cwd) or die "chdir: $!"; + } + + open(DISTS, '<', "$var/cpandists") or err("$PROG: open: $!"); + while() { + my @f = split; + next unless(lc($f[0]) 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); + err("FAILED") unless($ff->fetch()); + print STDERR "OK\n"; +} + +sub main +{ + my $pkg = shift or die "Usage: $PROG [package name]\n"; + my $dist = $pkg; + + $dist = "app-$dist" if($dist =~ s/^perl-// == 0); + + STDERR->autoflush(1); + my ($realname, $cpath) = matchdist($dist); + unless($realname){ + print STDERR "$PROG: failed to find perl dist similar to $dist\n"; + exit 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 $?; +} + +exit main(@ARGV); diff --git a/lib/metas/perl.d/cpandists b/lib/metas/perl.d/cpandists new file mode 100755 index 0000000..040db77 --- /dev/null +++ b/lib/metas/perl.d/cpandists @@ -0,0 +1,66 @@ +#!/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, "/")] + len = split(file, a, ".") + + if (!match(a[1], /[-_][vV]?[0-9]+$/)) { + #print "error: failed to grok " $3 | "cat 1>&2" + next + } + ver = substr(file, RSTART+1, RLENGTH-1) + dist = substr(file, 1, RSTART-1) + for (i=2; i<=len; i++) { + if (a[i] !~ /^[0-9]/) break + ver = ver "." a[i] + } + sub(/^[vV]/, "", ver) + + # For some reason the newest version of perl had no modules in 02packages + # so I cant just use modules from the newest version of perl. + if(dist == "perl") + coremods = coremods $1 " " $2 "\n" + else + 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" ($1 == "perl" ? coremods : 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/lib/metas/perl.d/perl-dist b/lib/metas/perl.d/perl-dist new file mode 100755 index 0000000..57b468b --- /dev/null +++ b/lib/metas/perl.d/perl-dist @@ -0,0 +1,561 @@ +#!/usr/bin/env perl + +use warnings 'FATAL' => 'all'; +use strict; + +my $PROG = 'perl-dist'; + +package Convert; + +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); + + CPAN_DEP_LOOP: + while(my ($name, $ver) = each(%$prereqs)) { + # Sometimes a perl version is given as a prerequisite + if($name eq 'perl') { + $pkgdeps{'perl'} = _perldepver($ver); + next CPAN_DEP_LOOP; + } + push @mods, $name; + } + + my %dists = _distsofmods(@mods); + while(my ($mod, $dist) = each %dists) { + 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); + } + + 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 = {}; + _merge($checkdeps, _yankcheckers($pkgdeps{$_})) for(qw/makedepends depends/); + $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); + + use Time::HiRes qw(time); + my $beg = time; + + my $var = $ENV{'PKGVAR'} + or die "$PROG: PKGVAR env variable is unset\n"; + open(my $fh, '<', "$var/cpanmods") + or die "$PROG: failed to open $var/cpanmods: $!"; + + my (@hunted, %dists) = @mods; + local $/ = ''; + + RECLOOP: + while(my $rec = <$fh>) { + my ($dist, @modvers) = split(/\n/, $rec); + for (@modvers) { + my ($m) = split; + + CMPLOOP: + for my $i (0 .. $#hunted) { + next CMPLOOP unless($hunted[$i] eq $m); + $dists{$m} = $dist; + splice @hunted, $i, 1; + last RECLOOP if(@hunted == 0); + last CMPLOOP; + } + } + } + + if (@hunted) { + for my $lost (@hunted) { + print STDERR "$PROG: failed to find module $lost\n"; + } + exit 2; + } + + return %dists; +} + +#----------------------------------------------------------------------------- + +package main; + +use File::Basename qw(basename dirname); +use File::Spec::Functions qw(catfile catdir); +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 + +use Digest::MD5 (); # for md5sums & sha512sums +use Digest::SHA (); + +sub main +{ + my $distpath = shift() or die "Usage: $PROG [path to cpan dist file]\n"; + my $dir = dirname($distpath); + my $file = basename($distpath); + my $info = distinfo($file); + + chsrcdir(catdir($dir, 'src'), $file); + $dir = extractdist($file); + + my $meta = loadmeta($dir); + my $desc = $meta->{'abstract'}; + if(!$desc || $desc eq '~') { + $meta->{'abstract'} = distdesc($dir, $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($dir) ? ['i686', 'x86_64'] : 'any'), + 'md5sums' => md5sums($file), + 'sha512sums' => sha512sums($file), + 'distdir' => $dir, + %$deps, + ); + + # Since this is a perl distribution, use the perl-pkg template. + printf("template\nperl-pkg %s\n\n", (-f "$dir/Build.PL" ? "MB" : "MM")); + print("options\n!emptydirs\n\n"); + + printmeta(\%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) == 0 or die "failed to rm $srcdir\n"; + } + 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; +} + +#----------------------------------------------------------------------------- + +sub md5sums +{ + return [ map { + open(my $fh, '<', $_) or die "open: $!"; + my $md5 = Digest::MD5->new()->addfile($fh)->hexdigest; + } @_ ] +} + +sub sha512sums +{ + return [ map { + my $sha = Digest::SHA->new(512)->addfile($_)->hexdigest; + } @_ ] +} + +exit main(@ARGV); -- cgit v1.2.3-24-g4f1b