summaryrefslogtreecommitdiff
path: root/cpan/Parse-CPAN-Meta/uupacktool.pl
diff options
context:
space:
mode:
Diffstat (limited to 'cpan/Parse-CPAN-Meta/uupacktool.pl')
-rw-r--r--cpan/Parse-CPAN-Meta/uupacktool.pl225
1 files changed, 0 insertions, 225 deletions
diff --git a/cpan/Parse-CPAN-Meta/uupacktool.pl b/cpan/Parse-CPAN-Meta/uupacktool.pl
deleted file mode 100644
index bb4dc0092f..0000000000
--- a/cpan/Parse-CPAN-Meta/uupacktool.pl
+++ /dev/null
@@ -1,225 +0,0 @@
-#!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();
View Lorry Controller Status