diff options
| -rw-r--r-- | Packdrakeng.pm | 49 | ||||
| -rwxr-xr-x | t/01packdrakeng.t | 29 |
2 files changed, 46 insertions, 32 deletions
diff --git a/Packdrakeng.pm b/Packdrakeng.pm index cad49da..b359335 100644 --- a/Packdrakeng.pm +++ b/Packdrakeng.pm @@ -16,7 +16,7 @@ ##- $Id$ -package packdrakeng; +package Packdrakeng; use strict; use warnings; @@ -27,7 +27,7 @@ use Compress::Zlib; use vars qw($VERSION); my $debug = 1; -$VERSION = 0.10; +$VERSION = "0.10"; my ($toc_header, $toc_footer) = ('cz[0', '0]cz'); @@ -47,6 +47,7 @@ sub _new { uncompress_method => $options{uncompress}, force_extern => $options{extern} || 0, # Don't use perl-zlib use_extern => 1, # default behaviour, informative only + noargs => $options{noargs}, level => $options{comp_level} || 6, # compression level, aka -X gzip or bzip option @@ -101,7 +102,7 @@ sub open { my ($class, %options) = @_; my $pack = _new($class, %options); sysopen($pack->{handle}, $pack->{filename}, O_RDONLY) or return undef; - $pack->read_toc(); + $pack->read_toc() or return undef; $pack->{log}->("Opening archive with '%s' / '%s'%s.", $pack->{compress_method}, $pack->{uncompress_method}, $pack->{use_extern} ? "" : " (internal compression)"); @@ -129,8 +130,10 @@ sub choose_compression_method { $pack->{direct_write} = 1; } }; - $pack->{uncompress_method} ||= "$pack->{compress_method} -d"; - $pack->{compress_method} = "$pack->{compress_method} -$pack->{level}"; + if (!$pack->{noargs}) { + $pack->{uncompress_method} ||= "$pack->{compress_method} -d"; + $pack->{compress_method} = $pack->{compress_method} ? "$pack->{compress_method} -$pack->{level}" : ""; + } } sub DESTROY { @@ -145,6 +148,7 @@ sub build_toc { my ($pack) = @_; $pack->{need_build_toc} or return 1; $pack->end_bloc(); + $pack->end_seek(); my ($toc_length, $cf, $cd, $cl) = (0, 0, 0, 0); sysseek($pack->{handle}, $pack->{coff}, 0) == $pack->{coff} or return 0; @@ -188,7 +192,6 @@ sub read_toc { $pack->{uncompress_method} ||= $uncompress; $pack->choose_compression_method(); - #printf STDERR "Toc size: %d + 16 * %d\n", $toc_str_size, $toc_f_count; sysseek($pack->{handle}, -64 - ($toc_str_size + 16 * $toc_f_count) ,2); sysread($pack->{handle}, my $fileslist, $toc_str_size); my @filenames = split("\n", $fileslist); @@ -240,7 +243,6 @@ sub end_bloc { $pack->{current_bloc_csize} = 0; $pack->{current_bloc_files} = {}; $pack->{current_bloc_off} = 0; - } ####################### @@ -250,22 +252,24 @@ sub end_bloc { sub extern_compress { my ($pack, $sourcefh) = @_; my ($insize, $outsize, $filesize) = (0, 0, 0); # aka uncompressed / compressed data length - my ($hin, $hout); # handle for open2 + my $hout; # handle for gzip if (defined($pack->{cstream_data})) { - ($hin, $hout) = ($pack->{cstream_data}{hin}, $pack->{cstream_data}{hout}); + $hout = $pack->{cstream_data}{hout}; $filesize = (stat($pack->{cstream_data}{file_bloc}))[7]; } if (defined($sourcefh)) { if (!defined($pack->{cstream_data})) { + my $hin; ($hin, $pack->{cstream_data}{file_bloc}) = tempfile(); - CORE::open($hout, "|$pack->{compress_method} > $pack->{cstream_data}{file_bloc}") or do { + close($hin); # ensure the flush + $pack->{cstream_data}{pid} = CORE::open($hout, + "|$pack->{compress_method} > $pack->{cstream_data}{file_bloc}") or do { warn "Unable to start $pack->{compress_method}"; return 0, 0; }; - ($pack->{cstream_data}{hin}, $pack->{cstream_data}{hout}) = ($hin, $hout); - binmode $hin; binmode $hout; - $| =1; + $pack->{cstream_data}{hout} = $hout; + binmode $hout; } # until we have data to push or data to read while (my $length = sysread($sourcefh, my $data, $pack->{bufsize})) { @@ -279,17 +283,22 @@ sub extern_compress { } elsif (defined($pack->{cstream_data})) { # If $sourcefh is not set, this mean we want a flush(), for end_bloc() close($hout); + waitpid $pack->{cstream_data}{pid}, 0; + sysopen(my $hin, $pack->{cstream_data}{file_bloc}, O_RDONLY) or do { + warn "Can't open temp bloc file"; + return 0, 0; + }; + $outsize = (stat($pack->{cstream_data}{file_bloc}))[7]; unlink($pack->{cstream_data}{file_bloc}); while (my $lenght = sysread($hin, my $data, $pack->{bufsize})) { (my $l = syswrite($pack->{handle}, $data)) == $lenght or do { warn "Can't write all data in archive"; }; - $outsize += $l; } close($hin); $pack->{cstream_data} = undef; } - ($insize, $outsize - $filesize) + ($insize, $outsize - $pack->{current_bloc_csize}) } sub extern_uncompress { @@ -319,18 +328,20 @@ sub extern_uncompress { } close($tempfh); - CORE::open(my $hc, "$pack->{uncompress_method} < '$tempname' |") or do { + CORE::open(my $hc, "cat '$tempname' | $pack->{uncompress_method} |") or do { warn "Can't start $pack->{uncompress_method} to uncompress data"; unlink($tempname); return -1; }; + binmode($hc); my $byteswritten = 0; my $read = 0; while ($byteswritten < $fileinfo->{size}) { my $length = sysread($hc, my $data, $pack->{bufsize}) or do { - warn "unexpected end of stream"; + warn "unexpected end of stream $tempname"; + #unlink($tempname); close($hc); return -1; }; @@ -676,7 +687,7 @@ __END__ =head1 NAME -packdrakeng - Simple Archive Extractor/Builder +Packdrakeng - Simple Archive Extractor/Builder =head1 SYNOPSIS @@ -706,7 +717,7 @@ packdrakeng - Simple Archive Extractor/Builder =head1 DESCRIPTION -C<packdrakeng> is a simple indexed archive builder and extractor using +C<Packdrakeng> is a simple indexed archive builder and extractor using standard compression method. This module is a rewrite from scratch of original packdrake, used format is diff --git a/t/01packdrakeng.t b/t/01packdrakeng.t index 0273604..34a673c 100755 --- a/t/01packdrakeng.t +++ b/t/01packdrakeng.t @@ -3,10 +3,10 @@ # $Id$ use strict; -use Test::More tests => 16; +use Test::More tests => 21; use Digest::MD5; -use_ok('packdrakeng'); +use_ok('Packdrakeng'); sub clean_test_files { -d "test" or return; @@ -29,7 +29,7 @@ sub create_test_files { %created } -sub create_know_file { +sub create_know_files { my %created; foreach my $letter ('a' .. 'z') { open(my $h, "> test/$letter"); @@ -67,34 +67,37 @@ sub check_files { sub test_packing { my ($pack_param, $listfiles) = @_; - ok(my $pack = packdrakeng->new(%$pack_param), "Creating an archive"); + ok(my $pack = Packdrakeng->new(%$pack_param), "Creating an archive"); + $pack or return; ok($pack->add(undef, keys %$listfiles), "packing files"); $pack = undef; # closing the archive. clean_test_files(); - ok($pack = packdrakeng->open(%$pack_param), "Re-opening the archive"); + ok($pack = Packdrakeng->open(%$pack_param), "Re-opening the archive"); + $pack or die; ok($pack->extract(undef, keys(%$listfiles)), "extracting files"); ok(check_files(%$listfiles), "Checking md5sum for extracted files"); $pack = undef; } +print "Test: using external cat function:\n"; + clean_test_files(); + test_packing({ archive => "packtest-cat.cz", compress => 'cat', uncompress => 'cat', noargs => 1 }, { create_test_files(30) }); + clean_test_files(); + print "Test: using internal gzip function:\n"; clean_test_files(); - test_packing({ archive => "packtest.cz" }, { create_test_files(30) }); + test_packing({ archive => "packtest-gzipi.cz" }, { create_test_files(30) }); clean_test_files(); - unlink("packtest.cz"); print "Test: using external gzip function:\n"; clean_test_files(); - test_packing({ archive => "packtest.cz", compress => "gzip", extern => 1}, { create_test_files(30) }); + test_packing({ archive => "packtest-gzip.cz", compress => "gzip", extern => 1}, { create_test_files(30) }); clean_test_files(); - unlink("packtest.cz"); - + print "Test: using external bzip function:\n"; clean_test_files(); - test_packing({ archive => "packtest.cz", compress => "bzip2", extern => 1}, { create_test_files(30) }); + test_packing({ archive => "packtest-bzip2.cz", compress => "bzip2", extern => 1}, { create_test_files(30) }); clean_test_files(); - unlink("packtest.cz"); - |