Index: trunk/Parse-CPAN-Meta/uupacktool.pl
===================================================================
--- trunk/Parse-CPAN-Meta/uupacktool.pl (revision 0)
+++ trunk/Parse-CPAN-Meta/uupacktool.pl (revision 0)
@@ -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();
Index: trunk/Parse-CPAN-Meta/t/data/utf_16_le_bom.yml
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: trunk/Parse-CPAN-Meta/t/data/utf_16_le_bom.yml.packed
===================================================================
--- trunk/Parse-CPAN-Meta/t/data/utf_16_le_bom.yml.packed (revision 0)
+++ trunk/Parse-CPAN-Meta/t/data/utf_16_le_bom.yml.packed (revision 0)
@@ -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`*````
Index: trunk/Parse-CPAN-Meta/lib/Parse/CPAN/Meta.pm
===================================================================
--- trunk/Parse-CPAN-Meta/lib/Parse/CPAN/Meta.pm (revision 8006)
+++ trunk/Parse-CPAN-Meta/lib/Parse/CPAN/Meta.pm (working copy)
@@ -15,7 +15,7 @@
# 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 };
}
Index: trunk/Parse-CPAN-Meta/Makefile.PL
===================================================================
--- trunk/Parse-CPAN-Meta/Makefile.PL (revision 8006)
+++ trunk/Parse-CPAN-Meta/Makefile.PL (working copy)
@@ -1,7 +1,7 @@
use strict;
BEGIN {
require 5.003_96;
- $main::VERSION = '1.39';
+ $main::VERSION = '1.40';
}
use ExtUtils::MakeMaker;
@@ -21,3 +21,29 @@
) : ()),
(INSTALLDIRS => $] >= 5.010001 ? 'perl' : 'site'),
);
+
+package MY;
+sub test {
+ my $inherited = shift->SUPER::test(@_);
+ $inherited =~ s{^test\s*:+\s*(.*)}{
+ "test : unpack_files $1";
+ }me || die $inherited;
+ return $inherited;
+}
+sub clean {
+ my $inherited = shift->SUPER::clean(@_);
+ $inherited =~ s{^(clean\s*:.*)}{
+ "$1 cleanup_unpacked_files";
+ }me || die $inherited;
+ return $inherited;
+}
+sub postamble {
+ return <<'MAKE_FRAG';
+unpack_files:
+ $(FULLPERLRUN) uupacktool.pl -u -m
+
+cleanup_unpacked_files:
+ $(FULLPERLRUN) uupacktool.pl -c
+
+MAKE_FRAG
+}
Index: trunk/Parse-CPAN-Meta/Changes
===================================================================
--- trunk/Parse-CPAN-Meta/Changes (revision 8006)
+++ trunk/Parse-CPAN-Meta/Changes (working copy)
@@ -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)
Index: trunk/Parse-CPAN-Meta/MANIFEST.SKIP
===================================================================
--- trunk/Parse-CPAN-Meta/MANIFEST.SKIP (revision 8006)
+++ trunk/Parse-CPAN-Meta/MANIFEST.SKIP (working copy)
@@ -1,5 +1,7 @@
^diff_to_blead\.pl$
+t/data/utf_16_le_bom.yml$
+
# Default section:
# Avoid version control files.
\bRCS\b
