In perl.git, the branch maint-5.10 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/8ef7ab02574b3ad1086cb7dbfbde9285b155b723?hp=ced57a7b6cbbe6d521fffd3924b633ff920c2c9d>
- Log ----------------------------------------------------------------- commit 8ef7ab02574b3ad1086cb7dbfbde9285b155b723 Author: Steffen Mueller <[email protected]> Date: Fri Jun 19 16:16:51 2009 +0200 Fix API docs:SvGAMAGIC returns a U32, not a char* (cherry picked from commit 458b44e7bc48569051e0eb9b5630ba87d7e5eed4) M sv.h commit 29cf5fea5e94c9df7b8b570e98afa7d4ad95d6dc Author: Jim Cromie <[email protected]> Date: Wed Jun 17 11:32:03 2009 -0600 make_patchnum.pl now works in -Dmksymlink target dirs this fixes script to work when run from a target/build dir created by Configure -Dmksymlinks.. It works properly when building in the srcdir too. Several git commands fail for me, I added $opt_v=1 to see, and left them; they add ~15 lines of output to a build. (A bit amended by rgs: made $opt_v dependent on a -v flag on the command-line) (cherry picked from commit 3f1788e11f2685299067ac0f8d3e4fd141a5b5cd) M make_patchnum.pl commit 7c9856fac8043ebcaf7ffcaf6817f96ac4c2b969 Author: Nicholas Clark <[email protected]> Date: Thu Jun 18 20:37:28 2009 +0100 Allow expand-macro.pl to expand macros in perl.h without pre-processor warnings. (cherry picked from commit 4784c5e80ccedd3734ce162e02ed1c7e25e60c01) M Porting/expand-macro.pl commit 8a14d253a3dd383528854eb881773c3db00238a9 Author: Nicholas Clark <[email protected]> Date: Thu Jun 18 20:33:09 2009 +0100 Make expand-macro.pl scan config.h, if it exists. (cherry picked from commit ed690650a4d3639a6ac1ace13598aa3f1c99d7dc) M Porting/expand-macro.pl commit 1929e4d731486fd656a688996622effb085b29fd Author: Craig A. Berry <[email protected]> Date: Wed Jun 17 21:23:49 2009 -0500 Handle the rare but legal angle bracket in unixify. We have been getting: $ perl -e "print VMS::Filespec::unixify('foo:<bar>');" /foo/<bar/ but should be (and now are) getting: $ perl -e "print VMS::Filespec::unixify('foo:<bar>');" /foo/bar/ (cherry picked from commit 5ad5b34cb2af84d4f37219a5dee752fca0459151) M vms/ext/filespec.t M vms/vms.c commit f4861c9517f894b5afc1c0d51adf526c1686b697 Author: David Mitchell <[email protected]> Date: Fri Jun 19 16:00:29 2009 +0100 add Porting/core-cpan-diff (cherry picked from commit cb097e7a7eb1098f10246724baff2d8189ac41c5) M MANIFEST A Porting/core-cpan-diff commit 495646e1ce970acf1fdfcfceb3beee216d0c865e Author: David Mitchell <[email protected]> Date: Fri Jun 19 15:57:27 2009 +0100 Maintainers.pl: add @IGNORABLE and document EXCLUDED, MAP fields (cherry picked from commit 2c95b6e4c4a0372d018a26686c0b0af74cf6592c) M Porting/Maintainers.pl commit e076be27d00f971e10e4b48c6ebc0e6448e85308 Author: David Golden <[email protected]> Date: Mon Jun 15 23:13:48 2009 -0400 add-package.pl lib exclude fixed Was deleting from lib, but should delete from perl/lib (cherry picked from commit a51040a0e9b5994cdc27784703fe3dec6a58bbfd) M Porting/add-package.pl commit 2ac2c9cf9d530f6c0a7ba38dc02dfabdb93c3324 Author: Jerry D. Hedden <[email protected]> Date: Fri Jun 19 13:00:40 2009 -0400 Upgrade to threads::shared 1.29 (cherry picked from commit 63790022394e4278430e337fa8d8576711061741) M ext/threads-shared/Makefile.PL M ext/threads-shared/shared.pm M ext/threads-shared/t/0nothread.t M ext/threads-shared/t/av_refs.t M ext/threads-shared/t/av_simple.t M ext/threads-shared/t/blessed.t M ext/threads-shared/t/clone.t M ext/threads-shared/t/cond.t M ext/threads-shared/t/disabled.t M ext/threads-shared/t/hv_refs.t M ext/threads-shared/t/hv_simple.t M ext/threads-shared/t/no_share.t M ext/threads-shared/t/object.t M ext/threads-shared/t/shared_attr.t M ext/threads-shared/t/stress.t M ext/threads-shared/t/sv_refs.t M ext/threads-shared/t/sv_simple.t M ext/threads-shared/t/utf8.t M ext/threads-shared/t/wait.t M ext/threads-shared/t/waithires.t ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + Porting/Maintainers.pl | 46 +++ Porting/add-package.pl | 2 +- Porting/core-cpan-diff | 591 ++++++++++++++++++++++++++++++++++++ Porting/expand-macro.pl | 8 +- ext/threads-shared/Makefile.PL | 2 +- ext/threads-shared/shared.pm | 8 +- ext/threads-shared/t/0nothread.t | 9 +- ext/threads-shared/t/av_refs.t | 4 - ext/threads-shared/t/av_simple.t | 4 - ext/threads-shared/t/blessed.t | 4 - ext/threads-shared/t/clone.t | 4 - ext/threads-shared/t/cond.t | 4 - ext/threads-shared/t/disabled.t | 7 - ext/threads-shared/t/hv_refs.t | 4 - ext/threads-shared/t/hv_simple.t | 4 - ext/threads-shared/t/no_share.t | 4 - ext/threads-shared/t/object.t | 4 - ext/threads-shared/t/shared_attr.t | 4 - ext/threads-shared/t/stress.t | 4 - ext/threads-shared/t/sv_refs.t | 4 - ext/threads-shared/t/sv_simple.t | 4 - ext/threads-shared/t/utf8.t | 4 - ext/threads-shared/t/wait.t | 5 - ext/threads-shared/t/waithires.t | 5 - make_patchnum.pl | 40 ++- sv.h | 2 +- vms/ext/filespec.t | 1 + vms/vms.c | 2 +- 29 files changed, 687 insertions(+), 98 deletions(-) create mode 100755 Porting/core-cpan-diff diff --git a/MANIFEST b/MANIFEST index 19928a6..54f78d8 100755 --- a/MANIFEST +++ b/MANIFEST @@ -3704,6 +3704,7 @@ Porting/config_H Sample config.h Porting/config_h.pl Reorder config_h.SH after metaconfig Porting/config.sh Sample config.sh Porting/Contract Social contract for contributed modules in Perl core +Porting/core-cpan-diff Compare core distros with their CPAN equivalents Porting/corecpan.pl Reports outdated dual-lived modules Porting/corelist.pl Generates data for Module::CoreList Porting/curliff.pl Curliff or liff your curliffable files. diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 0d553da..1f8df4a 100644 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -88,6 +88,21 @@ package Maintainers; 'zefram' => 'Andrew Main <[email protected]>', ); + +# IGNORABLE: files which, if they appear in the root of a CPAN +# distribution, need not appear in core (i.e. core-cpan-diff won't +# complain if it can't find them) + +...@ignorable = qw( + .cvsignore .dualLivedDiffConfig .gitignore + ANNOUNCE Announce Artistic AUTHORS BENCHMARK BUGS Build.PL + CHANGELOG ChangeLog CHANGES Changes COPYING Copying CREDITS + GOALS HISTORY INSTALL INSTALL.SKIP LICENSE Makefile.PL + MANIFEST MANIFEST.SKIP META.yml NEW NOTES ppport.h README + SIGNATURE THANKS TODO Todo VERSION WHATSNEW +); + + # Each entry in the %Modules hash roughly represents a distribution, # except in the case of CPAN=1, where it *exactly* represents a single # CPAN distribution. @@ -119,6 +134,37 @@ package Maintainers; # included in core are derived from. Note that the file's version may not # necessarily match the newest version on CPAN. +# EXCLUDED is a list of files to be excluded from a CPAN tarball before +# comparing the remaining contents with core. Each item can either be a +# full pathname (eg 't/foo.t') or a pattern (e.g. qr{^t/}). +# It defaults to the empty list. + +# MAP is a hash that maps CPAN paths to their core equivalents. +# Each key reprepresents a string prefix, with longest prefixes checked +# first. The first match causes that prefix to be replaced with the +# corresponding key. For example, with the following MAP: +# { +# 'lib/' => 'lib/', +# '' => 'lib/Foo/', +# }, +# +# these files are mapped as shown: +# +# README becomes lib/Foo/README +# lib/Foo.pm becomes lib/Foo.pm +# +# The default is dependent on the type of module. +# For distributions which appear to be stored under ext/, it defaults to: +# +# { '' => 'ext/Foo-Bar/' } +# +# otherwise, it's +# +# { +# 'lib/' => 'lib/', +# '' => 'lib/Foo/Bar/', +# } + %Modules = ( 'Archive::Extract' => diff --git a/Porting/add-package.pl b/Porting/add-package.pl index d91c3d5..20947c0 100644 --- a/Porting/add-package.pl +++ b/Porting/add-package.pl @@ -80,7 +80,7 @@ my @LibFiles; undef } : 1 - } `find lib -type f` + } `find $Repo/lib -type f` or die "Could not detect library files\n"; print "done\n" if $Verbose; diff --git a/Porting/core-cpan-diff b/Porting/core-cpan-diff new file mode 100755 index 0000000..80d6b7d --- /dev/null +++ b/Porting/core-cpan-diff @@ -0,0 +1,591 @@ +#!/usr/bin/env perl + +# core-cpan-diff: Compare CPAN modules with their equivalent in core + +# Originally based on App::DualLivedDiff by Steffen Mueller. + +use strict; +use warnings; + +use 5.010; + +use Getopt::Long; +use File::Temp (); +use File::Path (); +use File::Spec; +use Archive::Extract; +use IO::Uncompress::Gunzip (); +use File::Compare (); +use ExtUtils::Manifest; + +BEGIN { die "Must be run from root of perl source tree\n" unless -d 'Porting' } +use lib 'Porting'; +use Maintainers (); + +# if running from blead, we may be doing -Ilib, which means when we +# 'chdir /tmp/foo', Archive::Extract may not find Archive::Tar etc. +# So preload the things we need, and tell it to check %INC first: + +use Archive::Tar; +use IPC::Open3; +use IO::Select; +$Module::Load::Conditional::CHECK_INC_HASH = 1; +# stop Archive::Extract whinging about lack of Archive::Zip +$Archive::Extract::WARN = 0; + + +# Files, which if they exist in CPAN but not in perl, will not generate +# an 'Only in CPAN' listing +# +our %IGNORABLE = map { ($_ => 1) } + qw(.cvsignore .dualLivedDiffConfig .gitignore + ANNOUNCE Announce Artistic AUTHORS BENCHMARK BUGS Build.PL + CHANGELOG ChangeLog CHANGES Changes COPYING Copying CREDITS + GOALS HISTORY INSTALL INSTALL.SKIP LICENSE Makefile.PL + MANIFEST MANIFEST.SKIP META.yml NEW NOTES ppport.h README + SIGNATURE THANKS TODO Todo VERSION WHATSNEW); + +# where, under the cache dir, to untar stuff to + +use constant UNTAR_DIR => 'untarred'; + +use constant DIFF_CMD => 'diff'; +use constant WGET_CMD => 'wget'; + +sub usage { + print STDERR "\...@_\n\n" if @_; + print STDERR <<HERE; +Usage: $0 [opts] [ -d | -v | -x ] [ -a | module ... ] + +-a/--all Scan all dual-life modules. + +-c/--cachedir Where to save downloaded CPAN tarball files + (defaults to /tmp/something/ with deletion after each run). + +-d/--diff Display file differences using diff(1), rather than just + listing which files have changed. + The diff(1) command is assumed to be in your PATH. + +--diffopts Options to pass to the diff command. Defaults to '-u'. + +-f|force Force download from CPAN of new 02packages.details.txt file + (with --crosscheck only). + +-o/--output File name to write output to (defaults to STDOUT). + +-r/--reverse Reverses the diff (perl to CPAN). + +-v/--verbose List the fate of *all* files in the tarball, not just those + that differ or are missing. + +-x|crosscheck List the distributions whose current CPAN version differs from + that in blead (i.e. the DISTRIBUTION field in Maintainers.pl). + +By default (i.e. without the --crosscheck option), for each listed module +(or with -a, all CPAN modules listed in Maintainers.pl), grab the tarball +from CPAN associated with that module, and compare the files in it with +those in the perl source tree. + +Must be run from the root of the perl source tree. +Module names must match the keys of %Modules in Maintainers.pl. +HERE + exit(1); +} + + +sub run { + my $scan_all; + my $diff_opts; + my $reverse = 0; + my $cache_dir; + my $use_diff; + my $output_file; + my $verbose; + my $force; + my $do_crosscheck; + + GetOptions( + 'a|all' => \$scan_all, + 'c|cachedir=s' => \$cache_dir, + 'd|diff' => \$use_diff, + 'diffopts:s' => \$diff_opts, + 'f|force' => \$force, + 'h|help' => \&usage, + 'o|output=s' => \$output_file, + 'r|reverse' => \$reverse, + 'v|verbose' => \$verbose, + 'x|crosscheck' => \$do_crosscheck, + ) or usage; + + + my @modules; + + usage("Cannot mix -a with module list") if $scan_all && @ARGV; + + if ($do_crosscheck) { + usage("can't use -r, -d, --diffopts, -v with --crosscheck") + if ($reverse || $use_diff || $diff_opts || $verbose); + } + else { + $diff_opts = '-u' unless defined $diff_opts; + usage("can't use -f without --crosscheck") if $force; + } + + @modules = $scan_all + ? grep $Maintainers::Modules{$_}{CPAN}, + (sort {lc $a cmp lc $b } keys %Maintainers::Modules) + : @ARGV; + usage("No modules specified") unless @modules; + + + my $outfh; + if (defined $output_file) { + open $outfh, '>', $output_file + or die "ERROR: could not open file '$output_file' for writing: $!"; + } + else { + open $outfh, ">&STDOUT" + or die "ERROR: can't dup STDOUT: $!"; + } + + if (defined $cache_dir) { + die "ERROR: no such directory: '$cache_dir'\n" unless -d $cache_dir; + } + + if ($do_crosscheck) { + do_crosscheck($outfh, $cache_dir, $force, \...@modules); + } + else { + do_compare(\...@modules, $outfh, $cache_dir, $verbose, $use_diff, + $reverse, $diff_opts); + } +} + + + +# compare a list of modules against their CPAN equivalents + +sub do_compare { + my ($modules, $outfh, $cache_dir, $verbose, + $use_diff, $reverse, $diff_opts) = @_; + + + # first, make sure we have a directory where they can all be untarred, + # and if its a permanent directory, clear any previous content + my $untar_dir; + if ($cache_dir) { + $untar_dir = File::Spec->catdir($cache_dir, UNTAR_DIR); + if (-d $untar_dir) { + File::Path::rmtree($untar_dir) + or die "failed to remove $untar_dir\n"; + } + mkdir $untar_dir + or die "mkdir $untar_dir: $!\n"; + } + else { + $untar_dir = File::Temp::tempdir( CLEANUP => 1 ); + } + + my %ignorable = map { ($_ => 1) } @Maintainers::IGNORABLE; + + my %seen_dist; + for my $module (@$modules) { + print $outfh "\n$module\n" unless $use_diff; + + my $m = $Maintainers::Modules{$module} + or die "ERROR: No such module in Maintainers.pl: '$module'\n"; + + unless ($m->{CPAN}) { + print $outfh "WARNING: $module is not dual-life; skipping\n"; + next; + } + + my $dist = $m->{DISTRIBUTION}; + die "ERROR: $module has no DISTRIBUTION entry\n" unless defined $dist; + + if ($seen_dist{$dist}) { + warn "WARNING: duplicate entry for $dist in $module\n" + } + $seen_dist{$dist}++; + + my $cpan_dir = get_distribution($cache_dir, $untar_dir, $module, $dist); + + + my @perl_files = Maintainers::get_module_files($module); + + my $manifest = File::Spec->catfile($cpan_dir, 'MANIFEST'); + die "ERROR: no such file: $manifest\n" unless -f $manifest; + + my $cpan_files = ExtUtils::Manifest::maniread($manifest); + my @cpan_files = sort keys %$cpan_files; + + my ($excluded, $map) = get_map($m, $module, \...@perl_files); + + my %perl_unseen; + @perl_unse...@perl_files} = (); + my %perl_files = %perl_unseen; + + foreach my $cpan_file (@cpan_files) { + my $mapped_file = cpan_to_perl($excluded, $map, $cpan_file); + unless (defined $mapped_file) { + print $outfh " Excluded: $cpan_file\n" if $verbose; + next; + } + + if (exists $perl_files{$mapped_file}) { + delete $perl_unseen{$mapped_file}; + } + else { + # some CPAN files foo are stored in core as foo.packed, + # which are then unpacked by 'make test_prep' + my $packed_file = "$mapped_file.packed"; + if (exists $perl_files{$packed_file} ) { + if (! -f $mapped_file and -f $packed_file) { + print $outfh <<EOF; +WARNING: $mapped_file not found, but .packed variant exists. +Perhaps you need to run 'make test_prep'? +EOF + next; + } + delete $perl_unseen{$packed_file}; + } + else { + if ($ignorable{$cpan_file}) { + print $outfh " Ignored: $cpan_file\n" if $verbose; + next; + } + + unless ($use_diff) { + print $outfh " CPAN only: $cpan_file", + ($cpan_file eq $mapped_file) ? "\n" + : " (expected $mapped_file)\n"; + } + next; + } + } + + + my $abs_cpan_file = File::Spec->catfile($cpan_dir, $cpan_file); + + # should never happen + die "ERROR: can't find file $abs_cpan_file\n" unless -f $abs_cpan_file; + + # might happen if the FILES entry in Maintainers.pl is wrong + unless (-f $mapped_file) { + print $outfh "WARNING: perl file not found: $mapped_file\n"; + next; + } + + + if (File::Compare::compare($abs_cpan_file, $mapped_file)) { + if ($use_diff) { + file_diff($outfh, $abs_cpan_file, $mapped_file, + $reverse, $diff_opts); + } + else { + if ($cpan_file eq $mapped_file) { + print $outfh " Modified: $cpan_file\n"; + } + else { + print $outfh " Modified: $cpan_file $mapped_file\n"; + } + } + } + elsif ($verbose) { + if ($cpan_file eq $mapped_file) { + print $outfh " Unchanged: $cpan_file\n"; + } + else { + print $outfh " Unchanged: $cpan_file $mapped_file\n"; + } + } + } + for (sort keys %perl_unseen) { + print $outfh " Perl only: $_\n" unless $use_diff; + } + } +} + +# given FooBar-1.23_45.tar.gz, return FooBar + +sub distro_base { + my $d = shift; + $d =~ s/\.tar\.gz$//; + $d =~ s/\.gip$//; + $d =~ s/[\d\-_\.]+$//; + return $d; +} + +# process --crosscheck action: +# ie list all distributions whose CPAN versions differ from that listed in +# Maintainers.pl + +sub do_crosscheck { + my ($outfh, $cache_dir, $force, $modules) = @_; + + my $file = '02packages.details.txt'; + my $download_dir = $cache_dir || File::Temp::tempdir( CLEANUP => 1 ); + my $path = File::Spec->catfile($download_dir, $file); + my $gzfile = "$path.gz"; + + # grab 02packages.details.txt + + my $url = 'http://www.cpan.org/modules/02packages.details.txt.gz'; + + if (! -f $gzfile or $force) { + unlink $gzfile; + my_getstore($url, $gzfile); + } + unlink $path; + IO::Uncompress::Gunzip::gunzip($gzfile, $path) + or die "ERROR: failed to ungzip $gzfile: $IO::Uncompress::Gunzip::GunzipError\n"; + + # suck in the data from it + + open my $fh, '<', $path + or die "ERROR: open: $file: $!\n"; + + my %distros; + my %modules; + + while (<$fh>) { + next if 1../^$/; + chomp; + my @f = split ' ', $_; + if (@f != 3) { + warn "WARNING: $file:$.: line doesn't have three fields (skipping)\n"; + next; + } + $modules{$f[0]} = $f[2]; + + my $distro = $f[2]; + $distro =~ s{^.*/}{}; + + $distros{distro_base($distro)}{$distro} = 1; + } + + for my $module (@$modules) { + my $m = $Maintainers::Modules{$module} + or die "ERROR: No such module in Maintainers.pl: '$module'\n"; + + unless ($m->{CPAN}) { + print $outfh "\nWARNING: $module is not dual-life; skipping\n"; + next; + } + + + # given an try like + # Foo::Bar 1.23 foo-bar-1.23.tar.gz, + # first compare the module name against Foo::Bar, and failing that, + # against foo-bar + + my $pdist = $m->{DISTRIBUTION}; + die "ERROR: $module has no DISTRIBUTION entry\n" unless defined $pdist; + $pdist =~ s{^.*/}{}; + + my $cdist = $modules{$module}; + + if (defined $cdist) { + $cdist =~ s{^.*/}{}; + } + else { + my $d = $distros{distro_base($pdist)}; + unless (defined $d) { + print $outfh "\n$module: Can't determine current CPAN entry\n"; + next; + } + if (keys %$d > 1) { + print $outfh "\n$module: (found more than one CPAN candidate):\n"; + print $outfh " perl: $pdist\n"; + print $outfh " CPAN: $_\n" for sort keys %$d; + next; + } + $cdist = (keys %$d)[0]; + } + + if ($cdist ne $pdist) { + print $outfh "\n$module:\n Perl: $pdist\n CPAN: $cdist\n"; + } + } +} + + + +# get the EXCLUDED and MAP entries for this module, or +# make up defauts if they don't exist + +sub get_map { + my ($m, $module_name, $perl_files) = @_; + + my ($excluded, $map) = @$m{qw(EXCLUDED MAP)}; + + $excluded ||= []; + + return $excluded, $map if $map; + + # all files under ext/foo-bar (plus maybe some under t/lib)??? + + my $ext; + for (@$perl_files) { + if (m{^(ext/[^/]+/)}) { + if (defined $ext and $ext ne $1) { + # more than one ext/$ext/ + undef $ext; + last; + } + $ext = $1; + } + elsif (m{^t/lib/}) { + next; + } + else { + undef $ext; + last; + } + } + + if (defined $ext) { + $map = { '' => $ext }, + } + else { + (my $base = $module_name) =~ s{::}{/}g; + $base ="lib/$base"; + $map = { + 'lib/' => 'lib/', + '' => "$base/", + }; + } + return $excluded, $map; +} + + +# Given an exclude list and a mapping hash, convert a CPAN filename +# (eg 't/bar.t') to the equivalent perl filename (eg 'lib/Foo/Bar/t/bar.t'). +# Returns an empty list for an excluded file + +sub cpan_to_perl { + my ($excluded, $map, $cpan_file) = @_; + + for my $exclude (@$excluded) { + # may be a simple string to match exactly, or a pattern + if (ref $exclude) { + return if $cpan_file =~ $exclude; + } + else { + return if $cpan_file eq $exclude; + } + } + + my $perl_file = $cpan_file; + + # try longest prefix first, then alphabetically on tie-break + for my $prefix (sort { length($b) <=> length($a) || $a cmp $b } keys %$map) + { + last if $perl_file =~ s/^\Q$prefix/$map->{$prefix}/; + } + return $perl_file; +} + + + +# do LWP::Simple::getstore, possibly without LWP::Simple being available + +my $lwp_simple_available; + +sub my_getstore { + my ($url, $file) = @_; + unless (defined $lwp_simple_available) { + eval { require LWP::Simple }; + $lwp_simple_available = $@ eq ''; + } + if ($lwp_simple_available) { + return LWP::Simple::is_success(LWP::Simple::getstore($url, $file)); + } + else { + return system(WGET_CMD, "-O", $file, $url) == 0; + } +} + + +# download and unpack a distribution +# Returns the full pathname of the extracted directory +# (eg '/tmp/XYZ/Foo_bar-1.23') + +# cache_dir: where to dowenload the .tar.gz file to +# untar_dir: where to untar or unzup the file +# module: name of module +# dist: name of the distribution + +sub get_distribution { + my ($cache_dir, $untar_dir, $module, $dist) = @_; + + $dist =~ m{.+/([^/]+)$} + or die "ERROR: $module: invalid DISTRIBUTION name (no AUTHOR/ prefix): $dist"; + my $filename = $1; + + my $download_dir = $cache_dir || File::Temp::tempdir( CLEANUP => 1 ); + my $download_file = File::Spec->catfile($download_dir, $filename); + + # download distribution + + if (-f $download_file and ! -s $download_file ) { + # wget can leave a zero-length file on failed download + unlink $download_file; + } + + unless (-f $download_file) { + # not cached + $dist =~ /^([A-Z])([A-Z])/ + or die "ERROR: $module: invalid DISTRIBUTION name (not /^[A-Z]{2}/): $dist"; + + my $url = "http://www.cpan.org/modules/by-authors/id/$1/$1$2/$dist";; + my_getstore($url, $download_file) + or die "ERROR: Could not fetch '$url'"; + } + + # extract distribution + + my $ae = Archive::Extract->new( archive => $download_file); + $ae->extract( to => $untar_dir ) + or die "ERROR: failed to extract distribution '$download_file to temp. dir: " . $ae->error(); + + # get the name of the extracted distribution dir + + my $path = File::Spec->catfile($untar_dir, $filename); + + $path =~ s/\.tar\.gz$// or + $path =~ s/\.zip$// or + die "ERROR: downloaded file does not have a recognised suffix: $path\n"; + + die "ERROR: Extracted tarball does not appear as $path\n" unless -d $path; + + return $path; +} + + +# produce the diff of a single file +sub file_diff { + my $outfh = shift; + my $cpan_file = shift; + my $perl_file = shift; + my $reverse = shift; + my $diff_opts = shift; + + + my @cmd = (DIFF_CMD, split ' ', $diff_opts); + if ($reverse) { + push @cmd, $perl_file, $cpan_file; + } + else { + push @cmd, $cpan_file, $perl_file; + } + my $result = `...@cmd`; + + $result =~ s{^(--- |\+\+\+ )/tmp/[^/]+/}{$1}gm; + + print $outfh $result; +} + + +run(); + diff --git a/Porting/expand-macro.pl b/Porting/expand-macro.pl index 2cdaa79..ed8e188 100644 --- a/Porting/expand-macro.pl +++ b/Porting/expand-macro.pl @@ -32,6 +32,7 @@ if (!(@ARGV = @headers)) { while (<$fh>) { push @ARGV, $1 if m!^([^/]+\.h)\t!; } + push @ARGV, 'config.h' if -f 'config.h'; } my $header; @@ -56,7 +57,12 @@ my $sentinel = "$macro expands to"; print $out <<"EOF"; #include "EXTERN.h" #include "perl.h" -#include "$header" +EOF + +print qq{#include "$header"\n} + unless $header eq 'perl.h' or $header eq 'EXTERN.h'; + +print $out <<"EOF"; #line 4 "$sentinel" $macro$args EOF diff --git a/ext/threads-shared/Makefile.PL b/ext/threads-shared/Makefile.PL index 7856617..05c7383 100755 --- a/ext/threads-shared/Makefile.PL +++ b/ext/threads-shared/Makefile.PL @@ -62,7 +62,7 @@ if (not grep { $_ eq 'PERL_CORE=1' } @ARGV) { 'Carp' => 0, 'XSLoader' => 0, 'Scalar::Util' => 0, - 'threads' => 1.71, + 'threads' => 1.73, 'Test' => 0, 'Test::More' => 0, diff --git a/ext/threads-shared/shared.pm b/ext/threads-shared/shared.pm index 6f606b0..722e3ce 100644 --- a/ext/threads-shared/shared.pm +++ b/ext/threads-shared/shared.pm @@ -7,7 +7,7 @@ use warnings; use Scalar::Util qw(reftype refaddr blessed); -our $VERSION = '1.28'; +our $VERSION = '1.29'; my $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -187,7 +187,7 @@ threads::shared - Perl extension for sharing data structures between threads =head1 VERSION -This document describes threads::shared version 1.28 +This document describes threads::shared version 1.29 =head1 SYNOPSIS @@ -401,7 +401,7 @@ important to check the value of the variable and go back to waiting if the requirement is not fulfilled. For example, to pause until a shared counter drops to zero: - { lock($counter); cond_wait($count) until $counter == 0; } + { lock($counter); cond_wait($counter) until $counter == 0; } =item cond_timedwait VARIABLE, ABS_TIMEOUT @@ -588,7 +588,7 @@ L<threads::shared> Discussion Forum on CPAN: L<http://www.cpanforum.com/dist/threads-shared> Annotated POD for L<threads::shared>: -L<http://annocpan.org/~JDHEDDEN/threads-shared-1.28/shared.pm> +L<http://annocpan.org/~JDHEDDEN/threads-shared-1.29/shared.pm> Source repository: L<http://code.google.com/p/threads-shared/> diff --git a/ext/threads-shared/t/0nothread.t b/ext/threads-shared/t/0nothread.t index 36b1564..7609fbe 100644 --- a/ext/threads-shared/t/0nothread.t +++ b/ext/threads-shared/t/0nothread.t @@ -1,13 +1,6 @@ use strict; use warnings; -BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } -} - use Test::More (tests => 53); ### Start of Testing ### @@ -65,7 +58,7 @@ sub array ok((require threads::shared),"Require module"); -if ($threads::shared::VERSION && ! exists($ENV{'PERL_CORE'})) { +if ($threads::shared::VERSION && ! $ENV{'PERL_CORE'}) { diag('Testing threads::shared ' . $threads::shared::VERSION); } diff --git a/ext/threads-shared/t/av_refs.t b/ext/threads-shared/t/av_refs.t index 2e77031..8106e32 100644 --- a/ext/threads-shared/t/av_refs.t +++ b/ext/threads-shared/t/av_refs.t @@ -2,10 +2,6 @@ use strict; use warnings; BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } use Config; if (! $Config{'useithreads'}) { print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); diff --git a/ext/threads-shared/t/av_simple.t b/ext/threads-shared/t/av_simple.t index 67d9a32..7fab9b2 100644 --- a/ext/threads-shared/t/av_simple.t +++ b/ext/threads-shared/t/av_simple.t @@ -2,10 +2,6 @@ use strict; use warnings; BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } use Config; if (! $Config{'useithreads'}) { print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); diff --git a/ext/threads-shared/t/blessed.t b/ext/threads-shared/t/blessed.t index 225725f..2599423 100644 --- a/ext/threads-shared/t/blessed.t +++ b/ext/threads-shared/t/blessed.t @@ -2,10 +2,6 @@ use strict; use warnings; BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } use Config; if (! $Config{'useithreads'}) { print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); diff --git a/ext/threads-shared/t/clone.t b/ext/threads-shared/t/clone.t index 64ef93a..fd31181 100644 --- a/ext/threads-shared/t/clone.t +++ b/ext/threads-shared/t/clone.t @@ -2,10 +2,6 @@ use strict; use warnings; BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } use Config; if (! $Config{'useithreads'}) { print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); diff --git a/ext/threads-shared/t/cond.t b/ext/threads-shared/t/cond.t index 3a6bfdf..c2f02a4 100644 --- a/ext/threads-shared/t/cond.t +++ b/ext/threads-shared/t/cond.t @@ -2,10 +2,6 @@ use strict; use warnings; BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } use Config; if (! $Config{'useithreads'}) { print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); diff --git a/ext/threads-shared/t/disabled.t b/ext/threads-shared/t/disabled.t index 161bc79..46e781e 100644 --- a/ext/threads-shared/t/disabled.t +++ b/ext/threads-shared/t/disabled.t @@ -1,13 +1,6 @@ use strict; use warnings; -BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } -} - use Test; plan tests => 31; diff --git a/ext/threads-shared/t/hv_refs.t b/ext/threads-shared/t/hv_refs.t index 3985b3c..ecefdc6 100644 --- a/ext/threads-shared/t/hv_refs.t +++ b/ext/threads-shared/t/hv_refs.t @@ -2,10 +2,6 @@ use strict; use warnings; BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } use Config; if (! $Config{'useithreads'}) { print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); diff --git a/ext/threads-shared/t/hv_simple.t b/ext/threads-shared/t/hv_simple.t index e80cd08..574d8d5 100644 --- a/ext/threads-shared/t/hv_simple.t +++ b/ext/threads-shared/t/hv_simple.t @@ -2,10 +2,6 @@ use strict; use warnings; BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } use Config; if (! $Config{'useithreads'}) { print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); diff --git a/ext/threads-shared/t/no_share.t b/ext/threads-shared/t/no_share.t index 7c97b22..21703ae 100644 --- a/ext/threads-shared/t/no_share.t +++ b/ext/threads-shared/t/no_share.t @@ -2,10 +2,6 @@ use strict; use warnings; BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } use Config; if (! $Config{'useithreads'}) { print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); diff --git a/ext/threads-shared/t/object.t b/ext/threads-shared/t/object.t index 394ed6a..4e3c189 100644 --- a/ext/threads-shared/t/object.t +++ b/ext/threads-shared/t/object.t @@ -2,10 +2,6 @@ use strict; use warnings; BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } use Config; if (! $Config{'useithreads'}) { print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); diff --git a/ext/threads-shared/t/shared_attr.t b/ext/threads-shared/t/shared_attr.t index 09f2310..9085e27 100644 --- a/ext/threads-shared/t/shared_attr.t +++ b/ext/threads-shared/t/shared_attr.t @@ -2,10 +2,6 @@ use strict; use warnings; BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } use Config; if (! $Config{'useithreads'}) { print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); diff --git a/ext/threads-shared/t/stress.t b/ext/threads-shared/t/stress.t index 9fe1c21..e36ab0a 100644 --- a/ext/threads-shared/t/stress.t +++ b/ext/threads-shared/t/stress.t @@ -2,10 +2,6 @@ use strict; use warnings; BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } use Config; if (! $Config{'useithreads'}) { print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); diff --git a/ext/threads-shared/t/sv_refs.t b/ext/threads-shared/t/sv_refs.t index 30173bd..5cc6a22 100644 --- a/ext/threads-shared/t/sv_refs.t +++ b/ext/threads-shared/t/sv_refs.t @@ -2,10 +2,6 @@ use strict; use warnings; BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } use Config; if (! $Config{'useithreads'}) { print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); diff --git a/ext/threads-shared/t/sv_simple.t b/ext/threads-shared/t/sv_simple.t index f4cbcf2..9d264f7 100644 --- a/ext/threads-shared/t/sv_simple.t +++ b/ext/threads-shared/t/sv_simple.t @@ -2,10 +2,6 @@ use strict; use warnings; BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } use Config; if (! $Config{'useithreads'}) { print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); diff --git a/ext/threads-shared/t/utf8.t b/ext/threads-shared/t/utf8.t index 42e7c3f..6e0e664 100644 --- a/ext/threads-shared/t/utf8.t +++ b/ext/threads-shared/t/utf8.t @@ -2,10 +2,6 @@ use strict; use warnings; BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } use Config; if (! $Config{'useithreads'}) { print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); diff --git a/ext/threads-shared/t/wait.t b/ext/threads-shared/t/wait.t index b0a7cc1..2c367fd 100644 --- a/ext/threads-shared/t/wait.t +++ b/ext/threads-shared/t/wait.t @@ -2,11 +2,6 @@ use strict; use warnings; BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } - # Import test.pl into its own package { package Test; diff --git a/ext/threads-shared/t/waithires.t b/ext/threads-shared/t/waithires.t index 4cda602..ae82448 100644 --- a/ext/threads-shared/t/waithires.t +++ b/ext/threads-shared/t/waithires.t @@ -2,11 +2,6 @@ use strict; use warnings; BEGIN { - if ($ENV{'PERL_CORE'}){ - chdir 't'; - unshift @INC, '../lib'; - } - # Import test.pl into its own package { package Test; diff --git a/make_patchnum.pl b/make_patchnum.pl index 2bacd4b..1644d41 100644 --- a/make_patchnum.pl +++ b/make_patchnum.pl @@ -13,7 +13,7 @@ make_patchnum.pl - make patchnum perl make_patchnum.pl -=head1 DESCRITPTION +=head1 DESCRIPTION This program creates the files holding the information about locally applied patches to the source code. The created @@ -23,7 +23,7 @@ files are C<git_version.h> and C<lib/Config_git.pl>. Contains status information from git in a form meant to be processed by the tied hash logic of Config.pm. It is actually optional, -although -V will look strange without it. +although -V:git.\* will be uninformative without it. C<git_version.h> contains similar information in a C header file format, designed to be used by patchlevel.h. This file is obtained @@ -40,8 +40,25 @@ Same terms as Perl itself. =cut +# from a -Dmksymlink target dir, I need to cd to the git-src tree to +# use git (like script does). Presuming that's not unique, one fix is +# to follow Configure's symlink-path to run git. Maybe GIT_DIR or +# path-args can solve it, if so we should advise here, I tried only +# very briefly ('cd -' works too). + +my ($subcd, $srcdir); +our $opt_v = scalar grep $_ eq '-v', @ARGV; + BEGIN { my $root="."; + # test 1st to see if we're a -Dmksymlinks target dir + $subcd = ''; + $srcdir = $root; + if (-l "./Configure") { + $srcdir = readlink("./Configure"); + $srcdir =~ s/Configure//; + $subcd = "cd $srcdir &&"; # activate backtick fragment + } while (!-e "$root/perl.c" and length($root)<100) { if ($root eq '.') { $root=".."; @@ -71,14 +88,20 @@ sub write_file { } sub backtick { + # only for git. If we're in a -Dmksymlinks build-dir, we need to + # cd to src so git will work . Probably a better way. my $command = shift; if (wantarray) { - my @result= `$command`; + my @result= `$subcd $command`; + warn "$subcd $command: \$?=$?\n" if $?; + print "#> $subcd $command ->\n @result\n" if !$? and $opt_v; chomp @result; return @result; } else { - my $result= `$command`; + my $result= `$subcd $command`; $result="" if ! defined $result; + warn "$subcd $command: \$?=$?\n" if $?; + print "#> $subcd $command ->\n $result\n" if !$? and $opt_v; chomp $result; return $result; } @@ -102,14 +125,15 @@ sub write_files { my $unpushed_commits = '/*no-op*/'; my ($read, $branch, $snapshot_created, $commit_id, $describe)= ("") x 5; my ($changed, $extra_info, $commit_title, $new_patchnum, $status)= ("") x 5; + if (my $patch_file= read_file(".patch")) { ($branch, $snapshot_created, $commit_id, $describe) = split /\s+/, $patch_file; $extra_info = "git_snapshot_date='$snapshot_created'"; $commit_title = "Snapshot of:"; } -elsif (-d path_to('.git')) { +elsif (-d "$srcdir/.git") { # git branch | awk 'BEGIN{ORS=""} /\*/ { print $2 }' - ($branch) = map { /\* ([^(]\S*)/ ? $1 : () } backtick('git branch'); + ($branch) = map { /\* ([^(]\S*)/ ? $1 : () } backtick("git branch"); my ($remote,$merge); if (length $branch) { $merge= backtick("git config branch.$branch.merge"); @@ -139,12 +163,12 @@ git_remote_branch='$remote/$merge' git_unpushed='$unpushed_commit_list'"; } } - if ($changed) { + if ($changed) { # not touched since init'd. never true. $changed = 'true'; $commit_title = "Derived from:"; $status='"uncommitted-changes"' } else { - $status='/*clean-working-directory*/' + $status='/*clean-working-directory-maybe*/' } $commit_title ||= "Commit id:"; } diff --git a/sv.h b/sv.h index 9518fca..ccb5be3 100644 --- a/sv.h +++ b/sv.h @@ -1078,7 +1078,7 @@ in gv.h: */ #endif /* -=for apidoc Am|char*|SvGAMAGIC|SV* sv +=for apidoc Am|U32|SvGAMAGIC|SV* sv Returns true if the SV has get magic or overloading. If either is true then the scalar is active data, and has the potential to return a new value every diff --git a/vms/ext/filespec.t b/vms/ext/filespec.t index 5dd27c9..b40cc81 100644 --- a/vms/ext/filespec.t +++ b/vms/ext/filespec.t @@ -83,6 +83,7 @@ __DATA__ # Basic VMS to Unix filespecs __some_:[__where_.__over_]__the_.__rainbow_ unixify /__some_/__where_/__over_/__the_.__rainbow_ ^ +__some_:<__where_.__over_>__the_.__rainbow_ unixify /__some_/__where_/__over_/__the_.__rainbow_ ^ [.__some_.__where_.__over_]__the_.__rainbow_ unixify __some_/__where_/__over_/__the_.__rainbow_ ^ [-.__some_.__where_.__over_]__the_.__rainbow_ unixify ../__some_/__where_/__over_/__the_.__rainbow_ ^ [.__some_.--.__where_.__over_]__the_.__rainbow_ unixify __some_/../../__where_/__over_/__the_.__rainbow_ ^ diff --git a/vms/vms.c b/vms/vms.c index 0896934..9e94935 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -7346,7 +7346,7 @@ static char *int_tounixspec(const char *spec, char *rslt, int * utf8_fl) } if (*cp2 == ':') { *(cp1++) = '/'; - if (*(cp2+1) == '[') cp2++; + if (*(cp2+1) == '[' || *(cp2+1) == '<') cp2++; } else if (*cp2 == ']' || *cp2 == '>') { if (*(cp1-1) != '/') *(cp1++) = '/'; /* Don't double after ellipsis */ -- Perl5 Master Repository
