#! /usr/local/bin/perl -w
# $Id: directory_to_dot.pl,v 1.17 1997/10/17 02:22:38 user Exp $

use subs qw(traverse_fullname);

use Getopt::Long;

my $symlink_weight = "0";
my $merge_symlinks = 0;
GetOptions("symlink-weight=f", \$symlink_weight,
	   "merge-symlinks", \$merge_symlinks);

%main::visited = ();

print "digraph G {\n";

if (@ARGV) {
    foreach (@ARGV) {
	traverse_fullname $_;
    }
}
else {
    while (<STDIN>) {
	chomp;
	traverse_fullname $_;
    }
}

print "}\n";
exit 0;

use File::PathConvert;
sub traverse_fullname {
    my ($file) = @_;
    my $SL = '/';
    # don't touch
    my (@parts) = split($SL, $file);
    my $segptr = 0;
    # NOTE: assume absolute pathname here
    my $base = "";
    my $basedir = "/";
    # last filename segment, e.g. "home" for $base eq "/usr/home"
    my $last_segment = "";
  PART:
    while (1) {
	die "$0: $base does not exist; $!\n" unless lstat (($base) ? $base : "/");
	# test if last lstat referred to a symbolic link
      FILETYPE: {
	  if (-l _) {
	      my $link = readlink $base;
	      my $dest = traverse_fullname(File::PathConvert::rel2abs($link, $basedir));
	      unless ($main::visited{$base}++) {
		  if ($merge_symlinks) {
		      print "\"$base\" [label=\"$last_segment\\n$link\",shape=plaintext];\n";
		      print "\"$base\" -> \"$dest\" [style=dashed,color=red,weight=$symlink_weight];\n";
		  }
		  else {
		      print "\"$base\" [label=\"$last_segment\",shape=plaintext];\n";
		      print "\"$base\" -> \"$dest\" [label=\"$link\",style=dashed,color=red,weight=$symlink_weight];\n";
		  }
	      }
	      # TODO: fix this portion
	      $base = $dest;
	      last FILETYPE;
	  }
	  if (-d _) {
	      print "\"$base\" [label=\"$last_segment/\",style=filled,color=lightblue];\n"
		  unless $main::visited{$base}++;
	      return $base unless $segptr = next_segment($segptr, @parts);
	      $last_segment = $parts[$segptr];
	      # BUG: rel2abs does not work properly when the base
	      #  ends in a slash, but requires one for root
	      $basedir = $base ? $base : "/";
	      my $newbase = $base . $SL . $last_segment;
	      print "\"$base\" -> \"$newbase\";\n"
		  unless $main::visited{"$base\0$newbase"}++;
	      $base = $newbase;
	      last FILETYPE;
	  }
	  if (-f _) {
	      print "\"$base\" [label=\"$last_segment\",style=filled,shape=box,color=limegreen];\n"
		  unless $main::visited{$base}++;
	      return $base unless next_segment($segptr, @parts);
	      die "$0: $base is not a dir; halted\n";
	      # last FILETYPE; # pointless symmetry
	  }
      } # FILETYPE
    } # PART
    # returns new base, new segment
    sub next_segment {
	my ($sp, @p) = @_;
	while (++$sp <= $#p and !$p[$sp]) {;}
        ($sp > $#p) ? 0 : $sp;
    }
}