diff options
Diffstat (limited to 'metas/perl.d/perl-dist')
| -rwxr-xr-x | metas/perl.d/perl-dist | 584 |
1 files changed, 584 insertions, 0 deletions
diff --git a/metas/perl.d/perl-dist b/metas/perl.d/perl-dist new file mode 100755 index 0000000..3259fd8 --- /dev/null +++ b/metas/perl.d/perl-dist @@ -0,0 +1,584 @@ +#!/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); + + # Filter out deps on 'perl' and any core modules that we can. + while(my ($name, $ver) = each(%$prereqs)) { + my $cver = $Module::CoreList::version{$]}{$name}; + if($name eq 'perl') { + $pkgdeps{'perl'} = _perldepver($ver); + }elsif($cver && !$ver + || version->parse($ver) > version->parse($cver)){ + # Only add deps for core modules if we need a higher + # version than what is in the core for our perl interpreter. + ; + }else{ + 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); + @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; + if(@lost){ + for my $m (@lost){ + print STDERR "$PROG: failed to find module $m\n"; + } + exit 1; + } + + return %dists; +} + +sub _nocore +{ + my (@mods) = @_; + + my $path = _vardir() . '/coremods'; + 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); +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 '~' || $desc eq 'unknown') { + $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); |