perl: update to 5.16.0.
This commit is contained in:
Juan RP
parent
9540ebd754
commit
f6a4e9e6b5
3 changed files with 430 additions and 86 deletions
289
srcpkgs/perl/files/provides.pl
Executable file
289
srcpkgs/perl/files/provides.pl
Executable file
|
|
@ -0,0 +1,289 @@
|
|||
#!/usr/bin/env perl
|
||||
##
|
||||
# Script for printing out a provides list of every CPAN distribution
|
||||
# that is bundled with perl. You can run it before building perl
|
||||
# or you can run it after building perl. Required modules are in core
|
||||
# for perl 5.13 and above. It might be nice if this didn't require
|
||||
# HTTP::Tiny and maybe just used wget or curl.
|
||||
#
|
||||
# This script uses HTTP::Tiny to query Tatsuhiko Miyagawa's webapp at
|
||||
# cpanmetadb.plackperl.org to cross-reference module files to their
|
||||
# providing CPAN distribution. Thank you Miyagawa!
|
||||
#
|
||||
# - Justin "juster" Davis <jrcd83@gmail.com>
|
||||
#
|
||||
# Based on the Archlinux version and modified for xbps.
|
||||
|
||||
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 (my $ln = <$fh>) {
|
||||
next unless $ln =~ /\s*$m\s*=\s*.+/;
|
||||
chomp $ln;
|
||||
my $ver = do { no strict; eval $ln };
|
||||
return $ver unless $@;
|
||||
die qq{$path:$. bad version string in "$ln"\n};
|
||||
}
|
||||
|
||||
close $fh;
|
||||
return undef;
|
||||
}
|
||||
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
package Dists;
|
||||
|
||||
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 = $dist;
|
||||
$mod =~ s/-/::/g;
|
||||
my $ver = Common::evalver($path, $mod);
|
||||
unless ($ver) {
|
||||
warn "failed to find version in module file for $dist\n";
|
||||
return undef;
|
||||
}
|
||||
|
||||
return $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;
|
||||
|
||||
open my $fh, '<', $path or die "open: $!";
|
||||
while (<$fh>) {
|
||||
return $1 if /\A\s*(?:$dist[ \t]*)?([0-9._]+)/;
|
||||
return $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
|
||||
|
||||
return Common::evalver($path);
|
||||
}
|
||||
|
||||
# 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 $ver = (module_ver($dist, $distdir)
|
||||
|| changelog_ver($dist, $distdir)
|
||||
|| verfile_ver($dist, $distdir));
|
||||
|
||||
if ($ver) { push @found, [ $dist, $ver ]; }
|
||||
else { warn "failed to find version for $dist\n"; }
|
||||
}
|
||||
return @found;
|
||||
}
|
||||
|
||||
sub find
|
||||
{
|
||||
my ($srcdir) = @_;
|
||||
return map { scan_distroot($_) } glob "$srcdir/{cpan,dist}";
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
package Modules;
|
||||
|
||||
use HTTP::Tiny qw();
|
||||
use File::Find qw();
|
||||
use File::stat;
|
||||
|
||||
*findfile = *File::Find::find;
|
||||
|
||||
sub cpan_provider
|
||||
{
|
||||
my ($module) = @_;
|
||||
my $url = "http://cpanmetadb.plackperl.org/v1.0/package/$module";
|
||||
my $http = HTTP::Tiny->new;
|
||||
my $resp = $http->get($url);
|
||||
return undef unless $resp->{'success'};
|
||||
|
||||
my ($cpanpath) = $resp->{'content'} =~ /^distfile: (.*)$/m
|
||||
or return undef;
|
||||
|
||||
my $dist = $cpanpath;
|
||||
$dist =~ s{\A.+/}{}; # remove author directory
|
||||
$dist =~ s{-[^-]+\z}{}; # remove version and extension
|
||||
return ($dist eq 'perl' ? undef : $dist);
|
||||
}
|
||||
|
||||
sub find
|
||||
{
|
||||
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/;
|
||||
return if m{\Q$libdir\E[^/]+/t/}; # ignore testing modules
|
||||
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 ];
|
||||
}
|
||||
|
||||
# Convert modules names to the dist names who provide them.
|
||||
my %seen;
|
||||
my @dists;
|
||||
for my $modref (@mods) {
|
||||
my ($mod, $ver) = @$modref;
|
||||
my $dist = cpan_provider($mod) or next; # filter out core modules
|
||||
next if $seen{$dist}++; # avoid duplicate dists
|
||||
push @dists, [ $dist, $ver ];
|
||||
}
|
||||
return @dists;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
package Dist2Pkg;
|
||||
|
||||
sub name
|
||||
{
|
||||
my ($name) = @_;
|
||||
my $orig = $name;
|
||||
|
||||
# Delete leading or trailing hyphens...
|
||||
$name =~ s/\A-|-\z//g;
|
||||
|
||||
die qq{Dist. name '$orig' completely violates packaging standards}
|
||||
unless $name;
|
||||
|
||||
return "perl-$name";
|
||||
}
|
||||
|
||||
sub version
|
||||
{
|
||||
my ($version) = @_;
|
||||
|
||||
# Package versions should be numbers and decimal points only...
|
||||
$version =~ tr/-/./;
|
||||
$version =~ tr/_0-9.-//cd;
|
||||
|
||||
$version =~ tr/././s; # only one period at a time
|
||||
$version =~ s/\A[.]|[.]\z//g; # shouldn't start or stop with a period
|
||||
|
||||
return $version;
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------------
|
||||
|
||||
package main;
|
||||
|
||||
my %CPANNAME = ('List-Util' => 'Scalar-List-Utils',
|
||||
'Text-Tabs' => 'Text-Tabs+Wrap',
|
||||
'Cwd' => 'PathTools');
|
||||
|
||||
my $perldir = shift or die "Usage: $0 [path to perl source directory]\n";
|
||||
die "$perldir is not a valid directory." unless -d $perldir;
|
||||
|
||||
my @dists = (Dists::find($perldir), Modules::find($perldir));
|
||||
for my $dist (@dists) {
|
||||
my $name = $dist->[0];
|
||||
$dist->[0] = $CPANNAME{$name} if exists $CPANNAME{$name};
|
||||
}
|
||||
|
||||
my @pkgs = map {
|
||||
my ($name, $ver) = @$_;
|
||||
$name = Dist2Pkg::name($name);
|
||||
$ver = Dist2Pkg::version($ver);
|
||||
[ $name, $ver ];
|
||||
} @dists;
|
||||
|
||||
@pkgs = sort { $a->[0] cmp $b->[0] } @pkgs;
|
||||
|
||||
for my $pkg (@pkgs) {
|
||||
my ($name, $ver) = @$pkg;
|
||||
print "$name-$ver\n";
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue