aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Packdrakeng.pm49
-rwxr-xr-xt/01packdrakeng.t29
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");
-