#!/usr/bin/perl

# Generate module dependency diagrams in dot format from ocaml source files,
# using ocamldep.
#
# Requires: perl, ocamldep.
# On Windows, probably works best under Cygwin.
#
# Andrew Myers, Sept. 2008

use strict;

my $scale = 50;
my $gray = "#808080";
my $missing_color = "#c0c0c0";

if ($#ARGV == -1) {
    print STDERR "Usage: dep2dot <ocaml source file> ...\n";
    exit 1;
}

open(DEPS, "ocamldep @ARGV |") || die "ocamldep not found.";

print "digraph G {\n",
      "  node [shape=box];\n";

my %targets;

while (<DEPS>) {
    my $line = $_;
    chomp $line;
    while ($line =~ m/\\$/) {
	$line =~ s/\\$//;
	$line .= <DEPS>;
	chomp $line;
    }

    if (/cmo:/) {
	(my $target, my $deps) = split /:/, $line;
	my @deps = split " ", $deps;
	print "// $line\n";

	$target =~ s/\.cmo//;
	$targets{$target} = 1;
	for my $f (@deps) {
	    $f =~ s/\.cm[io]//;
	    $targets{$f} = 1;
	    if ($f ne $target) {
		print "  $target -> $f;\n";
	    }
	}
	print "\n";
    }
}

close(DEPS);

for my $name (keys %targets) {
    my $size = &Size($name, "mll", "mly", "ml");
    my $fontcolor = "";
    if ($size == 0) {
	$fontcolor = ", fontcolor=\"$gray\"";
    }
    my $isize = &Size($name, "mli");
    if ($isize != 0) {
	$size += $isize;
    }
    print "// size of $name is $size\n";
    my $dim = sqrt($size);
    my $fontsize = $dim/4.0;
    $dim /= $scale;
    if ($fontsize < 8) { $fontsize=8; }
    if ($dim == 0) {
	$fontcolor = ", fontcolor=\"$missing_color\"";
    }

    print "  $name [width=$dim, height=$dim, fontsize=$fontsize$fontcolor];\n";
}

print "}\n";

exit 0;

# Size(name, ext1, ext2, ...) is the size of the file name
# name.ext1, or if that file doesn't exist, then the size of name.ext2,
# and so on. Returns 0 if none of the files exists.
sub Size {
    my $name = shift @_;

    foreach my $ext (@_) {
        (my $dev,my $ino,my $mode,my $nlink,my $uid,my $gid,my $rdev,my $size,
	 my $atime,my $mtime,my $ctime,my $blksize,my $blocks) =
	    stat("$name.$ext");
	if ($size > 0) {
	    return $size;
	}
    }
    return 0;
}