import graph maker for graphviz

Just small perl script to parse dumpbin /imports output and make .dot file for graphviz

#!perl -w
# Lame script to make .dot graphviz file for drivers import graph
# 28 dec 2012 (C) RedPlait
use strict;
use warnings;
use File::Basename;
use Getopt::Std;
use vars qw/$opt_f $opt_w/;

my $wdir = "c:/windows/system32";

sub usage
{
    print STDERR <<EOF;
Usage is $0 [options] file(s)
Options:
  -f -- output file name, default stdout
  -w -- windows dir, default $wdir
EOF
    exit (8);
}

# global dicts
my %name2id;
my %items;
my $Gid = 0;

sub get_full_name
{
  my $name = shift;
  my $d1 = $wdir . '/' . $name;
  return $d1 if ( -f $d1 );
  $d1 = $wdir . '/drivers/' . $name;
  return $d1 if ( -f $d1 );
  return undef;
}

sub make_dot
{
  my $fh = shift;
  # header
  print $fh "digraph ImpGraph {\n";
  my $iter;
  foreach $iter ( keys %name2id )
  {
    printf($fh "d%d [shape=box];\n", $name2id{$iter});
    printf($fh "d%d [label=\"%s\"];\n", $name2id{$iter}, $iter);
  }
  foreach $iter ( sort { $a <=> $b } keys %items )
  {
    my $aref = $items{$iter};
    printf($fh "d%d -> d%d;\n", $iter, $_) foreach @$aref;
  }
  # footer
  print $fh "}\n";
}

# warning ! this function is recursive
sub process
{
  my($fname, $id) = @_;
  my($cmd, @imports, $aref);
  # check if this entry already was added
  return if ( exists $name2id{$fname} );
  my $fullname = get_full_name($fname);
  if ( !defined $fullname )
  {
    warn("Cannot find file $fname\n");
    return;
  }
  $cmd = 'dumpbin /imports "' . $fullname . '"';
  my($fh, $str, $state);
  open($fh, '-|', $cmd) or die("Cannot run " . $cmd . "error $!");
  $name2id{$fname} = $id;
  $aref = [];
  $state = 0;
  while( $str = <$fh> )
  {
    chomp $str;
    if ( !$state )
    {
      next if ( $str !~ /Section contains the following imports:/ );
      $state++;
      next;
    }
    if ( $state && $str =~ /^    (\S+)$/ )
    {
      $str = lc($1);
      push @imports, $str;
    }
  }
  close $fh;
  foreach $str ( @imports )
  {
    if ( exists $name2id{$str} )
    {
      push @$aref, $name2id{$str};
      next;
    }
    my $cid = ++$Gid;
    push @$aref, $cid;
    process($str, $cid);
  }
  $items{$id} = $aref;
}

# main
my $status = getopts("f:w:");
if ($status == 0)
{
    usage();
}

# check -w option
if ( defined $opt_w )
{
  $opt_w =~ s/[\\\/]$//;
  die("Cannot find $opt_w directory, error $!") if ( ! -d $opt_w );
  $wdir = $opt_w;
}

# process all
my $f;
foreach $f ( @ARGV )
{
  my $fn;
  if ( $f =~ /\*/ )
  {
    my @files = glob($f);
    foreach ( @files )
    {
      $fn = basename(lc($_));
      next if ( exists $name2id{$fn} );
      process($fn, ++$Gid);
    }
  } else {
    $fn = basename(lc($f));
    next if ( exists $name2id{$fn} );
    process($fn, ++$Gid);
  }
}

# produce output
if ( $Gid )
{
  my $fh = *STDOUT;
  if ( defined $opt_f )
  {
    open($fh, '>', $opt_f) or die("Cannot open file $opt_f, error $!\n");
  }
  make_dot $fh;
}

Make terrible images for all drivers on my xp 32bit machine: