http://www.perlmonks.org?node_id=101426
Category: Miscellaneous
Author/Contact Info bikeNomad, Ned Konz, perl@bike-nomad.com
Description: Creates a self-extracting, uncompressed, Perl archive from the (possibly binary) files specified on the command line. Does not require any library modules for extraction. Will make directories as needed.

Does not yet handle cross-platform filenames or allow for translating paths from absolute to relative (though you can of course edit its output with another Perl program).

Note that these files will actually be at least 37% bigger than the input files because of the extractor and the uuencoding. But you can send binary with them without worrying about someone trashing them in a mail or FTP program.

#!/usr/bin/perl -w
# Creates self-extracting archives that use Perl to extract.
# Will make directories on extraction, but parents of top-level
# directories must exist and be writable.
#
# Outputs self-extracting archive to stdout.
# Arguments that are directories will be recursed into.
#
# To make an archive:
#  perl separ.pl <fileOrDir> [...] > archive
#
# To unpack an archive:
#   perl archive
#
# Uses no external modules for decompression.
# File format is: extractor program (Perl) at top,
# __DATA__ tag,
# multiple files, uuencoded.
# There may be "mkdir" lines before files.
#
# By Ned Konz, perl@bike-nomad.com
# encode() derived from Tom Christensen's PPT version of uuencode
# decoder based on code by Nick Ing-Simmons and Tom Christiansen

use strict;
use File::Find;

sub encode {
    my ( $source, $destination, $mode ) = @_;

    if ( $source eq '-' && -t STDIN ) {
        warn "$0: WARNING: reading from standard input\n";
    }

    printf "begin %03o $destination\012", $mode || 0644;

    local *INPUT;
    open( INPUT, "< $source" ) || die "can't open $source: $!";
    binmode(INPUT);

    my $block;
    print pack( "u", $block ) while read( INPUT, $block, 45 );
    print "`\012";
    print "end\012";

    close(INPUT) || die "can't close $source: $!";
}

# copy the extractor
print $_ while (<DATA>);

# now encode the files with relative path names
$File::Find::dont_use_nlink = 1;
for my $arg (@ARGV) {
    my $ignoreLength = length($arg) + 1;
    File::Find::find(
        {
            no_chdir => 1,
            wanted   => sub {
                my $name = $File::Find::name;
                my $mode = $name eq '-' ? 0777 : ( stat($name) )[2];

                if ( -d _ ) {
                    $mode &= 0777;
                    printf( "mkdir %03o %s\012", $mode || 0777, $name 
+);
                    return;
                }
                encode( $name, $name, $mode & 0666 );
            },
        },
        $arg
    );
}

__DATA__
#!/usr/bin/perl
use strict;

# This is a self-extracting archive that requires Perl to extract.
BEGIN { $/ = "\012" }

while (<DATA>) {

  # attempt to be robust if someone edits this file in a different OS
  $_ =~ s/[\r\n]+$//s;
  next FILESPEC
    unless my ( $op, $mode, $file ) = /^(begin|mkdir)\s+(\d+)\s+(.*)/s
+;

  if ( $op eq 'mkdir' ) {
    if ( !-d $file ) {
      print STDERR "making directory $file\n";
      mkdir $file, 0777 or die "Can't make directory $file: $!\n";
    }
    next;    # filespec
  }
  my $foundEnd = 0;
  print STDERR "extracting file $file\n";
  open( OUT, ">$file" ) or die "Can't create $file: $!\n";
  binmode(OUT);

  while (<DATA>) {
    $_ =~ s/[\r\n]+$//s;
    if (/^end/) { $foundEnd++; last }
    next if /[a-z]/;
    next
      unless int( ( ( ( ord() - 32 ) & 077 ) + 2 ) / 3 ) == int( lengt
+h() / 4 );
    print OUT unpack( "u", $_ ) or die "can't write $file: $!";
  }
  close(OUT) or die "can't close $file: $!";
  chmod oct($mode), $file or die "can't chmod $file to $mode: $!\n";
  $foundEnd or die "Missing end: $file may be truncated.\n";
}
__DATA__
Replies are listed 'Best First'.
Re: Self-extracting Perl archives
by Anonymous Monk on Dec 31, 2002 at 17:02 UTC
    Exactly the tool I looked for. But it doesn't work in that form: You haven't defined a LABEL "FILESPEC" in the decoder. Define it or remove it completely. Uli