File Coverage

blib/lib/LibZip/MyZlib.pm

Criterion	Covered	Total	%
statement	12	128	9.3
branch	1	30	3.3
condition	0	9	0.0
subroutine	8	44	18.1
pod	0	33	0.0
total	21	244	8.6

########################
# 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;