aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorOlivier Thauvin <nanardon@mandriva.org>2004-12-06 16:42:29 +0000
committerOlivier Thauvin <nanardon@mandriva.org>2004-12-06 16:42:29 +0000
commitdcd615a5ac5759ce82db71f8aac058768e2d8ce3 (patch)
tree62159ef989cd9baaee2d4a46253a0031278301a5
parent749363943850d341a730ac739e086ea837f28ea3 (diff)
downloadrpmtools-dcd615a5ac5759ce82db71f8aac058768e2d8ce3.tar
rpmtools-dcd615a5ac5759ce82db71f8aac058768e2d8ce3.tar.gz
rpmtools-dcd615a5ac5759ce82db71f8aac058768e2d8ce3.tar.bz2
rpmtools-dcd615a5ac5759ce82db71f8aac058768e2d8ce3.tar.xz
rpmtools-dcd615a5ac5759ce82db71f8aac058768e2d8ce3.zip
- fix dir / symlink creation
- add test
-rw-r--r--Packdrakeng.pm24
-rwxr-xr-xt/01packdrakeng.t69
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) });