Making adding binary files possible
Jos I. Boumans [Fri, 15 Dec 2006 20:51:45 +0000 (21:51 +0100)]
From: "Jos Boumans" <kane@dwim.org>
Message-ID: <19978.80.127.35.68.1166212305.squirrel@webmail.xs4all.nl>

with a few tweaks

p4raw-id: //depot/perl@29593

MANIFEST
Makefile.SH
Porting/patching.pod
pack.pl [new file with mode: 0644]
packed_files.pl [new file with mode: 0644]

index 0a36e7f..35533af 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2916,6 +2916,8 @@ os2/perlrexx.c                    Support perl interpreter embedded in REXX
 os2/perlrexx.cmd               Test perl interpreter embedded in REXX
 overload.h                     generated overload enum and name table
 overload.pl                    generate overload.h
+pack.pl                                Pack/unpack individual files to the .packed format
+packed_files.pl                        Extract all .packed files mentioned in MANIFEST
 pad.c                          Scratchpad functions
 pad.h                          Scratchpad headers
 parser.h                       parser object header
index 1fb7a95..bba2e1b 100644 (file)
@@ -1023,18 +1023,19 @@ printconfig:
 
 .PHONY: clean _tidy _mopup _cleaner1 _cleaner2 \
        realclean _realcleaner clobber _clobber \
-       distclean veryclean _verycleaner
+       distclean veryclean _verycleaner \
+       cleanup_unpacked_files unpack_files
 
-clean:         _tidy _mopup
+clean:         cleanup_unpacked_files _tidy _mopup 
 
-realclean:     _realcleaner _mopup
+realclean:     cleanup_unpacked_files _realcleaner _mopup
        @echo "Note that '$(MAKE) realclean' does not delete config.sh or Policy.sh"
 
 _clobber:
        -@rm -f Cross/run-* Cross/to-* Cross/from-*
        rm -f config.sh cppstdin Policy.sh extras.lst
 
-clobber:       _realcleaner _mopup _clobber
+clobber:       cleanup_unpacked_files _realcleaner _mopup _clobber
 
 distclean:     clobber
 
@@ -1157,7 +1158,7 @@ makedepend: makedepend.SH config.sh
 
 TESTFILE=TEST
 
-_test_prep:
+_test_prep: unpack_files
        cd t && (rm -f $(PERL)$(EXE_EXT); $(LNS) ../$(PERL)$(EXE_EXT) $(PERL)$(EXE_EXT))
 
 # Architecture-neutral stuff:
@@ -1173,6 +1174,12 @@ _test_tty:
 _test_notty:
        cd t && $(PERL_DEBUG) PERL_SKIP_TTY_TEST=1 $(LDLIBPTH) $(PERL) $(TESTFILE) $(TEST_ARGS)
 
+unpack_files:
+       $(LDLIBPTH) ./miniperl$(EXE_EXT) -Ilib packed_files.pl -u
+
+cleanup_unpacked_files:
+       $(LDLIBPTH) ./miniperl$(EXE_EXT) -Ilib packed_files.pl -c
+
 # The second branch is for testing without a tty or controlling terminal,
 # see t/op/stat.t
 _test:
index 47ebbb1..5114d72 100644 (file)
@@ -151,6 +151,25 @@ you have your changes, you would run makepatch as follows:
               -diff "diff -u" \
               perl-5.7.1@8685 perl-5.7.1@8685-withfoo
 
+=item Binary Files
+
+Since the patch(1) utility can not deal with binary files, it's important
+that you either avoid the use of binary files in your patch, generate the files
+dynamically or that you encode any binary files using the C<Porting/pack.pl>
+utility.
+
+Assuming you needed to include a C<gzip> encoded file for a module's test suite,
+you might do this as follows using the C<Porting/pack.pl> utility:
+
+    $ perl Porting/pack.pl -v -D lib/Some/Module/t/src/t.gz
+    Writing lib/Some/Module/t/src/t.gz into lib/Some/Module/t/src/t.gz.packed
+
+This will replace the C<t.gz> file with an encoded counterpart. During 
+C<make test>, before any tests are run, Perls Makefile will restore all the
+C<.packed> files mentioned in the C<MANIFEST> to their original name. This 
+means that the test suite does not need to be aware of this packing scheme and
+will not need to be altered.
+
 =item Try it yourself
 
 Just to make sure your patch "works", be sure to apply it to the Perl
