#!/usr/bin/perl -w
#
# arcdir
#
# Archive directories into their own .tar.bz2 files.  Or you can
# specify a type of archive to create, eg:
#
# % arcdir -t zip directory
#
# will create the zipfile directory.zip.
#
# This program is in the public domain.  Use at your own risk.
# <http://membled.com/work/apps/unarc/>.
#
# Part of unarc version 0.2.8.
#
# -- Ed Avis, ed@membled.com, 2002-11-15
#

use strict;
use Getopt::Std;

require 'archive_types.pl'; use vars qw[%TYPES $DEF_TYPE];

########
# Configuration

# Whether we're running on NT (convert backslashes to slashes)
my $NT = 0;

# See also the stuff in archive_types.pl

########
# End of configuration

use vars qw($opt_t); getopts('t:');

# The file type we should use is in $opt_t
$opt_t = $DEF_TYPE if not defined $opt_t;

my $cmds = $TYPES{$opt_t}
  or die "archive type $opt_t not known";

my $arc_cmd = $cmds->{'pack'}
  or die "don't know a 'pack' command for archive type $opt_t";

if (not @ARGV) {
    my $avail_types = join(', ', grep { defined $TYPES{$_}->{pack} }
			         sort keys %TYPES );

    print STDERR <<END;
usage: $0 [-t type] directories...
available file types: $avail_types
default file type is $DEF_TYPE
END
    exit(1);
}

foreach (@ARGV) {
    tr!\\!/! if $NT;
    s!/+$!!;
    if (not -d) {
	warn "$_: not a directory, skipping";
	next;
    }
    my $arc = "$_.$opt_t";
    $arc =~ s!.*/!!;
    if (-e $arc) {
	warn "$_: archive $arc already exists, skipping";
	next;
    }
    my $rc = system("$arc_cmd $_ >$arc") / 256;
    if ($rc) {
	# The command returned a nonzero status - error.
	warn "$arc_cmd returned error status $rc, skipping $_";
	if (-e $arc) {
	    unlink $arc or warn "cannot unlink $arc: $!";
	}
    }
    else { print STDERR "$_/ -> $arc\n" }
}