dar - pure perl directory archiver

[Ctrl-z]

Category:

Utility Scripts

Description:

Simple directory archiver akin to tar, but works on Win32. See pod.

#!/usr/local/bin/perl

use strict;
use warnings;

=pod

    dar.pl: directory archiver akin to tar

    This is the result of a procrastination period during which I need
+ed 
    to get files from Windows onto Solaris quickly and easily.

    2 observations:

    1. I ALWAYS use the same args with tar: tar -cvf <DIR>.tar <DIR>
    2. Tar on Windows does not preserve case in filenames

    This code is pure perl. A rough benchmark against tar: 

        61.5Mb directory (6,363 files - 418 directories)

        tar: 66.4Mb took 33 seconds using 1.04Mb RAM
        dar: 61.9Mb took 47 seconds using 2.13Mb RAM

    The Good:
    * cvf/xvf arguments are implied
    * Extraction or Compression is implied from (lack of) parameter su
+ffix
    * Changing the .dar filename changes the output directory 
    * Text file-format, something like HTTP
    * Output is smaller than tar equivalent

    The Bad:
    * Treatment of UNIX links is undefined
    * Does not retain file stats
    * No conversion between DOS line-endings

    The Ugly:
    * Code is not very perlish as I considered rewriting in C (yeah ri
+ght!)

    Tested fleetingly on Linux, Window XP and Solaris - USE AT YOUR OW
+N RISK!
   
=cut

our $FILE_SEP  =  "/";
our $FIELD_SEP = "\t";
our $REC_SEP   = "\n";

our $TYPE_DIR  = "d";
our $TYPE_TEXT = "t";
our $TYPE_BIN  = "b";

our $BUFSIZ    = 1024;
our $CHMOD     = 0770;

our $TAG       = "DAR";
our $VERSION   = 0.1;
our $PLATFORM  = $^O;



exit main(@ARGV);

#
#
#
sub main
{
    usage() unless scalar(@_);
    
    my $arg = shift;
    my $dir = ($arg =~ /\.dar$/) ? 0 : 1;

    extract($arg) if !$dir;
    archive($arg) if  $dir;
    return 0;
}

#
#
#
sub usage
{
    print "Usage:\n";
    print "dar <DIRECTORY>        archive <DIRECTORY> in <DIRECTORY>.d
+ar\n";
    print "dar <DIRECTORY>.dar    extract <DIRECORY>.dar to <DIRECTORY
+>\n";
    print "\n";
    print "To extract to a different directory, rename the .dar file\n
+";
    exit(0);
}

#
# 
#
sub fopen
{
    my $path = shift;
    my $f;
    open($f, $path) or die "$path: $!";
    binmode($f);
    #my $s = select($f);$|++;select($s);
    return $f;
}

#
# Invoked foreach directory entry
#
sub callback
{
    my($file, $prefix, $heap, $out) = @_;
    my($type, $sz, $name, $buf, $in, $entry);

    ($name = $file) =~ s#^$prefix##;

    if(-d $file)
    {
        $type = $TYPE_DIR; 
        $sz   = 0;
    }
    else
    {
        $type = (-B $file) ? $TYPE_BIN : $TYPE_TEXT ;
        $in   = fopen($file);
        while(1)
        {
            my $read = read($in, $buf, $BUFSIZ);
            last if $read == 0;
            # TODO: fix text line-endings...
            print $heap $buf;
            $sz += $read;
        }
    }

    $entry = $type.$FIELD_SEP.$sz.$FIELD_SEP.$name.$REC_SEP;
    print $out   $entry;
    print STDOUT $entry;
}

#
# Traverse directory structure
#
sub traverse
{
    my $dir      = shift;
    my $callback = shift;
    my $full;

    opendir(my $d, $dir) or die $!;
    while(my $f = readdir($d))
    {
        next if $f =~ /^\.\.?$/;
        $full = $dir.$FILE_SEP.$f;
        &$callback($full, @_);
        traverse($full, $callback, @_) if -d $full;
    }
    closedir($d);
}

#
# Create a .dar file
#
sub archive
{
    my $dir = shift;
    my $buf;
    if(-d $dir)
    {
        my $heap = fopen(">$dir.heap");
        my $out  = fopen(">$dir.dar");

        print $out $TAG,$FIELD_SEP,$VERSION,$FIELD_SEP,$PLATFORM,$REC_
+SEP;
        traverse($dir, \&callback, $dir, $heap, $out);
        print $out $REC_SEP;
        close($heap);

        $heap = fopen("$dir.heap");
        while( read($heap, $buf, $BUFSIZ) )
        {
            print $out $buf;
        }
        close $heap;
        unlink("$dir.heap");
    }
    else
    {
        usage();
    }
}

#
# Explode a .dar file
#
sub extract
{
    my $dar     = shift;
    my $dir     = $dar;
       $dir     =~ s#\.dar$##io;
    my @entries = ();
    my ($in, $t, $v, $p, $buf);

    $in         = fopen($dar);
    ($t,$v,$p)  = split /$FIELD_SEP/, <$in>;

    die "'$dar' is not a dar file" unless $t eq $TAG;

    mkdir($dir);
    chmod $CHMOD, $dir;

    # read filepaths header
    while(<$in>)
    {
        chomp;
        last unless length($_);
        push @entries, $_;
    }

    # extract file contents from 'heap'
    foreach(@entries)
    {
        print STDOUT $_,"\n";
        my($type, $sz, $name) = split($FIELD_SEP, $_);
        my $full = $dir.$name;

        if($type eq $TYPE_DIR)
        {
            mkdir($full);
        }
        else
        {
            my $out = fopen(">".$full);
            my $len = 0;
            my $tot = 0;

            while($tot < $sz)
            {
                $len = read($in, $buf, ($sz-$tot));
                # TODO: fix text line-endings...
                print $out $buf;
                $tot += $len;
            }
            close($out);
        }
        chmod $CHMOD, $full;
    }
}

[merlyn]

Does Archive::Tar not work on windows? Or did you overlook that? Or did you rule that out (and if so, what reason)?

[PodMaster]

Archive::Tar does work on windows, as does it's tar clone, ptar.

[Ctrl-z]

No, it doesn't work. It flattens the directory structure and dumps all of the files in the root directory. For the same benchmark above it takes around 74 seconds and uses 80Mb of memory to do this.

[chb]

hm, it seems like you have a name clash with a much older project, unfortunately in the same application domain: http://dar.linux.free.fr/

[Ctrl-z]

Thanks for the heads up - looks good. Not as easy to sneak over FTP though ;-)