- fix dir / symlink creation

- add test

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) });