Upgrade to Parse-CPAN-Meta-1.40

5 files changed, 246 insertions, 1 deletions

diff --git a/cpan/Parse-CPAN-Meta/Changes b/cpan/Parse-CPAN-Meta/Changes
index 107b969e3f..0ba34c5c23 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 a06556e331..e7d585170b 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 b9230ebb5a..0000000000
--- a/cpan/Parse-CPAN-Meta/t/data/utf_16_le_bom.yml
+++ /dev/null
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 0000000000..478c5736f3
--- /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 0000000000..bb4dc0092f
--- /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();