#!/usr/bin/env perl

use File::Temp qw/ tempfile /;

# if this is set - we pack all the svn pieces
# otherwise we unpack them ...
my $pack = 0;

# if unpacking - do we copy or use hard links
my $do_link = 0;

sub syntax($)
{
    if ($pack) {
	print <<"EOF"
svn-pack: <svn checkout path> [dest-archive]
    --help - show this help
EOF
;
    } else {
	print <<"EOF"
svn-unpack: [args] [<path> (default . )]
    --link - use hard links instead of copies
    --help - show this help
EOF
;
    }
    die();
}

sub slurp_dir($)
{
    my $path = shift;
    my @paths = ();
    my $dirh;

    opendir ($dirh, $path) || die "Can't open $path: $!";
    while (my $line = readdir ($dirh)) {
	($line =~ m/^\.$/ || $line =~ m/^\.\.$/) && next;
	push @paths, $line;
    }
    close ($dirh);

    return @paths;
}

sub dump_svn_directory ($$);
sub dump_svn_directory ($$)
{
    my $path = shift;
    my $toplevel = shift;
    my @paths = ();

    for my $line (slurp_dir ($path)) {
	if ($toplevel) {
	    $line eq 'text-base' && next;
	    $line eq 'tmp' && next; # re-create on unpack
	}
	my $subpath = "$path/$line";
	push @paths, $subpath;
	-d $subpath && push @paths, dump_svn_directory ("$path/$line", 0);
    }
    
    return @paths;
}

sub find_svn($);
sub find_svn($)
{
    my $path = shift;
    my @paths = ();

    for my $line (slurp_dir ($path)) {
	my $subpath = "$path/$line";

	if ($line eq '.svn') {
	    if ($pack) {
		push @paths, dump_svn_directory ($subpath, 1);
	    } else {
		push @paths, $path;
	    }

	} elsif (-d $subpath) {
	    push @paths, find_svn ($subpath);
	}
    }

    return @paths;
}

sub make_text_base($$)
{
    my ($src, $dest) = @_;
#    print "$src -> $dest\n";
    for my $file (slurp_dir ($src)) {
	my $from = "$src/$file";
	-d $from && next;
	my $to = "$dest/$file.svn-base";
	-f $to && next;

#	print "do $from -> $to\n";
	if (!$do_link || !link ($from, $to)) {
	    `cp -a $from $to`;
	}
    }
}

sub setup_entry()
{
    my %entry;
    my @lines = ();

    $entry{__lines} = \@lines;
    $entry{kind} = '';
    $entry{name} = '';
    $entry{should_write} = 0;

    return \%entry;
}

sub find_emit_entry($$$)
{
    my ($en_out, $path, $entry) = @_;
    my $kind = $entry->{kind};
    my $name = $entry->{name};
    my $found = 0;

    if ($kind =~ m/^file$/i) {
	$found = -f "$path/$name";
    } elsif ($kind =~ m/^dir$/i) {
	$found = -d "$path/$name";
    } else {
	print STDERR "Unknown kind $kind on $name\n";
    }
    if ($found) {
	for my $line (@{$entry->{__lines}}) {
	    print $en_out $line;
	}
    } else {
	print STDERR "entry '$name' removed\n";
    }

    return $found;
}

sub rewrite_entries($)
{
    my $path = shift;
    my $entries = "$path/.svn/entries";
    my $entries_new = "$path/.svn/entries.new";
    my $en_in;
    my $en_out;

# not a full XML parser - relies on the 'friendly' layout of .svn/entries

    open ($en_in, "$entries") || die "Can't open $entries: $!\n";
    open ($en_out, ">$entries_new") || die "Can't open $entries_new: $!\n";
    my $entry;
    my $rewritten;
    while (<$en_in>) {
	my $line = $_;
	if (! defined $entry) {
	    if ($line =~ /<entry/) {
		$entry = setup_entry();
		push @{$entry->{__lines}}, $line;
	    } else {
		print $en_out $_;
	    }
	} else { # inside entry ...
	    push @{$entry->{__lines}}, $line;
	    if ($line =~ m/^\s*([\S-]+)=\"([^\"]+)\"/) {
		$entry->{$1} = $2;
#		print "Set '$1' to '$2'\n";
	    }
	    if ($line =~ m/\/>/) {
		$rewritten = 1 if (!find_emit_entry ($en_out, $path, $entry));
		$entry = undef;
	    }
	}
    }
    close ($en_in) || die "Failed to close $en_in: $!";
    close ($en_out) || die "Failed to close $en_out: $!";

    rename ($entries_new, $entries) if ($rewritten);
    unlink ($entries_new) if (!$rewritten);
}

my $src;
my $dest;

my $app_name = $0;
$app_name =~ s/^.*\/([^\/+])/$1/;
$pack = $app_name eq 'svn-pack';

print "packing mode\n" if ($pack);
print "un-packing mode\n" if (!$pack);

for my $arg (@ARGV) {
    if ($arg eq '--help' || $arg eq '-h') {
	syntax (0);
    } elsif ($arg eq '--link') {
	$do_link = 1;
    } elsif ($arg eq '--force-pack') {
	$pack = 1;
    } elsif ($arg eq '--force-unpack') {
	$pack = 0;
    } elsif (!defined $src) {
	$src = $arg;
	$src =~ s/\/$//;
    } elsif (!defined $dest) {
	$dest = $arg;
    } else {
	print "Too many arguments $arg\n";
	syntax (1);
    }
}

$src = '.' if (!defined $src && !$pack);

syntax(1) if (!defined $src);

my @files = find_svn ($src);

if ($pack) {
    if (!defined $dest) {
	$dest = $src;
	$dest =~ s/^.*\/([^\/*])/$1/;
	$dest .= "-svn.tar.gz";
    }
    print "Pack $src to $dest\n";
    my ($fh, $filename) = tempfile( "svnpackXXXXXX" );
    for my $file (@files) {
	print $fh "$file\n";
    }
    close ($fh);
    
    print "Written file list to $filename\n";
    `tar czf $dest -T $filename`;

    unlink $filename;
    print "done.\n";

} else {
    for my $from (@files) {
	mkdir ("$from/.svn/tmp"); # without which svn barfs
	mkdir ("$from/.svn/text-base");
	make_text_base ($from, "$from/.svn/text-base");
	rewrite_entries ($from);
    }
    `svn cleanup $src`
}
