########################
# SIMPLE COMPRESS:ZLIB #
########################
##package Compress'Zlib;
package LibZip::MyZlib ;
no warnings ;
BEGIN { $INC{'LibZip/MyZlib.pm'} = 1 if !$INC{'LibZip/MyZlib.pm'} ;}
#require DynaLoader;
@ISA = qw(DynaLoader);
$VERSION = "1.33" ;
## NO BOOT: Zlib will be inside executable (LibZipBin binary).
#DynaLoader::bootstrap LibZip::MyZlib $VERSION if !$NO_BOOT ;
sub ZLIB_VERSION { 1.1.4 }
sub DEF_WBITS { '' }
sub OS_CODE { '' }
sub MAX_MEM_LEVEL { 9 }
sub MAX_WBITS { 15 }
sub Z_ASCII { 1 }
sub Z_BEST_COMPRESSION { 9 }
sub Z_BEST_SPEED { 1 }
sub Z_BINARY { 0 }
sub Z_BUF_ERROR { -5 }
sub Z_DATA_ERROR { -3 }
sub Z_DEFAULT_COMPRESSION { -1 }
sub Z_DEFAULT_STRATEGY { 0 }
sub Z_DEFLATED { 8 }
sub Z_ERRNO { -1 }
sub Z_FILTERED { 1 }
sub Z_FINISH { 4 }
sub Z_FULL_FLUSH { 3 }
sub Z_HUFFMAN_ONLY { 2 }
sub Z_MEM_ERROR { -4 }
sub Z_NEED_DICT { 2 }
sub Z_NO_COMPRESSION { 0 }
sub Z_NO_FLUSH { 0 }
sub Z_NULL { 0 }
sub Z_OK { 0 }
sub Z_PARTIAL_FLUSH { 1 }
sub Z_STREAM_END { 1 }
sub Z_STREAM_ERROR { -2 }
sub Z_SYNC_FLUSH { 2 }
sub Z_UNKNOWN { 2 }
sub Z_VERSION_ERROR { -6 }
sub ParseParameters($@) {
my ($default, @rest) = @_ ;
my (%got) = %$default ;
my (@Bad) ;
my ($key, $value) ;
my $sub = (caller(1))[3] ;
my %options = () ;
# allow the options to be passed as a hash reference or
# as the complete hash.
if (@rest == 1) {
%options = %{ $rest[0] } ;
}
elsif (@rest >= 2) {
%options = @rest ;
}
while (($key, $value) = each %options)
{
$key =~ s/^-// ;
if (exists $default->{$key})
{ $got{$key} = $value }
else
{ push (@Bad, $key) }
}
if (@Bad) {
my ($bad) = join(", ", @Bad) ;
}
return \%got ;
}
$deflateDefault = {
'Level' => Z_DEFAULT_COMPRESSION(),
'Method' => Z_DEFLATED(),
'WindowBits' => MAX_WBITS(),
'MemLevel' => MAX_MEM_LEVEL(),
'Strategy' => Z_DEFAULT_STRATEGY(),
'Bufsize' => 4096,
'Dictionary' => "",
} ;
$deflateParamsDefault = {
'Level' => Z_DEFAULT_COMPRESSION(),
'Strategy' => Z_DEFAULT_STRATEGY(),
} ;
$inflateDefault = {
'WindowBits' => MAX_WBITS(),
'Bufsize' => 4096,
'Dictionary' => "",
} ;
sub inflateInit {
my ($got) = ParseParameters($inflateDefault, @_) ;
_inflateInit($got->{WindowBits}, $got->{Bufsize}, $got->{Dictionary}) ;
}
#############################
# LIBZIP::MYZLIB::TOOLS #
#############################
package LibZip::MyZlib::tools ;
use LibZip::CORE ;
############
# MY_UNTAR #
############
sub my_untar {
my ( $tar_file ) = @_ ;
my $tar = (length($tar_file) < 1000 && -e $tar_file) ? cat($tar_file) : $tar_file ;
my $lng = length($tar) ;
my %files ;
my ( $sz , $name ) ;
for(my $i = 0 ; $i < $lng ;) {
$sz = unpack("V", substr($tar , $i , 4) ) ; $i += 4 ;
$name = substr($tar , $i , $sz) ; $i += $sz ;
$sz = unpack("V", substr($tar , $i , 4) ) ; $i += 4 ;
$files{$name} = my_uncompress( split_bloks( substr($tar , $i , $sz) ) ) ; $i += $sz ;
}
return \%files ;
}
################
# MY_SAVE_TREE #
################
sub my_save_tree {
my $dir = shift ;
my $tree = shift ;
mkpath($dir) if ( !-d $dir );
foreach my $Key (sort keys %$tree ) {
my $name = "$dir/$Key" ;
my ($dirName) = ( $name =~ /^(.*?)[\\\/]*[^\\\/]+$/s );
mkpath($dirName) if ( !-d $dirName ) ;
save($name , $$tree{$Key}) ;
}
}
##########
# MKPATH #
##########
sub mkpath {
my($paths) = @_;
$paths = [$paths] unless ref $paths ;
my $mode = 0775 ;
local($")=$Is_MacOS ? ":" : "/";
my(@created,$path);
foreach $path (@$paths) {
$path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s ;
next if -d $path ;
my ($parent) = ( $path =~ /^(.*?)[\\\/]*[^\\\/]+$/s );
unless (-d $parent or $path eq $parent) { push(@created,mkpath($parent)) ;}
unless (mkdir($path,$mode)) { my $e = $! ;}
push(@created, $path) ;
}
@created ;
}
###############
# SPLIT_BLOKS #
###############
sub split_bloks {
my $sz_blk_size = unpack("V", substr($_[0] , 0 , 4) ) ;
my $blk_size = substr($_[0] , 4 , $sz_blk_size) ;
my $total = 4 + $sz_blk_size ;
$blk_size = my_uncompress($blk_size) ;
my (@sizes) = ( $blk_size =~ /(....)/gs );
my $i = $sz_blk_size + 4 ;
my @blks ;
foreach my $sizes_i ( @sizes ) {
$sizes_i = unpack("V", $sizes_i ) ;
push(@blks , substr($_[0] , $i , $sizes_i) ) ;
$i += $sizes_i ;
}
return @blks ;
}
###################
# PURE_UNCOMPRESS #
###################
sub my_uncompress {
my ( @blks ) = @_ ;
package LibZip::MyZlib ;
my $uncompressed ;
foreach my $blks_i ( @blks ) {
my ($d, $status) = inflateInit( -WindowBits => - MAX_WBITS ) ;
my ($out, $status) = $d->inflate( $blks_i ) ;
$uncompressed .= $out ;
}
return $uncompressed ;
}
##########
# BASE64 #
##########
sub my_uncompress_base64 { return my_uncompress( split_bloks( _decode_base64_pure_perl($_[0]) ) ) ;}
sub my_untar_base64 { return my_untar( _decode_base64_pure_perl($_[0]) ) ;}
############################
# _DECODE_BASE64_PURE_PERL #
############################
sub _decode_base64_pure_perl {
local($^W) = 0 ;
my $str = shift ;
my $res = "";
$str =~ tr|A-Za-z0-9+=/||cd ;
if (length($str) % 4) {
#require Carp;
#Carp::carp("Length of base64 data not a multiple of 4")
}
$str =~ s/=+$//;
$str =~ tr|A-Za-z0-9+/| -_|;
while ($str =~ /(.{1,60})/gs) {
my $len = chr(32 + length($1)*3/4);
$res .= unpack("u", $len . $1 );
}
$res;
}
#######
# END #
#######
1;