diff --git a/pack.pl b/pack.pl
new file mode 100644 (file)
index 0000000..e82c4e1
--- /dev/null
+++ b/pack.pl
@@ -0,0 +1,68 @@
+#!perl
+use strict;
+use Getopt::Std;
+
+my $opts = {};
+getopts('ushvD', $opts );
+
+die usage() if $opts->{h};
+
+my $file    = shift or die "Need file\n". usage();
+my $outfile = shift || '';
+my $mode    = (stat($file))[2] & 07777;
+
+open my $fh, $file or die "Could not open input file $file: $!";
+my $str = do { local $/; <$fh> };
+
+### unpack?
+my $outstr;
+if( $opts->{u} ) {
+    if( !$outfile ) {
+        $outfile = $file;
+        $outfile =~ s/\.packed$//;
+    }
+
+    $outstr  = unpack 'u', $str;
+
+} else {
+    $outfile ||= $file . '.packed';
+
+    $outstr = pack 'u', $str;
+}
+
+### output the file
+if( $opts->{'s'} ) {
+    print STDOUT $outstr;
+} else {
+    print "Writing $file into $outfile\n" if $opts->{'v'};
+    open my $outfh, ">$outfile"
+        or die "Could not open $outfile for writing: $!";
+    print $outfh $outstr;
+    close $outfh;
+
+    chmod $mode, $outfile;
+}
+
+### delete source file?
+if( $opts->{'D'} and $file ne $outfile ) {
+    1 while unlink $file;
+}
+
+sub usage {
+    return qq[
+Usage: $0 [-v] [-s] [-D] SOURCE [OUTPUT_FILE]
+       $0 [-v] [-s] [-D] -u SOURCE [OUTPUT_FILE]
+       $0 -h
+
+    uuencodes a file, either to a target file or STDOUT.
+    If no output file is provided, it outputs to SOURCE.packed
+
+Options:
+    -v  Run verbosely
+    -s  Output to STDOUT rather than OUTPUT_FILE
+    -h  Display this help message
+    -u  Unpack rather than pack
+    -D  Delete source file after encoding/decoding
+
+]
+}
diff --git a/packed_files.pl b/packed_files.pl
new file mode 100644 (file)
index 0000000..f71290d
--- /dev/null
@@ -0,0 +1,58 @@
+#!perl
+use strict;
+use Getopt::Std;
+
+my $opts = {};
+getopts('uch', $opts );
+
+die usage() if $opts->{'h'} or ( not $opts->{'u'} and not $opts->{'c'} );
+
+my $Pack = 'pack.pl';
+die "Could not find $Pack" unless -e $Pack;
+
+open my $fh, "MANIFEST" or die "Could not open MANIFEST";
+
+while( my $line = <$fh> ) {
+    chomp $line;
+    my ($file) = split /\s+/, $line;
+
+    next unless $file =~ /\.packed/;
+
+    my $out = $file;
+    $out =~ s/\.packed//;
+
+    ### unpack
+    if( $opts->{'u'} ) {
+
+        my $cmd =  "$^X -Ilib $Pack -u -v $file $out";
+        system( $cmd ) and die "Could not unpack $file: $?";
+
+    ### 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;
+        }
+    }
+}
+
+sub usage {
+    return qq[
+Usage: $^X $0 -u | -c | -h
+
+    Unpack or clean up .packed files from the source tree.
+    This program is just a wrapper around $Pack.
+
+Options:
+    -u  Unpack all files in this source tree
+    -c  Clean up all unpacked files from this source tree
+    -h  Display this help text
+
+];
+}