The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/perl -w

use Archive::Tar;
use File::Find;

$switches = shift @ARGV;
$tarfile = "./default.tar";
$create=0;
$list=0;
$extract=0;
$debug=0;

if (!$switches) {
    print<<EOF;
usage: tar [xct][v][f][z] [archive_file] [files...]
    x    Extract from archive_file
    c    Make archive_file from files
    t    Print contents of archive_file
    f    First argument is name of archive_file, default is ./default.tar
    v    Print filenames as they are added to archive_file
    z    Read/write gnuzip-compressed archive_file (not always available)
EOF
    exit;
}

foreach (split(//,$switches)) {
    if ($_ eq "x") {
	$extract = 1;
    }
    elsif ($_ eq "t") {
	$list = 1;
    }
    elsif ($_ eq "c") {
	$create = 1;
    }
    elsif ($_ eq "z") {
	$compress = 1;
    }
    elsif ($_ eq "f") {
	$tarfile = shift @ARGV;
    }
    elsif ($_ eq "v") {
	$verbose = 1;
    }
    elsif ($_ eq "d") {
	$debug = 1;
    }
    elsif ($_ eq "-") {
	# Oh, a leading dash! How cute!
    }
    else {
	warn "Unknown switch: $_\n";
    }
}

if ($extract+$list+$create>1) {
    die "More than one of x, c and t doesn't make sense.\n";
}

if ($list) {
    $arc = Archive::Tar->new($tarfile,$compress);
    print join "\n", $arc->list_files,"";
}

if ($extract) {
    $arc = Archive::Tar->new($tarfile,$compress);
    $arc->extract($arc->list_files);
}

if ($create) {
    my @f;
    
    $arc = Archive::Tar->new();
    finddepth(sub {push @f,$File::Find::name; print $File::Find::name,"\n" if $verbose},@ARGV);
    $arc->add_files(@f);
    $arc->write($tarfile,$compress);
}