#!/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.
#
# Stéphane (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`;
}
