view release on metacpan or  search on metacpan

SelfExtracting.pm  view on Meta::CPAN

package Compress::SelfExtracting;
use Digest::MD5 'md5_hex';
require Exporter;

use vars qw/@ISA @EXPORT @EXPORT_OK $VERSION/;

@EXPORT_OK = qw/compress decompress/;
@EXPORT = qw/zscript zfile/;
@ISA = qw/Exporter/;
$VERSION = 0.04;

my %O;
BEGIN {
    %O = (standalone => 1,
	  type => 'LZW',
	  op => 'eval',
	  uu => 1);
};

sub compress
{
    my $data = shift;
    my %o = @_;
    @O{keys %o} = values %o;
    my $cdata = &{"Compress::SelfExtracting::$O{type}::compress"}($data, \%O);
    if ($O{uu}) {
	$cdata = pack 'u', $cdata;
    }
    if ($O{standalone}) {
	my $sa = &{"Compress::SelfExtracting::$O{type}::standalone"}(\%O);
	return $sa.$cdata;
    } else {
	return "use Compress::SelfExtracting::Filter "
		.join(', ', map { "$_ => '$O{$_}'" }
		  grep!/decompress|file|data/,keys %O).";\n"
		.md5_hex($data)."\n$cdata\n";
    }
}

sub decompress
{
    my $data = shift;
    my %o = @_;
    @O{keys %o} = values %o;
    if ($data =~ /^([0-9a-f]+)\n(.*)/s) {
	if ($O{uu}) {
	    $data = unpack 'u', $2;
	} else {
	    chomp($data = $2);
	}
	$data = &{"Compress::SelfExtracting::$O{type}::decompress"}($data, \%O);
	my $cksum = md5_hex($data);
	unless ($cksum eq $1) {
	    open BAD, ">BAD";
	    print BAD $data;
	    close BAD;
	    die "Bad checksum\n";
	}
    } else {
	die "$0 doesn't look compressed\n";
    }
    $data;
}

sub zscript
{
    local $/ = undef;
    my $data = <STDIN>;
    print compress $data, @_;
}

sub zfile
{
    local $/ = undef;
    my $data = <STDIN>;
    print compress $data, @_, op => 'print';
}

############################################################
package Compress::SelfExtracting::LZ77;

sub import { }

sub compress
{
    my $str = shift;
    die "Sorry, code too long\n" if length($str) >= 1<<16;
    my @rep;
    my $la = 0;
    while ($la < length $str) {
	my $n = 1;
	my ($tmp, $p);
	$p = 0;
	while ($la + $n < length $str
	       && $n < 255
	       && ($tmp = index(substr($str, 0, $la),