From: Steve Hay Date: Sat, 10 Oct 2009 11:31:12 +0000 (+0100) Subject: Upgrade to Parse-CPAN-Meta-1.40 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c82fc722e45a871624ff0f029652ce8eff600fda;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Parse-CPAN-Meta-1.40 --- diff --git a/MANIFEST b/MANIFEST index 679569f..3af00ca 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1721,9 +1721,10 @@ cpan/Parse-CPAN-Meta/t/data/sample.yml Parse::CPAN::Meta cpan/Parse-CPAN-Meta/t/data/Spreadsheet-Read.yml Parse::CPAN::Meta cpan/Parse-CPAN-Meta/t/data/Template-Provider-Unicode-Japanese.yml Parse::CPAN::Meta cpan/Parse-CPAN-Meta/t/data/toolbar.yml Parse::CPAN::Meta -cpan/Parse-CPAN-Meta/t/data/utf_16_le_bom.yml Parse::CPAN::Meta +cpan/Parse-CPAN-Meta/t/data/utf_16_le_bom.yml.packed Parse::CPAN::Meta cpan/Parse-CPAN-Meta/t/data/vanilla.yml Parse::CPAN::Meta cpan/Parse-CPAN-Meta/t/lib/Parse/CPAN/Meta/Test.pm Parse::CPAN::Meta testing library +cpan/Parse-CPAN-Meta/uupacktool.pl Parse::CPAN::Meta cpan/PerlIO-via-QuotedPrint/lib/PerlIO/via/QuotedPrint.pm PerlIO::via::QuotedPrint cpan/PerlIO-via-QuotedPrint/t/QuotedPrint.t PerlIO::via::QuotedPrint cpan/Pod-Escapes/ChangeLog ChangeLog for Pod::Escapes diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index d6e7f1e..d4beee8 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1100,7 +1100,7 @@ use File::Glob qw(:case); 'Parse::CPAN::Meta' => { 'MAINTAINER' => 'smueller', - 'DISTRIBUTION' => 'ADAMK/Parse-CPAN-Meta-1.39.tar.gz', + 'DISTRIBUTION' => 'ADAMK/Parse-CPAN-Meta-1.40.tar.gz', 'FILES' => q[cpan/Parse-CPAN-Meta], 'EXCLUDED' => [ qw( t/97_meta.t t/98_pod.t t/99_pmv.t ) ], 'CPAN' => 1, diff --git a/cpan/Parse-CPAN-Meta/Changes b/cpan/Parse-CPAN-Meta/Changes index 107b969..0ba34c5 100644 --- a/cpan/Parse-CPAN-Meta/Changes +++ b/cpan/Parse-CPAN-Meta/Changes @@ -1,5 +1,9 @@ Changes for Perl programming language extension Parse-CPAN-Meta +1.40 Sat 25 Jul 2009 + - Add core perl 5.10.1's uupacktool.pl + - Repackage t/data/utf_16_le_bom.yml as ASCII for https://rt.cpan.org/Ticket/Display.html?id=47844 + 1.39 Thu 21 May 2009 - Even though utf8 starts at 5.7+ there's no is_utf till 5.8.1 so skip in the tests if needed (ADAMK) diff --git a/cpan/Parse-CPAN-Meta/lib/Parse/CPAN/Meta.pm b/cpan/Parse-CPAN-Meta/lib/Parse/CPAN/Meta.pm index a06556e..e7d5851 100644 --- a/cpan/Parse-CPAN-Meta/lib/Parse/CPAN/Meta.pm +++ b/cpan/Parse-CPAN-Meta/lib/Parse/CPAN/Meta.pm @@ -15,7 +15,7 @@ BEGIN { # Class structure require 5.004; require Exporter; - $Parse::CPAN::Meta::VERSION = '1.39'; + $Parse::CPAN::Meta::VERSION = '1.40'; @Parse::CPAN::Meta::ISA = qw{ Exporter }; @Parse::CPAN::Meta::EXPORT_OK = qw{ Load LoadFile }; } diff --git a/cpan/Parse-CPAN-Meta/t/data/utf_16_le_bom.yml b/cpan/Parse-CPAN-Meta/t/data/utf_16_le_bom.yml deleted file mode 100644 index b9230eb..0000000 Binary files a/cpan/Parse-CPAN-Meta/t/data/utf_16_le_bom.yml and /dev/null differ diff --git a/cpan/Parse-CPAN-Meta/t/data/utf_16_le_bom.yml.packed b/cpan/Parse-CPAN-Meta/t/data/utf_16_le_bom.yml.packed new file mode 100644 index 0000000..478c573 --- /dev/null +++ b/cpan/Parse-CPAN-Meta/t/data/utf_16_le_bom.yml.packed @@ -0,0 +1,16 @@ +######################################################################### +This is a binary file that was packed with the 'uupacktool.pl' which +is included in the Perl distribution. + +To unpack this file use the following command: + + uupacktool.pl -u t/data/utf_16_le_bom.yml.packed t/data/utf_16_le_bom.yml + +To recreate it use the following command: + + uupacktool.pl -p t/data/utf_16_le_bom.yml t/data/utf_16_le_bom.yml.packed + +Created at Sat Jul 25 17:27:03 2009 +######################################################################### +__UU__ +6__XM`"T`+0`*`"T`(`!F`&\`;P`*```` diff --git a/cpan/Parse-CPAN-Meta/uupacktool.pl b/cpan/Parse-CPAN-Meta/uupacktool.pl new file mode 100644 index 0000000..bb4dc00 --- /dev/null +++ b/cpan/Parse-CPAN-Meta/uupacktool.pl @@ -0,0 +1,225 @@ +#!perl + +use strict; +use warnings; +use Getopt::Long; +use File::Basename; +use File::Spec; + +BEGIN { + if ($^O eq 'VMS') { + require VMS::Filespec; + import VMS::Filespec; + } +} + +Getopt::Long::Configure('no_ignore_case'); + +our $LastUpdate = -M $0; + +sub handle_file { + my $opts = shift; + my $file = shift or die "Need file\n". usage(); + my $outfile = shift || ''; + $file = vms_check_name($file) if $^O eq 'VMS'; + my $mode = (stat($file))[2] & 07777; + + open my $fh, "<", $file + or do { warn "Could not open input file $file: $!"; exit 0 }; + my $str = do { local $/; <$fh> }; + + ### unpack? + my $outstr; + if( $opts->{u} ) { + if( !$outfile ) { + $outfile = $file; + $outfile =~ s/\.packed\z//; + } + my ($head, $body) = split /__UU__\n/, $str; + die "Can't unpack malformed data in '$file'\n" + if !$head; + $outstr = unpack 'u', $body; + + } else { + $outfile ||= $file . '.packed'; + + my $me = basename($0); + + $outstr = <<"EOFBLURB" . pack 'u', $str; +######################################################################### +This is a binary file that was packed with the 'uupacktool.pl' which +is included in the Perl distribution. + +To unpack this file use the following command: + + $me -u $outfile $file + +To recreate it use the following command: + + $me -p $file $outfile + +Created at @{[scalar localtime]} +######################################################################### +__UU__ +EOFBLURB + } + + ### output the file + if( $opts->{'s'} ) { + print STDOUT $outstr; + } else { + $outfile = VMS::Filespec::vmsify($outfile) if $^O eq 'VMS'; + print "Writing $file into $outfile\n" if $opts->{'v'}; + open my $outfh, ">", $outfile + or do { warn "Could not open $outfile for writing: $!"; exit 0 }; + binmode $outfh; + ### $outstr might be empty, if the file was empty + print $outfh $outstr if $outstr; + close $outfh; + + chmod $mode, $outfile; + } + + ### delete source file? + if( $opts->{'D'} and $file ne $outfile ) { + 1 while unlink $file; + } +} + +sub bulk_process { + my $opts = shift; + my $Manifest = $opts->{'m'}; + + open my $fh, "<", $Manifest or die "Could not open '$Manifest':$!"; + + print "Reading $Manifest\n" + if $opts->{'v'}; + + my $count = 0; + my $lines = 0; + while( my $line = <$fh> ) { + chomp $line; + my ($file) = split /\s+/, $line; + + $lines++; + + next unless $file =~ /\.packed/; + + $count++; + + my $out = $file; + $out =~ s/\.packed\z//; + $out = vms_check_name($out) if $^O eq 'VMS'; + + ### unpack + if( !$opts->{'c'} ) { + ( $out, $file ) = ( $file, $out ) if $opts->{'p'}; + if (-e $out) { + my $changed = -M _; + if ($changed < $LastUpdate and $changed < -M $file) { + print "Skipping '$file' as '$out' is up-to-date.\n" + if $opts->{'v'}; + next; + } + } + handle_file($opts, $file, $out); + print "Converted '$file' to '$out'\n" + if $opts->{'v'}; + + ### clean up + } else { + + ### file exists? + unless( -e $out ) { + print "File '$file' was not unpacked into '$out'. Can not remove.\n"; + + ### remove it + } else { + print "Removing '$out'\n"; + 1 while unlink $out; + } + } + } + print "Found $count files to process out of $lines in '$Manifest'\n" + if $opts->{'v'}; +} + +sub usage { + return qq[ +Usage: $^X $0 [-d dir] [-v] [-c] [-D] -p|-u [orig [packed|-s] | -m [manifest]] + + Handle binary files in source tree. Can be used to pack or + unpack files individiually or as specified by a manifest file. + +Options: + -u Unpack files (defaults to -u unless -p is specified) + -p Pack files + -c Clean up all unpacked files. Implies -m + + -D Delete source file after encoding/decoding + + -s Output to STDOUT rather than OUTPUT_FILE + -m Use manifest file, if none is explicitly provided defaults to 'MANIFEST' + + -d Change directory to dir before processing + + -v Run verbosely + -h Display this help message +]; +} + +sub vms_check_name { + +# Packed files tend to have multiple dots, which the CRTL may or may not handle +# properly, so convert to native format. And depending on how the archive was +# unpacked, foo.bar.baz may be foo_bar.baz or foo.bar_baz. N.B. This checks for +# existence, so is not suitable as-is to generate ODS-2-safe names in preparation +# for file creation. + + my $file = shift; + + $file = VMS::Filespec::vmsify($file); + return $file if -e $file; + + my ($vol,$dirs,$base) = File::Spec->splitpath($file); + my $tmp = $base; + 1 while $tmp =~ s/([^\.]+)\.(.+\..+)/$1_$2/; + my $try = File::Spec->catpath($vol, $dirs, $tmp); + return $try if -e $try; + + $tmp = $base; + 1 while $tmp =~ s/(.+\..+)\.([^\.]+)/$1_$2/; + $try = File::Spec->catpath($vol, $dirs, $tmp); + return $try if -e $try; + + return $file; +} + +my $opts = {}; +GetOptions($opts,'u','p','c', 'D', 'm:s','s','d=s','v','h'); + +die "Can't pack and unpack at the same time!\n", usage() + if $opts->{'u'} && $opts->{'p'}; +die usage() if $opts->{'h'}; + +if ( $opts->{'d'} ) { + chdir $opts->{'d'} + or die "Failed to chdir to '$opts->{'d'}':$!"; +} +$opts->{'u'} = 1 if !$opts->{'p'}; +binmode STDOUT if $opts->{'s'}; +if ( exists $opts->{'m'} or exists $opts->{'c'} ) { + $opts->{'m'} ||= "MANIFEST"; + bulk_process($opts); + exit(0); +} else { + if (@ARGV) { + handle_file($opts, @ARGV); + } else { + die "No file to process specified!\n", usage(); + } + exit(0); +} + + +die usage();