Chakra_Linux/core
1
0
Fork 0
mirror of https://gitdl.cn/https://github.com/chakralinux/core.git synced 2025-01-23 09:22:14 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

Update

Browse Source
This commit is contained in:
Manuel 2012-05-09 20:14:20 +00:00
parent 02786a7f0a
commit 56dd7e9c04
7 changed files with 494 additions and 245 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

82
perl/0001-Append-CFLAGS-and-LDFLAGS-to-their-Config.pm-counter.patch Normal file
View File

@ -0,0 +1,82 @@
From bb249b0b26c2e79a6f55355ef94889070f07fd21 Mon Sep 17 00:00:00 2001
From: Niko Tyni <ntyni@debian.org>
Date: Thu, 28 Apr 2011 09:18:54 +0300
Subject: [PATCH] Append CFLAGS and LDFLAGS to their Config.pm counterparts in
EU::CBuilder
Since ExtUtils::CBuilder 0.27_04 (bleadperl commit 06e8058f27e4),
CFLAGS and LDFLAGS from the environment have overridden the Config.pm
ccflags and ldflags settings. This can cause binary incompatibilities
between the core Perl and extensions built with EU::CBuilder.
Append to the Config.pm values rather than overriding them.
---
.../lib/ExtUtils/CBuilder/Base.pm | 6 +++-
dist/ExtUtils-CBuilder/t/04-base.t | 25 +++++++++++++++++++-
2 files changed, 28 insertions(+), 3 deletions(-)
diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Base.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Base.pm
index b572312..2255c51 100644
--- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Base.pm
+++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Base.pm
@@ -40,11 +40,13 @@ sub new {
$self->{config}{$k} = $v unless exists $self->{config}{$k};
}
$self->{config}{cc} = $ENV{CC} if defined $ENV{CC};
- $self->{config}{ccflags} = $ENV{CFLAGS} if defined $ENV{CFLAGS};
+ $self->{config}{ccflags} = join(" ", $self->{config}{ccflags}, $ENV{CFLAGS})
+ if defined $ENV{CFLAGS};
$self->{config}{cxx} = $ENV{CXX} if defined $ENV{CXX};
$self->{config}{cxxflags} = $ENV{CXXFLAGS} if defined $ENV{CXXFLAGS};
$self->{config}{ld} = $ENV{LD} if defined $ENV{LD};
- $self->{config}{ldflags} = $ENV{LDFLAGS} if defined $ENV{LDFLAGS};
+ $self->{config}{ldflags} = join(" ", $self->{config}{ldflags}, $ENV{LDFLAGS})
+ if defined $ENV{LDFLAGS};
unless ( exists $self->{config}{cxx} ) {
my ($ccpath, $ccbase, $ccsfx ) = fileparse($self->{config}{cc}, qr/\.[^.]*/);
diff --git a/dist/ExtUtils-CBuilder/t/04-base.t b/dist/ExtUtils-CBuilder/t/04-base.t
index c3bf6b5..1bb15aa 100644
--- a/dist/ExtUtils-CBuilder/t/04-base.t
+++ b/dist/ExtUtils-CBuilder/t/04-base.t
@@ -1,7 +1,7 @@
#! perl -w
use strict;
-use Test::More tests => 50;
+use Test::More tests => 64;
use Config;
use Cwd;
use File::Path qw( mkpath );
@@ -326,6 +326,29 @@ is_deeply( $mksymlists_args,
"_prepare_mksymlists_args(): got expected arguments for Mksymlists",
);
+my %testvars = (
+ CFLAGS => 'ccflags',
+ LDFLAGS => 'ldflags',
+);
+
+while (my ($VAR, $var) = each %testvars) {
+ local $ENV{$VAR};
+ $base = ExtUtils::CBuilder::Base->new( quiet => 1 );
+ ok( $base, "ExtUtils::CBuilder::Base->new() returned true value" );
+ isa_ok( $base, 'ExtUtils::CBuilder::Base' );
+ like($base->{config}{$var}, qr/\Q$Config{$var}/,
+ "honours $var from Config.pm");
+
+ $ENV{$VAR} = "-foo -bar";
+ $base = ExtUtils::CBuilder::Base->new( quiet => 1 );
+ ok( $base, "ExtUtils::CBuilder::Base->new() returned true value" );
+ isa_ok( $base, 'ExtUtils::CBuilder::Base' );
+ like($base->{config}{$var}, qr/\Q$ENV{$VAR}/,
+ "honours $VAR from the environment");
+ like($base->{config}{$var}, qr/\Q$Config{$var}/,
+ "doesn't override $var from Config.pm with $VAR from the environment");
+}
+
#####
for ($source_file, $object_file, $lib_file) {
--
1.7.4.4

174
perl/PKGBUILD
View File

@ -1,137 +1,31 @@
#
# Chakra Packages for Chakra, part of chakra-project.org
#
# maintainer (i686): Phil Miller <philm[at]chakra-project[dog]org>
# maintainer (x86_64): Manuel Tortosa <manutortosa[at]chakra-project[dot]org>
# maintainer: Manuel Tortosa <manutortosa[at]chakra-project[dot]org>
pkgname=perl
pkgver=5.12.3
pkgrel=4
pkgver=5.14.2
pkgrel=1
pkgdesc="A highly capable, feature-rich programming language"
arch=(i686 x86_64)
license=('GPL' 'PerlArtistic')
url="http://www.perl.org"
groups=('base')
depends=('gdbm' 'db>=4.8' 'coreutils' 'glibc' 'sh')
source=(http://www.cpan.org/src/5.0/perl-${pkgver}.tar.bz2 perlbin.sh fix-h2ph-and-tests.patch)
depends=('gdbm' 'db' 'coreutils' 'glibc' 'sh')
source=(http://www.cpan.org/src/5.0/perl-${pkgver}.tar.bz2
perlbin.sh
perlbin.csh
provides.pl
digest_eval_hole.diff
0001-Append-CFLAGS-and-LDFLAGS-to-their-Config.pm-counter.patch)
install=perl.install
provides=(
perl-archive-extract=0.38
perl-archive-tar=1.54
perl-attribute-handlers=0.87
perl-autodie=2.06_01
perl-autoloader=5.70
perl-base=2.15
perl-b-debug=1.12
perl-bignum=0.23
perl-b-lint=1.11_01
perl-cgi=3.49
perl-class-isa=0.36
perl-compress-raw-bzip2=2.024
perl-compress-raw-zlib=2.024
perl-constant=1.20
perl-cpan=1.94_56
perl-cpanplus=0.90
perl-cpanplus-dist-build=0.46
perl-data-dumper=2.125
perl-db_file=1.820
perl-devel-dprof=20080331.00
perl-devel-peek=1.04
perl-devel-ppport=3.19
perl-digest=1.16
perl-digest-md5=2.39
perl-digest-sha=5.47
perl-encode=2.39
perl-encoding-warnings=0.11
perl-exporter=5.64_01
perl-extutils-cbuilder=0.27
perl-extutils-command=1.16
perl-extutils-constant=0.22
perl-extutils-embed=1.28
perl-extutils-install=1.55
perl-extutils-makemaker=6.56
perl-extutils-manifest=1.57
perl-extutils-parsexs=2.21
perl-file-fetch=0.24
perl-file-path=2.08_01
perl-file-temp=0.22
perl-filter=1.37
perl-filter-simple=0.84
perl-getopt-long=2.38
perl-if=0.05
perl-io=1.25_02
perl-io-compress=2.024
perlio-via-quotedprint=0.06
perl-io-zlib=1.10
perl-ipc-cmd=0.54
perl-ipc-sysv=2.01
perl-libnet=1.22
perl-locale-codes=2.07
perl-locale-maketext=1.14
perl-locale-maketext-simple=0.21
perl-log-message=0.02
perl-log-message-simple=0.06
perl-math-bigint=1.89_01
perl-math-bigint-fastcalc=0.19
perl-math-bigrat=0.24
perl-math-complex=1.56
perl-memoize=1.01_03
perl-mime-base64=3.08
perl-module-build=0.3603
perl-module-corelist=2.29
perl-module-load=0.16
perl-module-load-conditional=0.34
perl-module-loaded=0.06
perl-module-pluggable=3.9
perl-net-ping=2.36
perl-next=0.64
perl-object-accessor=0.36
perl-package-constants=0.02
perl-params-check=0.26
perl-parent=0.223
perl-parse-cpan-meta=1.40
perl-pathtools=3.31
perl-pod-escapes=1.04
perl-pod-latex=0.58
perl-podlators=2.3.1
perl-pod-parser=1.37
perl-pod-perldoc=3.15_02
perl-pod-plainer=1.02
perl-pod-simple=3.14
perl-safe=2.27
perl-scalar-list-utils=1.22
perl-selfloader=1.17
perl-shell=0.72_01
perl-storable=2.22
perl-switch=2.16
perl-sys-syslog=0.27
perl-term-ansicolor=2.02
perl-term-cap=1.12
perl-term-ui=0.20
perl-test=1.25_02
perl-test-harness=3.17
perl-test-simple=0.94
perl-text-balanced=2.02
perl-text-parsewords=3.27
perl-text-soundex=3.03_01
perl-text-tabs+wraps=2009.0305
perl-thread-queue=2.11
perl-threads=1.75
perl-thread-semaphore=2.09
perl-threads-shared=1.32
perl-tie-file=0.97_02
perl-tie-refhash=1.38
perl-time-hires=1.9719
perl-time-local=1.1901_01
perl-time-piece=1.15_01
perl-unicode-collate=0.52_01
perl-unicode-normalize=1.03
perl-version=0.82
perl-win32=0.39
perl-win32api-file=0.1101
perl-xsloader=0.10
)
options=('!makeflags' '!purge')
md5sums=('04a4c5d3c1f9f19d77daff8e8cd19a26'
'd42c73468e596309f85908ee94a633e5'
'1f0cbbee783e8a6d32f01be5118e0d5e'
'31fc0b5bb4935414394c5cfbec2cb8e5'
'79cc7d76a208a6b935a08269434bfd04'
'a77c19a159b04f18f06c5a0ff9791b23')
build() {
cd ${srcdir}/${pkgname}-${pkgver}
@ -143,6 +37,9 @@ build() {
# for i686
arch_opts=""
fi
patch -Np1 -i $srcdir/digest_eval_hole.diff
./Configure -des -Dusethreads -Duseshrplib -Doptimize="${CFLAGS}" \
-Dprefix=/usr -Dinstallprefix=${pkgdir}/usr -Dvendorprefix=/usr \
-Dprivlib=/usr/share/perl5/core_perl \
@ -155,19 +52,33 @@ build() {
-Dsitescript=/usr/bin/site_perl \
-Dvendorscript=/usr/bin/vendor_perl \
-Dinc_version_list=none \
-Dman1ext=1perl -Dman3ext=3perl ${arch_opts}
patch -Np1 -i $srcdir/fix-h2ph-and-tests.patch
-Dman1ext=1perl -Dman3ext=3perl ${arch_opts} \
-Dlddlflags="-shared ${LDFLAGS}" -Dldflags="${LDFLAGS}"
patch -Np1 -i $srcdir/0001-Append-CFLAGS-and-LDFLAGS-to-their-Config.pm-counter.patch
make
# check
}
check() {
cd ${srcdir}/${pkgname}-${pkgver}
TEST_JOBS=$(echo $MAKEFLAGS | sed 's/.*-j\([0-9][0-9]*\).*/\1/') make test_harness
# make test
}
package() {
# hack to work around makepkg running the subshell in check()
new_provides=($(cd "$srcdir/perl-$pkgver"; LD_PRELOAD=./libperl.so ./perl -Ilib "$srcdir/provides.pl" .))
provides=(${new_provides[@]})
cd ${srcdir}/${pkgname}-${pkgver}
make install
### Perl Settings ###
# Change man page extensions for site and vendor module builds.
sed -e '/^man1ext=/ s/1perl/1p/' -e '/^man3ext=/ s/3perl/3pm/' \
-e "/^cf_email=/ s/'.*'/'chakra-linux@googlegroups.com'/" \
-e "/^perladmin=/ s/'.*'/'chakra-linux@googlegroups.com'/" \
-e "/^cf_email=/ s/'.*'/'info@chakra-project.org'/" \
-e "/^perladmin=/ s/'.*'/'info@chakra-project.org'/" \
-i ${pkgdir}/usr/lib/perl5/core_perl/Config_heavy.pl
### CPAN Settings ###
@ -182,9 +93,12 @@ package() {
-e "/{'buildflags'}/ s/'';/'installdirs=site';/" \
-i ${pkgdir}/usr/share/perl5/core_perl/CPANPLUS/Config.pm
# Profile script so set paths to perl scripts.
# Profile script to set paths to perl scripts.
install -D -m755 ${srcdir}/perlbin.sh \
${pkgdir}/etc/profile.d/perlbin.sh
# Profile script to set paths to perl scripts on csh. (FS#22441)
install -D -m755 ${srcdir}/perlbin.csh \
${pkgdir}/etc/profile.d/perlbin.csh
(cd ${pkgdir}/usr/bin; mv perl${pkgver} perl)
(cd ${pkgdir}/usr/bin/core_perl; ln -sf c2ph pstruct; ln -sf s2p psed)
@ -198,9 +112,9 @@ package() {
find $d -name *.pod -delete
fi
done
find $pkgdir/usr/lib -name *.pod -delete
find $pkgdir -name .packlist -delete
install -dv ${pkgdir}/etc/ld.so.conf.d
echo "/usr/lib/perl5/core_perl/CORE" > ${pkgdir}/etc/ld.so.conf.d/perl.conf
}
md5sums=('72f3f7e1c700e79bbf9d9279ca5b42d9'
'f86eb0dba1638ca6d1c8fff1b06c2a71'
'294b5311cbfc50e7dcffbee85854da38')

62
perl/digest_eval_hole.diff Normal file
View File

@ -0,0 +1,62 @@
From 4b6a7324284e7435a361c58f7ddb32fc0c635bd0 Mon Sep 17 00:00:00 2001
From: "Michael G. Schwern" <schwern@pobox.com>
Date: Mon, 3 Oct 2011 19:05:29 +0100
Subject: Close the eval "require $module" security hole in
Digest->new($algorithm)
Also the filter was incomplete.
Bug-Debian: http://bugs.debian.org/644108
Patch-Name: fixes/digest_eval_hole.diff
---
cpan/Digest/Digest.pm | 6 ++++--
cpan/Digest/t/security.t | 14 ++++++++++++++
2 files changed, 18 insertions(+), 2 deletions(-)
create mode 100644 cpan/Digest/t/security.t
diff --git a/cpan/Digest/Digest.pm b/cpan/Digest/Digest.pm
index 384dfc8..d714434 100644
--- a/cpan/Digest/Digest.pm
+++ b/cpan/Digest/Digest.pm
@@ -24,7 +24,7 @@ sub new
shift; # class ignored
my $algorithm = shift;
my $impl = $MMAP{$algorithm} || do {
- $algorithm =~ s/\W+//;
+ $algorithm =~ s/\W+//g;
"Digest::$algorithm";
};
$impl = [$impl] unless ref($impl);
@@ -35,7 +35,9 @@ sub new
($class, @args) = @$class if ref($class);
no strict 'refs';
unless (exists ${"$class\::"}{"VERSION"}) {
- eval "require $class";
+ my $pm_file = $class . ".pm";
+ $pm_file =~ s{::}{/}g;
+ eval { require $pm_file };
if ($@) {
$err ||= $@;
next;
diff --git a/cpan/Digest/t/security.t b/cpan/Digest/t/security.t
new file mode 100644
index 0000000..5cba122
--- /dev/null
+++ b/cpan/Digest/t/security.t
@@ -0,0 +1,14 @@
+#!/usr/bin/env perl
+
+# Digest->new() had an exploitable eval
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+use Digest;
+
+$LOL::PWNED = 0;
+eval { Digest->new(q[MD;5;$LOL::PWNED = 42]) };
+is $LOL::PWNED, 0;

104
perl/fix-h2ph-and-tests.patch
View File

@ -1,104 +0,0 @@
From 8d66b3f930dc6d88b524d103e304308ae73a46e7 Mon Sep 17 00:00:00 2001
From: Robin Barker <rmbarker@cpan.org>
Date: Thu, 22 Apr 2010 11:51:20 +0100
Subject: [PATCH 1/1] Fix h2ph and test
---
lib/h2ph.t | 12 ++++++++++--
utils/h2ph.PL | 28 +++++++++++++++++++++++-----
2 files changed, 33 insertions(+), 7 deletions(-)
diff --git a/lib/h2ph.t b/lib/h2ph.t
index 27dd7b9..8d62d46 100644
--- a/lib/h2ph.t
+++ b/lib/h2ph.t
@@ -18,7 +18,7 @@ if (!(-e $extracted_program)) {
exit 0;
}
-plan(4);
+plan(5);
# quickly compare two text files
sub txt_compare {
@@ -41,8 +41,16 @@ $result = runperl( progfile => 'lib/h2ph.pht',
stderr => 1 );
like( $result, qr/syntax OK$/, "output compiles");
+$result = runperl( progfile => '_h2ph_pre.ph',
+ switches => ['-c'],
+ stderr => 1 );
+like( $result, qr/syntax OK$/, "preamble compiles");
+
$result = runperl( switches => ["-w"],
- prog => '$SIG{__WARN__} = sub { die $_[0] }; require q(lib/h2ph.pht);');
+ stderr => 1,
+ prog => <<'PROG' );
+$SIG{__WARN__} = sub { die $_[0] }; require q(lib/h2ph.pht);
+PROG
is( $result, '', "output free of warnings" );
# cleanup
diff --git a/utils/h2ph.PL b/utils/h2ph.PL
index 8f56db4..1255807 100644
--- a/utils/h2ph.PL
+++ b/utils/h2ph.PL
@@ -401,7 +401,10 @@ if ($opt_e && (scalar(keys %bad_file) > 0)) {
exit $Exit;
sub expr {
- $new = '"(assembly code)"' and return if /\b__asm__\b/; # freak out.
+ if (/\b__asm__\b/) { # freak out
+ $new = '"(assembly code)"';
+ return
+ }
my $joined_args;
if(keys(%curargs)) {
$joined_args = join('|', keys(%curargs));
@@ -770,7 +773,7 @@ sub inc_dirs
sub build_preamble_if_necessary
{
# Increment $VERSION every time this function is modified:
- my $VERSION = 2;
+ my $VERSION = 3;
my $preamble = "$Dest_dir/_h2ph_pre.ph";
# Can we skip building the preamble file?
@@ -798,7 +801,16 @@ sub build_preamble_if_necessary
# parenthesized value: d=(v)
$define{$_} = $1;
}
- if ($define{$_} =~ /^([+-]?(\d+)?\.\d+([eE][+-]?\d+)?)[FL]?$/) {
+ if (/^(\w+)\((\w)\)$/) {
+ my($macro, $arg) = ($1, $2);
+ my $def = $define{$_};
+ $def =~ s/$arg/\$\{$arg\}/g;
+ print PREAMBLE <<DEFINE;
+unless (defined &$macro) { sub $macro(\$) { my (\$$arg) = \@_; \"$def\" } }
+
+DEFINE
+ } elsif
+ ($define{$_} =~ /^([+-]?(\d+)?\.\d+([eE][+-]?\d+)?)[FL]?$/) {
# float:
print PREAMBLE
"unless (defined &$_) { sub $_() { $1 } }\n\n";
@@ -807,8 +819,14 @@ sub build_preamble_if_necessary
print PREAMBLE
"unless (defined &$_) { sub $_() { $1 } }\n\n";
} elsif ($define{$_} =~ /^\w+$/) {
- print PREAMBLE
- "unless (defined &$_) { sub $_() { &$define{$_} } }\n\n";
+ my $def = $define{$_};
+ if ($isatype{$def}) {
+ print PREAMBLE
+ "unless (defined &$_) { sub $_() { \"$def\" } }\n\n";
+ } else {
+ print PREAMBLE
+ "unless (defined &$_) { sub $_() { &$def } }\n\n";
+ }
} else {
print PREAMBLE
"unless (defined &$_) { sub $_() { \"",
--
1.6.5.2.74.g610f9.dirty

15
perl/perlbin.csh Normal file
View File

@ -0,0 +1,15 @@
# Set path to perl scriptdirs if they exist
# https://wiki.archlinux.org/index.php/Perl_Policy#Binaries_and_Scripts
# Added /usr/bin/*_perl dirs for scripts
# Remove /usr/lib/perl5/*_perl/bin in next release
[ -d /usr/bin/site_perl ] && setenv PATH ${PATH}:/usr/bin/site_perl
[ -d /usr/lib/perl5/site_perl/bin ] && setenv PATH ${PATH}:/usr/lib/perl5/site_perl/bin
[ -d /usr/bin/vendor_perl ] && setenv PATH ${PATH}:/usr/bin/vendor_perl
[ -d /usr/lib/perl5/vendor_perl/bin ] && setenv PATH ${PATH}:/usr/lib/perl5/vendor_perl/bin
[ -d /usr/bin/core_perl ] && setenv PATH ${PATH}:/usr/bin/core_perl
# If you have modules in non-standard directories you can add them here.
#export PERLLIB=dir1:dir2

16
perl/perlbin.sh
View File

@ -1,20 +1,14 @@
# Set path to perl scriptdirs if they exist
# https://wiki.archlinux.org/index.php/Perl_Policy#Binaries_and_Scripts
# Added /usr/bin/*_perl dirs for scripts
# Remove /usr/lib/perl5/*_perl/bin in next release
[ -d /usr/bin/site_perl ] &&
PATH=$PATH:/usr/bin/site_perl
[ -d /usr/lib/perl5/site_perl/bin ] &&
PATH=$PATH:/usr/lib/perl5/site_perl/bin
[ -d /usr/bin/site_perl ] && PATH=$PATH:/usr/bin/site_perl
[ -d /usr/lib/perl5/site_perl/bin ] && PATH=$PATH:/usr/lib/perl5/site_perl/bin
[ -d /usr/bin/vendor_perl ] &&
PATH=$PATH:/usr/bin/vendor_perl
[ -d /usr/lib/perl5/vendor_perl/bin ] &&
PATH=$PATH:/usr/lib/perl5/vendor_perl/bin
[ -d /usr/bin/vendor_perl ] && PATH=$PATH:/usr/bin/vendor_perl
[ -d /usr/lib/perl5/vendor_perl/bin ] && PATH=$PATH:/usr/lib/perl5/vendor_perl/bin
[ -d /usr/bin/core_perl ] &&
PATH=$PATH:/usr/bin/core_perl
[ -d /usr/bin/core_perl ] && PATH=$PATH:/usr/bin/core_perl
export PATH

286
perl/provides.pl Executable file
View File

@ -0,0 +1,286 @@
# provides.pl
##
# Script for printing out a provides list of every CPAN distribution
# that is bundled with perl.
#
# Justin Davis <jrcd83@gmail.com>
use warnings 'FATAL' => 'all';
use strict;
package Common;
sub evalver
{
my ($path, $mod) = @_;
$mod ||= "";
open my $fh, '<', $path or die "open $path: $!";
while (<$fh>) {
next unless /\s*(?:\$${mod}::|\$)VERSION\s*=\s*(.+)/;
my $ver = eval $1;
return $ver unless $@;
warn qq{$path:$. bad version string "$ver"\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.appspot.com/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/;
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) || 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;
# Package names should be lowercase and consist of alphanumeric
# characters only (and hyphens!)...
$name =~ tr/A-Z/a-z/;
$name =~ tr/_+/-/; # _ and +'s converted to - (ie Tabbed-Text+Wrap)
$name =~ tr/-a-z0-9+//cd; # Delete all other chars.
$name =~ tr/-/-/s;
# 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;
# Remove developer versions because pacman has no special logic
# to compare them to regular versions like perl does.
$version =~ s/_[^_]+\z//;
$version =~ tr/_//d; # delete other underscores
$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";
}