#! /usr/bin/perl -w
#
# atool - A script for managing file archives of various types.
#
# Copyright (C) 2001  Oskar Liljeblad
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston,
#   MA  02111-1307  USA
#
# See the atool(1) manual page for usage details.
#

use File::Basename;
use File::Spec;
use Getopt::Long;
use strict;

# Subroutine prototypes (needed for perl 5.6)
sub runcmds($$$;@);
sub getmode();
sub multiarchivecmd($$$$$@);
sub singlearchivecmd($$$$$@);
sub maketarcmd($$$$);
sub cmdexec($@);
sub parsefmt($$);
sub makeoutdir();
sub explain($);
sub extract(@);
sub shquotemeta($);
sub tailslash($);
sub de($);
sub makespec(@);
sub backticks(@);
sub readconfig($$);
sub formatext($);
sub stripext($);
sub findformat($$);

# Configuration options and their built-in defaults
$::cfg_use_tar_j_option   = 1;              # does tar support -j?
$::cfg_use_tar_z_option   = 1;              # does tar support -z?
$::cfg_use_gzip_for_z     = 1;              # use gzip to decompress .Z files?
$::cfg_use_jar            = 0;              # use jar or zip for .jar archives?
$::cfg_use_file           = 1;              # use file(1) for unknown extensions?
$::cfg_path_pager         = 'pager';        # pager program
$::cfg_path_jar           = 'jar';          # jar program
$::cfg_path_tar           = 'tar';          # tar program
$::cfg_path_zip           = 'zip';          # zip program
$::cfg_path_unzip         = 'unzip';        # unzip program
$::cfg_path_gzip          = 'gzip';         # gzip program
$::cfg_path_bzip          = 'bzip';         # bzip program
$::cfg_path_bzip2         = 'bzip2';        # bzip2 program
$::cfg_path_compress      = 'ncompress';    # compress program
$::cfg_path_rar           = 'rar';          # rar program
$::cfg_path_file          = 'file';         # file program
$::cfg_tmpdir_name        = 'Unpack-%04d';  # extraction directory name
$::cfg_default_verbosity  = 1;              # default verbosity level
$::cfg_path_syscfg        = '/etc/atool.conf';	# system-wide configuration file
$::cfg_path_usercfg       = '.atoolrc';					# user configuration file

# Global variables
$::version = '0.11.0';
$::basename = File::Basename::basename($0);
@::rmdirs = ();

# Parse arguments
Getopt::Long::config('bundling');
Getopt::Long::GetOptions(
	'l|list'         => \$::opt_cmd_list,
	'x|extract'      => \$::opt_cmd_extract,
	'X|extract-to=s' => \$::opt_cmd_extract_to,
	'a|add'          => \$::opt_cmd_add,
	'c|cat'          => \$::opt_cmd_cat,
	'q|quiet'        => sub { $::opt_verbosity--; },
	'v|verbose'      => sub { $::opt_verbosity++; },
	'V|verbosity=i'  => \$::opt_verbosity,
	'config=s'       => \$::opt_config,
	'help'           => \$::opt_cmd_help,
	'version'        => \$::opt_cmd_version,
	'F|format=s'     => \$::opt_format,
	'f|force'        => \$::opt_force,
	'p|page'         => \$::opt_use_pager,
	'e|each'         => \$::opt_each,
	'E|explain'      => \$::opt_explain,
	'S|simulate'     => \$::opt_simulate,
) or exit 1;

# Display --version
if ($::opt_cmd_version) {
	print
"atool $::version\
Written by Oskar Liljeblad <osk\@hem.passagen.se>.\
\
Copyright (C) 2001 Oskar Liljeblad.\
This is free software; see the source for copying conditions.  There is NO\
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
	exit;
}

