1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
#!/usr/bin/perl -w
#
# This script tests all functionnalities of atool.
# It will help to detect arch-incompabilities.
# For now it only does basic tests.
#
# Stphane (kwisatz) Jourdois <kwisatz@rubis.org>
# Mon, 16 Aug 2004 18:42:15 +0200
use strict;
use IO::Handle;
my $testdir = '/tmp/atool';
# List of atool-supported archives types
my @extensions = ('tar.gz', 'tar.bz', 'tar.bz2', 'tar.Z',
'tar', 'zip', 'jar', 'rar', 'lha', 'ace', 'a', 'arj', 'arc',
'rpm', 'gz', 'bz', 'bz2', 'Z');
`mkdir -p $testdir`; # Fixme, use perl mkdir
chdir $testdir;
for my $ext (@extensions) {
print "Testing $ext:\n";
# Prepare some files
mkdir "test";
open FOO, ">test/test.txt";
print FOO "This is a sample file\n";
close FOO;
open FOO, ">test/foo.txt";
print FOO "foobar\n";
close FOO;
# Create an archive
print "\tpack ...";
stdout->autoflush();
if (!add("test.$ext", "test")) {
print "nok (apack returned non-zero code)\n";
clean();
next;
}
if (-e "test.$ext") { print "ok\n" }
else {
print "nok\n";
clean();
next;
}
# Remove files
clean();
# List files in archive
print "\tlist ...";
stdout->autoflush();
my $list = `als test.$ext 2>&1`;
if ($? != 0) {
print "nok (als returned non-zero code)\n";
next;
}
if ($list =~ /(?:test\/)?test\.txt/ and
$list =~ /(?:test\/)?foo\.txt/) {
print "ok\n";
} else {
print "nok (missing file)\n";
next;
}
# Unpack it
print "\tunpack ...";
stdout->autoflush();
# Workarounds
my $stdin;
$stdin = "y" if $ext eq 'arj';
if ($stdin) {
`echo $stdin | aunpack -f test.$ext 2>&1`;
} else {
`aunpack -f test.$ext 2>&1`;
}
if ($? != 0) {
print "nok (aunpack returned non-zero code)\n";
next;
}
if (-d "test") {
if (-e "test/test.txt") {
print "ok\n";
} else {
print "nok (file missing)\n";
next
}
} else {
print "nok (dir missing)\n";
next;
}
# Remove files again
clean();
# Remove archive
unlink "test.$ext";
}
`rm -rf $testdir`;
#--------------------------------------------------------------------------
sub add {
my ($archive, @files) = @_;
`apack $archive @files 2>&1`;
if ($? == 0) { return 1 }
else { return 0 }
}
sub clean {
`rm -rf test`;
}
|
