diff options
author | Jos I. Boumans <kane@dwim.org> | 2006-12-15 21:51:45 +0100 |
---|---|---|
committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2006-12-19 15:07:45 +0000 |
commit | 687d3573c7533b89705e64f529b53c631cb9dec0 (patch) | |
tree | d9ec7bf7b365d8ca462debe7fc0ba81fb2086556 | |
parent | 2ae48df0f018213e8336ab227bb84aba249da141 (diff) | |
download | perl-687d3573c7533b89705e64f529b53c631cb9dec0.tar.gz |
Making adding binary files possible
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
-rw-r--r-- | MANIFEST | 2 | ||||
-rw-r--r-- | Makefile.SH | 17 | ||||
-rw-r--r-- | Porting/patching.pod | 19 | ||||
-rw-r--r-- | pack.pl | 68 | ||||
-rw-r--r-- | packed_files.pl | 58 |
5 files changed, 159 insertions, 5 deletions
@@ -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 diff --git a/Makefile.SH b/Makefile.SH index 1fb7a9508c..bba2e1bf60 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -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: diff --git a/Porting/patching.pod b/Porting/patching.pod index 47ebbb194a..5114d72a57 100644 --- a/Porting/patching.pod +++ b/Porting/patching.pod @@ -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 index 0000000000..e82c4e1ccd --- /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 index 0000000000..f71290d744 --- /dev/null +++ b/packed_files.pl @@ -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 + +]; +} |