# Display --help
if ($::opt_cmd_help) {
	print
"Usage: atool [OPTION]... ARCHIVE [FILE]...\
       atool -e [OPTION]... [ARCHIVE]...
Managing file archives of various types.\
\
Commands:\
  -l, --list              list files in archive (als)\
  -x, --extract           extract files from archive (aunpack)\
  -X, --extract-to=PATH   extract archive to current directory\
  -a, --add               create archive (apack)\
  -c, --cat               extract file to standard out (acat)\
      --help              display this help and exit\
      --version           output version information and exit\
\
Options:\
  -e, --each              execute command above for each file specified
  -F, --format=EXT        override archive format (see below)\
  -f, --force             allow overwriting of local files\
  -q, --quiet             decrease verbosity level by one\
  -v, --verbose           increase verbosity level by one\
  -V, --verbosity=LEVEL   specify verbosity (0, 1 or 2)\
  -p, --page              send output through pager\
  -E, --explain           explain what is being done by atool\
  -S, --simulate          simulation mode - no filesystem changes are made\
      --config=FILE       load configuration defaults from file\
\
Archive format (for --format) may be specified either as a\
file extension (\"tar.gz\") or as \"tar+gzip\".\
\
Report bugs to Oskar Liljeblad <osk\@hem.passagen.se>.\
";
	exit;
}

# Read configuration files
if (defined $::opt_config) {
	readconfig($::opt_config, 0);
} else {
	readconfig($::cfg_path_syscfg, 1);
	if ($::cfg_path_usercfg !~ /^\//) {
		readconfig(File::Spec->catfile($ENV{HOME}, $::cfg_path_usercfg), 1);
	} else {
		readconfig($::cfg_path_usercfg, 1);
	}
}

# Verify option integrity
$::opt_verbosity += $::cfg_default_verbosity;
if ($::opt_explain && $::opt_simulate) {
	die "$::basename: --explain and --simulate options are mutually exclusive\n";	#OK
}

my $mode = getmode();
if ($::opt_each) {
	if ($mode eq 'cat') {
		die "$::basename: --each can not be used with cat or add command\n";	#OK
	}
	if ($mode eq 'add') {
		if (!defined $::opt_format) {
			die "$::basename: specify a format with -F when using --each in add mode\n";
		}
		my $format = findformat($::opt_format, 1);
		for (my $c = 0; $c < @ARGV; $c++) {
			my $archive = File::Spec->canonpath($ARGV[$c]) . formatext($format);
			warn "$archive:\n" if $::opt_verbosity > 1;
			runcmds($mode, $archive, $c == $#ARGV, $ARGV[$c]);
		}
	} else {
		for (my $c = 0; $c < @ARGV; $c++) {
			warn "$ARGV[$c]:\n" if $::opt_verbosity > 1;
			runcmds($mode, $ARGV[$c], $c == $#ARGV);
		}
	}
} else {
	die "$::basename: missing archive argument\n" if ($#ARGV == -1);	#OK
	runcmds($mode, shift @ARGV, 1, @ARGV);
}

# runcmds:
# Execute an atool command.
# This is where it all happens.
sub runcmds($$$;@) {
	my ($mode, $archive, $exec, @args) = @_;

	my $format;
	if (defined $::opt_format) {
		$format = findformat($::opt_format, 1);
	} else {
		$format = findformat($archive, 0);
	}
	return if !defined $format;

	my @cmd;
	my $outdir;
	if ($format eq 'tar+bzip2') {
		if ($mode eq 'extract') {
			$outdir = makeoutdir();
			return if (!defined $outdir);
		}
		if ($::cfg_use_tar_j_option) {
			push @cmd, maketarcmd($archive, $outdir, $mode, 'jf'), @args;
		} else {
			push @cmd, $::cfg_path_bzip2, '-cd', $archive, ['|'] if $mode ne 'add';
			push @cmd, maketarcmd(undef, $outdir, $mode, ''), @args;
			push @cmd, ['|'], $::cfg_path_bzip2, ['>'], $archive if $mode eq 'add';
		}
		multiarchivecmd $archive, $outdir, $mode, 1, $exec, \@args, @cmd;
	}
	elsif ($format eq 'tar+gzip') {
		if ($mode eq 'extract') {
			$outdir = makeoutdir();
			return if (!defined $outdir);
		}
		if ($::cfg_use_tar_z_option) {
			push @cmd, maketarcmd($archive, $outdir, $mode, 'zf'), @args;
		} else {
			push @cmd, $::cfg_path_gzip, '-cd', $archive, ['|'] if $mode ne 'add';
			push @cmd, maketarcmd(undef, $outdir, $mode, ''), @args;
			push @cmd, ['|'], $::cfg_path_gzip, ['>'], $archive if $mode eq 'add';
		}
		multiarchivecmd $archive, $outdir, $mode, 1, $exec, \@args, @cmd;
	}
	elsif ($format eq 'tar+bzip') {
		if ($mode eq 'extract') {
			$outdir = makeoutdir();
			return if (!defined $outdir);
		}
		push @cmd, $::cfg_path_bzip, '-cd', $archive, ['|']	if $mode ne 'add';
		push @cmd, maketarcmd(undef, $outdir, $mode, ''), @args;
		push @cmd, ['|'], $::cfg_path_bzip, ['>'], $archive if $mode eq 'add';
		multiarchivecmd $archive, $outdir, $mode, 1, $exec, \@args, @cmd;
	}
	elsif ($format eq 'tar+compress') {
		if ($mode eq 'extract') {
			$outdir = makeoutdir();
			return if (!defined $outdir);
		}
		if ($::cfg_use_gzip_for_z) {
			push @cmd, $::cfg_path_gzip, '-cd', $archive, ['|']	if $mode ne 'add';
		} else {
			push @cmd, $::cfg_path_compress, '-cd', $archive, ['|']	if $mode ne 'add';
		}
		push @cmd, maketarcmd(undef, $outdir, $mode, ''), @args;
		push @cmd, ['|'], $::cfg_path_compress, ['>'], $archive if $mode eq 'add';
		multiarchivecmd $archive, $outdir, $mode, 1, $exec, \@args, @cmd;
	}
	elsif ($format eq 'tar') {
		if ($mode eq 'extract') {
			$outdir = makeoutdir();
			return if (!defined $outdir);
		}
		push @cmd, maketarcmd($archive, $outdir, $mode, 'f'), @args;
		multiarchivecmd $archive, $outdir, $mode, 1, $exec, \@args, @cmd;
	}
	elsif ($format eq 'jar' && $::cfg_use_jar) {
		if ($mode eq 'extract') {
			$outdir = makeoutdir();
			return if (!defined $outdir);
		}
		my $opts = '';
		if ($mode eq 'add') {
			warn "$::basename: $archive: $mode command not supported for $format archives\n";
			return;
		}
		$opts .= 'v' if $::opt_verbosity >= 1;
		push @cmd, $::cfg_path_jar;
		push @cmd, "x$opts", '-C', $outdir if $mode eq 'extract';
		push @cmd, "x$opts", '-C', $::opt_cmd_extract_to if $mode eq 'extract-to';
		push @cmd, "t$opts" if $mode eq 'list';
		push @cmd, "c$opts" if $mode eq 'add';
		push @cmd, $archive, @args;
		multiarchivecmd $archive, $outdir, $mode, 1, $exec, \@args, @cmd;
	}
	elsif ($format eq 'jar' || $format eq 'zip') {
		if ($mode eq 'extract') {
			$outdir = makeoutdir();
			return if (!defined $outdir);
		}
		if ($mode eq 'add') {
			push @cmd, $::cfg_path_zip, '-r';
		} else {
			push @cmd, $::cfg_path_unzip;
			push @cmd, '-p' if $mode eq 'cat';
			push @cmd, '-l' if $mode eq 'list';
			push @cmd, '-d', $outdir if $mode eq 'extract';
			push @cmd, '-d', $::opt_cmd_extract_to if $mode eq 'extract-to';
		}
		push @cmd, '-v' if $::opt_verbosity > 1;
		push @cmd, '-qq' if $::opt_verbosity < 0;
		push @cmd, '-q' if $::opt_verbosity == 0;
		push @cmd, $archive, @args;
		multiarchivecmd $archive, $outdir, $mode, 0, $exec, \@args, @cmd;
	}
	elsif ($format eq 'rar') {
		if ($mode eq 'extract') {
			$outdir = makeoutdir();
			return if (!defined $outdir);
		}
		push @cmd, $::cfg_path_rar;
		push @cmd, 'a' if $mode eq 'add';
		push @cmd, 'vt' if $mode eq 'list' && $::opt_verbosity >= 3;
		push @cmd, 'v' if $mode eq 'list' && $::opt_verbosity == 2;
		push @cmd, 'l' if $mode eq 'list' && $::opt_verbosity <= 1;
		push @cmd, 'x' if ($mode eq 'extract' || $mode eq 'extract-to');
		push @cmd, '-ierr', 'p' if $mode eq 'cat';
		push @cmd, $archive, @args;
		push @cmd, tailslash($outdir) if $mode eq 'extract';
		push @cmd, tailslash($::opt_cmd_extract_to) if $mode eq 'extract-to';
		multiarchivecmd $archive, $outdir, $mode, 0, $exec, \@args, @cmd;
	}
	elsif ($format eq 'bzip2') {
		singlearchivecmd $archive, $::cfg_path_bzip2, $format, $mode, $exec, @args;
	}
	elsif ($format eq 'bzip') {
		singlearchivecmd $archive, $::cfg_path_bzip, $format, $mode, $exec, @args;
	}
	elsif ($format eq 'gzip') {
		singlearchivecmd $archive, $::cfg_path_gzip, $format, $mode, $exec, @args;
	}
	elsif ($format eq 'compress') {
		if ($::cfg_use_gzip_for_z && $mode ne 'add') {
			singlearchivecmd $archive, $::cfg_path_gzip, $format, $mode, $exec, @args;
		} else {
			singlearchivecmd $archive, $::cfg_path_compress, $format, $mode, $exec, @args;
		}
	}
}

# de(value):
# Return 1 if value defined and is non-zero, 0 otherwise.
sub de($) {
	my ($value) = @_;
	return defined $value && $value ? 1 : 0;
}

# getmode()
# Identify the execution mode, and return it.
# Possible modes are 'cat', 'extract', 'list', 'add' or 'extract-to'.
sub getmode() {
	my $mode;
	if (de($::opt_cmd_list) + de($::opt_cmd_cat)
			+ de($::opt_cmd_extract) + de($::opt_cmd_add) 
			+ de($::opt_cmd_extract_to) > 1) {
		die "$::basename: only one command may be specified\n"; #OK
	}
	$mode = 'cat'           if ($::basename eq 'acat');
	$mode = 'extract'       if ($::basename eq 'aunpack');
	$mode = 'list'          if ($::basename eq 'als');
	$mode = 'add'           if ($::basename eq 'apack');
	$mode = 'add'		        if ($::opt_cmd_add);
	$mode = 'cat'		        if ($::opt_cmd_cat);
	$mode = 'list'			    if ($::opt_cmd_list);
	$mode = 'extract'	      if ($::opt_cmd_extract);
	$mode = 'extract-to'    if ($::opt_cmd_extract_to);
	if (!defined $mode) {
		die "$::basename: don't know what to do - no command specified\n"; #OK
	}
	return $mode;
}

# singlearchivecmd(archive, command, format, mode, exec, args)
# Execute a command for single-file archives.
# The command parameter specifies what command to execute.
sub singlearchivecmd($$$$$@) {
	my ($archive, $cmd, $format, $mode, $exec, @args) = @_;

	if ($mode eq 'add' && !$::opt_force && (-e $archive || -l $archive)) {
		warn "$::basename: $archive: refuse to overwrite existing file\n";
		return;
	}

	my $outdir = $::opt_cmd_extract_to;
	if ($mode eq 'extract-to' && -d $outdir) {
		my $base = File::Basename::basename($archive);
		$outdir = File::Spec->catfile($outdir, stripext($base));
	}

	if ($mode eq 'list') {
		warn "$::basename: $archive: $mode command not supported for $format archives\n";
		return;
	}
	my @cmd;
	push @cmd, $cmd;
	push @cmd, '-v'                       if $::opt_verbosity > 1;
	push @cmd, '-c'                       if $mode eq 'cat';
	push @cmd, '-c'                       if $mode eq 'extract-to';
	if ($mode eq 'add') {
 	 	push @cmd, '-c', @args, ['>'], $archive;
	} else {
	  push @cmd, '-d', $archive, @args;
	}
	push @cmd, ['>'], $outdir             if $mode eq 'extract-to';
	push @cmd, ['|'], $::cfg_path_pager   if $::opt_use_pager;
	cmdexec $exec, @cmd;
}

# maketarcmd(opts):
# Create (partial) command line arguments for a tar command.
# The parameter opts specifies additional arguments to add.
sub maketarcmd($$$$) {
	my ($archive, $outdir, $mode, $opts) = @_;
	$opts .= 'v' if $::opt_verbosity >= 1;
	my @cmd = ($::cfg_path_tar);
	push @cmd, "xO$opts" if $mode eq 'cat';
	push @cmd, "x$opts" if ($mode eq 'extract' || $mode eq 'extract-to');
	push @cmd, "t$opts" if $mode eq 'list';
	push @cmd, "c$opts" if $mode eq 'add';
	push @cmd, $archive if defined $archive;
	push @cmd, '-C', $outdir if $mode eq 'extract';
	push @cmd, '-C', $::opt_cmd_extract_to if $mode eq 'extract-to';
	return @cmd;
}

# cmdexec(exec, cmdspec)
# Execute a command specification.
# The cmdspec parameter is a list of string arguments building
# the command line. If there's a list reference instead of a
# string, it is a shell meta character/string which shouldn't
# be quoted.
sub cmdexec($@) {
	my ($exec, @cmd) = @_;
	my $spec = join(' ', map { ref $_ ? @{$_} : shquotemeta $_ } @cmd);
	my $rc;

	explain "$spec\n";
	if ($::opt_simulate) {
		return 1 if !$exec;
		exit;
	}

	if (grep(ref, @_)) {
		eval { local $^W = 0; exec $spec } if $exec;
		$rc = system $spec if !$exec;
	} else {
		eval { local $^W = 0; exec @cmd } if $exec;
		$rc = system @cmd if !$exec;
	}

	my $cmds = makespec(@cmd);
	if ($exec || $rc == -1) {
		warn "$::basename: cannot execute `$cmds': $!\n";
		return 0;
	}
	if ($rc & 0xFF != 0) {
		warn "$::basename: $cmds: abnormal exit\n";
		return 0;
	}
	if ($rc >> 8 != 0) {
		warn "$::basename: $cmds: non-zero return-code\n";
		return 0;
	}
	return 1;
}

# makespec(@)
# Make a command specification when printing errors.
sub makespec(@) {
	my (@cmd) = @_;
	my $spec = $cmd[0].' ..';
	my $lastref = 0;
	foreach (@cmd, '') {
		if ($lastref) {
			$spec .= " | $_ ..";
			$lastref = 0;
		}
		$lastref = 1 if (ref);
	}
	return $spec;
}

# makeoutdir()
# Make a temporary (unique) output directory for extraction command.
sub makeoutdir() {
	my $dir = '';
	do {
		$dir = sprintf $::cfg_tmpdir_name, int rand 10000;
	} while (-e $dir);

	if (!$::opt_simulate) {
		if (!mkdir($dir, 0700)) {
			warn "$::basename: cannot create directory `$dir': $!\n";
			return undef;
		}
	}
	push @::rmdirs, $dir;
	return $dir;
}

# explain($)
# Print on screen if $::opt_explain is true.
sub explain($) {
	my ($msg) = @_;
	print STDERR $msg if ($::opt_explain || $::opt_simulate);
}

# tailslash($)
# If specified file does not end with a slash,
# add one and return the new file.
sub tailslash($) {
	my ($file) = @_;
	return ($file =~ /\/$/ ? $file : "$file/");
}

# shquotemeta($)
# A more sophisticated quotemeta for bourne shells.
sub shquotemeta($) {
	my ($str) = @_;
	$str =~ s/([^A-Za-z0-9_.+,\/:=@%^-])/\\$1/g;
	return $str;
}

# multiarchivecmd(archive, outdir, mode, create, exec, argref, cmdspec)
# Execute a command for multi-file archives.
# The `create' argument controls whether the archive
# will be created (1) or just added to (0) if mode is "add".
sub multiarchivecmd($$$$$@) {
	my ($archive, $outdir, $mode, $create, $exec, $argref, @cmd) = @_;
	my @args = @{$argref};

	if (($mode eq 'cat' || $mode eq 'add') && $#args == -1) {
		die "$::basename: missing file argument\n";	#OK
	}
	if ($mode eq 'add' && $create && !$::opt_force && (-e $archive || -l $archive)) {
		warn "$::basename: $archive: refusing to overwrite existing file\n";
		return;
	}

	push @cmd, ['|'], $::cfg_path_pager if $::opt_use_pager;
	if ($mode ne 'extract') {
		cmdexec $exec, @cmd;
		return;
	}

 	return if (!cmdexec 0, @cmd);
	return if $::opt_simulate;

	if (!opendir DIR, $outdir) {
		warn "$::basename: $outdir: cannot list: $!\n";
		return;
	}
	my @files = grep !/^\.\.?$/, readdir DIR;
	closedir DIR;

	my $archivebase = File::Basename::basename($archive);
	my $reason;
	if ($#files == -1) {
		warn "$archivebase: archive is empty\n";
		rmdir $outdir;
		return;
	} elsif ($#files == 0) {
		my $fromfile = File::Spec->catfile($outdir, $files[0]);
		if ($::opt_force || (!-l $files[0] && !-e $files[0])) {
			if (!rename $fromfile, $files[0]) {
				warn "$fromfile: cannot rename: $!\n";
				return;
			}
			rmdir $outdir;
			return;
		}
		$reason = 'local file exists';
	} else {
		$reason = 'multiple root files';
	}

	my $localoutdir = stripext($archivebase);
	if (!-e $localoutdir) {
		if (!rename $outdir, $localoutdir) {
			warn "$outdir: cannot rename: $!\n";
			return;
		}
		$outdir = $localoutdir;
	}

	warn "$archivebase: extracted to `$outdir' ($reason)\n";
}

# stripext(file)
# Strip extension from the specified file.
sub stripext($) {
	my ($file) = @_;
	return $file if ($file =~ s/(\.tar\.bz2|\.tbz2)$//);
	return $file if ($file =~ s/(\.tar\.bz|\.tbz)$//);
	return $file if ($file =~ s/(\.tar\.gz|\.tgz)$//);
	return $file if ($file =~ s/(\.tar\.Z|\.tZ)$//);
	return $file if ($file =~ s/\.tar$//);
	return $file if ($file =~ s/\.bz2$//);
	return $file if ($file =~ s/\.bz$//);
	return $file if ($file =~ s/\.gz$//);
	return $file if ($file =~ s/\.zip$//);
	return $file if ($file =~ s/\.jar$//);
	return $file if ($file =~ s/\.war$//);
	return $file if ($file =~ s/\.Z$//);
	return $file if ($file =~ s/\.rar$//);
	return $file;
}

# formatext(format)
# Return the usual extension for the specified file format
sub formatext($) {
	my ($format) = @_;
	return '.tar.bz2'  if $format eq 'tar+bzip2';
	return '.tar.bz'   if $format eq 'tar+bzip';
	return '.tar.gz'   if $format eq 'tar+gzip';
	return '.tar.Z'    if $format eq 'tar+compress';
	return '.tar'      if $format eq 'tar';
	return '.bz2'      if $format eq 'bzip2';
	return '.bz'       if $format eq 'bzip';
	return '.gz'       if $format eq 'gzip';
	return '.zip'      if $format eq 'zip';
	return '.jar'      if $format eq 'jar';
	return '.Z'        if $format eq 'compress';
	return '.rar'      if $format eq 'rar';
	die "$::basename: $format: don't know file extension for format\n";
}

# findformat(spec, manual)
# Figure out format from specified file/string.
# If manual is 0, spec is a filename, otherwise
# it is a format description string.
sub findformat($$) {
	my ($file, $manual) = @_;
	my $spec = lc $file;
	if ($manual) {
		$spec =~ tr/+/./;
		$spec =~ s/^\.*/\./;
		$spec =~ s/bzip2/bz2/;
		$spec =~ s/bzip/bz/;
		$spec =~ s/gzip/gz/;
		$spec =~ s/compress/Z/;
	}
	return 'tar+bzip2'    if ($spec =~ /(\.tar\.bz2|\.tbz2)$/);
	return 'tar+bzip'     if ($spec =~ /(\.tar\.bz|\.tbz)$/);
	return 'tar+gzip'     if ($spec =~ /(\.tar\.gz|\.tgz)$/);
	return 'tar+compress' if ($spec =~ /(\.tar\.[zZ]|\.t[zZ])$/);
	return 'tar'          if ($spec =~ /\.tar$/);
	return 'bzip2'        if ($spec =~ /\.bz2$/);
	return 'bzip'         if ($spec =~ /\.bz$/);
	return 'gzip'         if ($spec =~ /\.gz$/);
	return 'zip'          if ($spec =~ /\.zip$/);
	return 'jar'          if ($spec =~ /\.(jar|war)$/);
	return 'compress'     if ($spec =~ /\.[zZ]$/);
	return 'rar'          if ($spec =~ /\.rar/);
	if (!$manual && $::cfg_use_file) {
		if (!open(TMP, $file)) {
			warn "$::basename: $file: $!\n";
			return;
		}
		close TMP;
		if (!-f $file) {
			warn "$::basename: $file: not a regular file\n";
			return;
		}
		if ($::opt_verbosity >= 1) {
			warn "$::basename: $file: format not known, identifying using file\n";
		}
		my @cmd = ($::cfg_path_file, '-b', '-L', '-z', '--', $file);
		$spec = backticks(@cmd);
		if (!defined $spec) {
			warn "$::basename: $::cfg_path_file: $!\n";
			return;
		}
		if ($? & 0xFF != 0) {
			warn "$::basename: $::cfg_path_file: abnormal exit\n";
			return;
		}
		if ($? >> 8 != 0) {
			warn "$::basename: $file: unknown file format\n";
			return;
		}
		chomp $spec;
		my $f;
		$f = 'tar+bzip2'    if (!$f && $spec =~ /^(GNU|POSIX) tar archive \(bzip2 compressed data(\W|$)/);
		$f = 'tar+gzip'     if (!$f && $spec =~ /^(GNU|POSIX) tar archive \(gzip compressed data(\W|$)/);
		$f = 'tar+bzip'     if (!$f && $spec =~ /^(GNU|POSIX) tar archive \(bzip compressed data(\W|$)/);
		$f = 'tar+compress' if (!$f && $spec =~ /^(GNU|POSIX) tar archive \(compress'd data(\W|$)/);
		$f = 'tar'        	if (!$f && $spec =~ /^(GNU|POSIX) tar archive(\W|$)/);
		$f = 'zip'        	if (!$f && $spec =~ /^Zip archive data(\W|$)/);
		$f = 'rar'        	if (!$f && $spec eq 'RAR archive data');
#		$f = 'bzip2'      	if (!$f && $spec =~ /^bzip2 compressed data(\W|$)/);
#		$f = 'bzip'       	if (!$f && $spec =~ /^bzip compressed data(\W|$)/);
#		$f = 'gzip'       	if (!$f && $spec =~ /^gzip compressed data(\W|$)/);
#		$f = 'compress'   	if (!$f && $spec =~ /^compress'd data(\W|$)/);
		$f = 'bzip2'      	if (!$f && $spec =~ / \(bzip2 compressed data(\W|$)/);
		$f = 'bzip'       	if (!$f && $spec =~ / \(bzip compressed data(\W|$)/);
		$f = 'gzip'					if (!$f && $spec =~ / \(gzip compressed data(\W|$)/);
		$f = 'compress'   	if (!$f && $spec =~ / \(compress'd data(\W|$)/);
		if ($f) {
			warn "$::basename: $file: format is `$f'\n" if $::opt_verbosity >= 1;
			return $f;
		}
		warn "$::basename: $file: unsupported file format `$spec'\n";
		return;
	}
	warn "$::basename: $file: unrecognized file format\n";
	return;
}

# backticks(cmdargs, ..)
# An implementation of the backtick (qx//) operator.
# The difference is that command STDERR output will still
# be printed on STDERR, and the shell isn't used to parse
# the command line.
sub backticks(@) {
  pipe(IN,OUT) || return;
  my $child = fork;
  return if !defined $child;
  if ($child == 0) {
    close IN || exit 1;
    close STDOUT || exit 1;
    open(STDOUT, '>&OUT') || exit 1;
    $SIG{__WARN__} = sub {};
    exec(@_) || exit 1;
  }
  close OUT;
  my $text = join('', <IN>);
  close IN;
  waitpid($child,0) == $child || return;
  return $text;
}

# readconfig(file)
# Read and parse the specified configuration file.
# If the file does not exist, just return.
# If there is an error in the configuration file,
# the program will be terminated. This could be a
# problem when there are errors in the system-wide
# configuration file.
sub readconfig($$) {
	my ($file, $failok) = @_;
	return if ($failok && !-e $file);
	open(FILE, $file) || die "$::basename: $file: $!\n";	#OK
	while (<FILE>) {
		chomp;
		next if /^\s*(#(.*))?$/;
		my ($var,$val) = /^(.*?)\s+([^\s].*)$/;
		my $varref = undef;
		($var eq 'use_tar_j_option')   && ($varref = \$::cfg_use_tar_j_option);
		($var eq 'use_tar_z_option')   && ($varref = \$::cfg_use_tar_z_option);
		($var eq 'cfg_use_gzip_for_z') && ($varref = \$::cfg_use_gzip_for_z);
		($var eq 'use_jar')            && ($varref = \$::cfg_use_jar);
		($var eq 'use_file')           && ($varref = \$::cfg_use_file);
		($var eq 'path_pager')         && ($varref = \$::cfg_path_pager);
		($var eq 'path_jar')           && ($varref = \$::cfg_path_jar);
		($var eq 'path_tar')           && ($varref = \$::cfg_path_tar);
		($var eq 'path_zip')           && ($varref = \$::cfg_path_zip);
		($var eq 'path_unzip')         && ($varref = \$::cfg_path_unzip);
		($var eq 'path_gzip')          && ($varref = \$::cfg_path_gzip);
		($var eq 'path_bzip')          && ($varref = \$::cfg_path_bzip);
		($var eq 'path_bzip2')         && ($varref = \$::cfg_path_bzip2);
		($var eq 'path_compress')      && ($varref = \$::cfg_path_compress);
		($var eq 'path_rar')           && ($varref = \$::cfg_path_rar);
		($var eq 'path_file')          && ($varref = \$::cfg_path_file);
		($var eq 'path_usercfg')       && ($varref = \$::cfg_path_usercfg);
		($var eq 'default_verbosity')  && ($varref = \$::cfg_default_verbosity);
		($var eq 'tmpdir_name')      && ($varref = \$::cfg_tmpdir_name);
		die "$::basename: $file: error in line $.\n" if (!defined $varref);	#OK
		${$varref} = $val;
	}
	close(FILE);
}

sub END {
	map (rmdir, @::rmdirs);	# Errors are ignored
}