#!/usr/bin/perl -w
#
# Darcs patch dependency grapher v0.1. Usage:
#
#   cd myrepo
#   deps.pl [subset] | dot -Tps -o deps.eps
#   gv deps.eps
#
# Where the optional 'subset' argument is the path to a repository
# which is a subset of the current one, in which case only the extra
# patches will be graphed. Both repositories must be local and not
# partial.
#
# Hint: Try using dot -Gsize=50,50 for large graphs, otherwise
# Ghostscript may fall over.
#
# WARNING: Darcs commands will be run against both repositories. They
# should be restored to their original condition afterwards, but
# things might break.
#
# Comments to ttimonen#movial.fi
#             james,webb#sygneca,com.
#
#
# ------------------------------------------------------------------------
# Copyright (c) 2005 Sygneca Ltd.
# Copyright (c) 2005 Movial Corporation
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License (GPL)
# 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.
#
# The full license text is at http://www.gnu.org/copyleft/gpl.html
# ------------------------------------------------------------------------

use FileHandle;
use IPC::Open2;
use Cwd;

$pwd = getcwd();

# Create sentinel patch to avoid leaving darcs
system("touch DEPS_TEMPORARY_FILE");
system("darcs add DEPS_TEMPORARY_FILE > /dev/null");
system("darcs record -a --no-test --no-ask-deps -A darcs-deps -m DEPS_TEMPORARY_PATCH DEPS_TEMPORARY_FILE > /dev/null");

# Use a blank repo if none is supplied
if($ARGV[0]) {
	chdir($ARGV[0]);
} else {
	mkdir("/tmp/darcsdeps$$");
	chdir("/tmp/darcsdeps$$");
	system("darcs init");
}

# Start talking
open2(*IN, *OUT, "darcs pull --quiet '$pwd'");

$patches = [];

# Get patch descriptions
parse_patch();
$total = $patch->{total}-1;
while($patch->{title} ne "DEPS_TEMPORARY_PATCH") {
	$patches->[$patch->{num}] = $patch;
	print OUT "w";
	parse_patch();
}

rewind_to(1);

# Find dependencies by saying 'no' to each patch in turn and
# seeing which ones disappear.
while($patch->{title} ne "DEPS_TEMPORARY_PATCH") {
	print STDERR "\rExamining patch $patch->{num} of $total.";
	$seen = [];
	$dep = $patches->[$patch->{num}];
	print OUT "n";
	parse_patch();
	while($patch->{title} ne "DEPS_TEMPORARY_PATCH") {
		$seen->[$patch->{num}] = 1;
		print OUT "w";
		parse_patch();
	}
	for $i ($dep->{num}+1 .. $total) {
		if(!$seen->[$i]) {
			push(@{$patches->[$i]{deps}}, $dep);
		}
	}
	rewind_to($dep->{num});
	print OUT "y";
	parse_patch();
}

# Clean up
print OUT "q";
chdir($pwd);
system("rm -rf /tmp/darcsdeps$$");
system("echo -n y | darcs unpull -p DEPS_TEMPORARY_PATCH > /dev/null");
print STDERR "\rDone.                                 \n";

# Simplify transitive deps
for $n (1..$#{$patches}) {
	print STDERR "\rPatch $n  ";
	$patch = $patches->[$n];
	$v = {};
	for $d (@{$patch->{deps}}) {
		simplify($d, $v);
	}
	$ndeps = [];
	for $d (@{$patch->{deps}}) {
		if(!$v->{$d->{num}}) { push(@$ndeps, $d); }
	}
	$patch->{deps} = $ndeps;
}

# Spit out the dot file
print "digraph deps {\n";
print "\trankdir=LR;\n";
print "\tnode [ shape=box ];\n";
for $p (1..$#$patches) {
	($t = $patches->[$p]{title}) =~ s/("|\\)/\\$1/g;
	print "\tp$p [ label = \"$t\" ];\n";
	for $d (@{$patches->[$p]{deps}}) {
		print "\tp$d->{num} -> p$p;\n";
	}
}
print "}\n";

sub simplify {
	my ($p, $v) = @_;
	if(!$p->{fulld}) {
	    my $fd = {};
	    for $d (@{$p->{deps}}) {
		$fd->{$d->{num}} = 1;
		simplify($d, $fd);
	    }
	    $p->{fulld}=$fd;
	}
	for $d (keys %{$p->{fulld}}) {
	    $v->{$d} = 1;
	}
}
	
sub rewind_to {
	while($patch->{num} != $_[0]) {
		# Hack to make Darcs re-ask about every patch
		print OUT "kwk";
		parse_patch();
		parse_patch();
		parse_patch();
	}
}
	
sub parse_patch {
	$patch = {};
	chomp($_ = <IN>);
	defined($_) or die;
	while(/^$|ynWvpxqadjk|Pulling from/i) { chomp($_ = <IN>); }
	/(.*)  (.*)/ or die $_;
	$patch->{date} = $1;
	$patch->{author} = $2;
	chomp($_ = <IN>);
	/^  (\*|UNDO:|tagged) (.*)/ or die $_;
	$patch->{type} = $1;
	$patch->{title} = ($1 eq "UNDO:" || $1 eq "tagged") ? $1 . " " .$2 : $2;
	$patch->{desc} = "";
	$patch->{deps} = [];
	my $l = "";
	while(defined($c = getc IN)) {
		$l .= $c;
		if($l =~ /^Shall I pull this patch\? \(([0-9]*)\/([0-9]*)\)/) {
			$patch->{num} = $1;
			$patch->{total} = $2;
			return;
		}
		if($c eq "\n") {
			$l =~ s/^  //;
			$patch->{desc} .= $l;
			$l = "";
		}
	}
	die $patch->{title};
}