diff options
| -rw-r--r-- | Packdrakeng.pm | 24 | ||||
| -rwxr-xr-x | t/01packdrakeng.t | 69 |
2 files changed, 64 insertions, 29 deletions
diff --git a/Packdrakeng.pm b/Packdrakeng.pm index 6986a39..0504ec4 100644 --- a/Packdrakeng.pm +++ b/Packdrakeng.pm @@ -605,25 +605,31 @@ sub extract_virtual { } sub extract { - my ($pack, $dir, @file) = @_; + my ($pack, $destdir, @file) = @_; foreach my $f (@file) { - my $dest = $dir ? "$dir/$f" : "$f"; + my $dest = $destdir ? "$destdir/$f" : "$f"; my ($dir) = $dest =~ m!(.*)/.*!; if (exists($pack->{dir}{$f})) { -d $dest || mkpath($dest) - or warn "Unable to create dir $dest"; + or warn "Unable to create dir $dest: $!"; next; } elsif (exists($pack->{'symlink'}{$f})) { - -d $dir || mkpath($dir) or do { - warn "Unable to create dir $dir"; - }; - symlink($dest, $pack->{'symlink'}{$f}) - or warn "Unable to extract symlink $f"; + -d $dir || mkpath($dir) or + warn "Unable to create dir $dest: $!"; + -l $dest and unlink $dest; + symlink($pack->{'symlink'}{$f}, $dest) + or warn "Unable to extract symlink $f: $!"; next; } elsif (exists($pack->{files}{$f})) { -d $dir || mkpath($dir) or do { warn "Unable to create dir $dir"; }; + if (-l $dest) { + unlink($dest) or do { + warn "Can't remove link $dest: $!"; + next; # Don't overwrite a file because where the symlink point to + }; + } sysopen(my $destfh, $dest, O_CREAT | O_TRUNC | O_WRONLY) or do { warn "Unable to extract $dest"; @@ -664,7 +670,7 @@ sub list { } # Print toc info -sub dump { +sub dumptoc { my ($pack) = @_; foreach my $file (keys %{$pack->{dir}}) { printf "d %13c %s\n", ' ', $file; diff --git a/t/01packdrakeng.t b/t/01packdrakeng.t index 34a673c..2321ad7 100755 --- a/t/01packdrakeng.t +++ b/t/01packdrakeng.t @@ -3,22 +3,34 @@ # $Id$ use strict; -use Test::More tests => 21; +use Test::More tests => 32; use Digest::MD5; use_ok('Packdrakeng'); +-d "test" || mkdir "test" or die "Can't create directory test"; + +my $coin = " + ___________ +< Coin coin > + ----------- + \ ,~~. + \ __( o ) + `--'==( ___/) + ( ( . / + \ '-' / + ~'`~'`~'`~'`~ +"; + sub clean_test_files { -d "test" or return; - unlink glob("test/*"); + system("rm -fr $_") foreach (glob("test/*")); } -# sub create_test_files { my ($number) = @_; my %created; - -d "test" or mkdir "test"; - foreach my $n (1 .. $number||10) { + foreach my $n (1 .. $number||10) { my $size = int(rand(1024)); # push(@created, "test/$size"); system("dd if=/dev/urandom of=test/$size bs=1024 count=$size >/dev/null 2>&1"); @@ -29,21 +41,6 @@ sub create_test_files { %created } -sub create_know_files { - my %created; - foreach my $letter ('a' .. 'z') { - open(my $h, "> test/$letter"); - foreach (1 .. 3456) { - printf $h "%s\n", $letter x 33; - } - close($h); - open($h, "test/$letter"); - $created{"test/$letter"} = Digest::MD5->new->addfile($h)->hexdigest; - close($h); - } - %created -} - sub check_files { my %files = @_; my $ok = 1; @@ -82,6 +79,38 @@ sub test_packing { $pack = undef; } + +# Single test: +{ +clean_test_files(); + +ok(my $pack = Packdrakeng->new(archive => "packtest.cz"), "Create a new archive"); +open(my $fh, "+> test/test") or die "Can't open test file $!"; +syswrite($fh, $coin); +sysseek($fh, 0, 0); +ok($pack->add_virtual('f', "coin", $fh), "Adding data from file"); +close($fh); +unlink("test/test"); + +ok($pack->add_virtual('d', "dir"), "Adding a dir"); +ok($pack->add_virtual('l', "symlink", "dest"), "Adding a symlink"); +$pack = undef; + +ok($pack = Packdrakeng->open(archive => "packtest.cz"), "Opening the archive"); +ok($pack->extract("test", "dir"), "Extracting dir"); +ok(-d "test/dir", "dir succefully restore"); +ok($pack->extract("test", "symlink"), "Extracting symlink"); +ok(readlink("test/symlink") eq "dest", "symlink succefully restore"); + +open($fh, "+> test/test") or die "Can't open file $!"; +ok($pack->extract_virtual($fh, "coin"), "Extracting data"); +sysseek($fh, 0, 0); +sysread($fh, my $data, 1000); +close($fh); +ok($data eq $coin, "Data are correct"); + +} + 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) }); |