pack.pl

   1 #!perl
   2 use strict;
   3 use Getopt::Std;
   4
   5 my $opts = {};
   6 getopts('ushvD', $opts );
   7
   8 die usage() if $opts->{h};
   9
  10 my $file    = shift or die "Need file\n". usage();
  11 my $outfile = shift || '';
  12 my $mode    = (stat($file))[2] & 07777;
  13
  14 open my $fh, $file or die "Could not open input file $file: $!";
  15 my $str = do { local $/; <$fh> };
  16
  17 ### unpack?
  18 my $outstr;
  19 if( $opts->{u} ) {
  20     if( !$outfile ) {
  21         $outfile = $file;
  22         $outfile =~ s/\.packed$//;
  23     }
  24
  25     $outstr  = unpack 'u', $str;
  26
  27 } else {
  28     $outfile ||= $file . '.packed';
  29
  30     $outstr = pack 'u', $str;
  31 }
  32
  33 ### output the file
  34 if( $opts->{'s'} ) {
  35     print STDOUT $outstr;
  36 } else {
  37     print "Writing $file into $outfile\n" if $opts->{'v'};
  38     open my $outfh, ">$outfile"
  39         or die "Could not open $outfile for writing: $!";
  40     print $outfh $outstr;
  41     close $outfh;
  42
  43     chmod $mode, $outfile;
  44 }
  45
  46 ### delete source file?
  47 if( $opts->{'D'} and $file ne $outfile ) {
  48     1 while unlink $file;
  49 }
  50
  51 sub usage {
  52     return qq[
  53 Usage: $0 [-v] [-s] [-D] SOURCE [OUTPUT_FILE]
  54        $0 [-v] [-s] [-D] -u SOURCE [OUTPUT_FILE]
  55        $0 -h
  56
  57     uuencodes a file, either to a target file or STDOUT.
  58     If no output file is provided, it outputs to SOURCE.packed
  59
  60 Options:
  61     -v  Run verbosely
  62     -s  Output to STDOUT rather than OUTPUT_FILE
  63     -h  Display this help message
  64     -u  Unpack rather than pack
  65     -D  Delete source file after encoding/decoding
  66
  67 ]
  68 }