graph-includes

   1 #!/usr/bin/env perl
   2
   3 # graph-includes - create a graphviz graph of source-files
   4 # dependencies, with an emphasis on getting usable graphs even for
   5 # large projects
   6
   7 # (c) 2005 Yann Dirson <ydirson@altern.org>
   8 # Distributed under version 2 of the GNU GPL.
   9
  10 use warnings;
  11 use strict;
  12
  13 use Getopt::Long;
  14
  15 #FIXME: also set arrow head
  16 our $paperparams='-Gnodesep=0.1 -Granksep=0.1 -Nfontsize=5 -Efontsize=5';
  17 our %paper = (
  18               a4     => '11.6,8.2',
  19               a3     => '16.5,11.6',
  20               letter => '11,8.5',
  21              );
  22
  23 our $showalldeps=0;
  24 our $showdropped=0;
  25 our $verbose=0;
  26 our $debug=0;
  27 our $class='default';
  28 our ($minshow, $maxshow) = (1, 1);
  29 our (@focus, @colors, @inclpath);
  30 our ($outfile, $prefixstrip, $paper);
  31
  32 our $usage = <<EOF;
  33 Usage: $0 [options] src/*.[ch]
  34 Options:
  35     --class {default|uniqueincludes|<your-own-class>}
  36                            Select "class" of source code
  37     -I <directory>         Adds a directory to the path where to look for include files
  38     --prefixstrip <prefix> Strip <prefix> (eg. "src/") from filenames in the graph
  39     --group <min>-<max>    Draw file groups of levels <min> through <max> (default: 1 1)
  40     --color <n>:<label>=<color>[,<label>=<color>...]
  41                            Use specified colors to show members of level-<n> group labelled <label>
  42     --alldeps              Do not apply transitive reduction to the graph
  43
  44     --showdropped          Show in special color edges dropped during transitive reduction
  45     --focus <node-label>   Like -showdropped but only for edges starting from given node
  46
  47     --output <outfile>.<fmt>
  48                            Format to output file, using <fmt> as target format
  49
  50     --verbose              Show progress
  51     --verbose              Show details of ignored include directives
  52     --debug                Loads of debuging output
  53
  54     --help                 This help text
  55 EOF
  56
  57 our @colspecs;
  58
  59 GetOptions ('alldeps' => \$showalldeps,
  60             'showdropped' => \$showdropped,
  61
  62             'focus=s' => \@focus,
  63             'class=s' => \$class,
  64
  65             'I=s'     => \@inclpath,
  66
  67             'group=s' => sub {
  68               my (undef, $range) = @_;
  69               ($minshow, $maxshow) = split /-/, $range;
  70             },
  71             'color=s@' => sub {
  72               my (undef, $colspec) = @_;
  73               my @temp = split /:/, $colspec;
  74               push @colspecs, [$temp[1], $temp[2]];
  75             },
  76             'output=s' => \$outfile,
  77             'paper=s'  => \$paper,
  78
  79             'prefixstrip=s' => \$prefixstrip,
  80
  81             'verbose+' => \$verbose,
  82             'debug' => \$debug,
  83             'help' => sub { print $usage; exit 0; },
  84
  85            ) or die "Could not parse command-line: $!";
  86
  87 # deal with non-default output formats
  88
  89 our $dotflags = '';
  90 our $outputformat;
  91
  92 if (defined $paper) {
  93   die "Unkown paper size \`$paper'" unless defined $paper{$paper};
  94   # paper output format is postscript on stdout unless otherwise specified
  95   $outputformat = 'ps';
  96   $dotflags .= " $paperparams -Gpage=" . $paper{$paper};
  97 }
  98
  99 if (defined $outfile) {
 100   $dotflags .= " -o $outfile";
 101
 102   $outfile =~ m/.*\.([^.]+)$/ or die "cannot guess output format";
 103   $outputformat = $1;
 104 }
 105
 106 $dotflags .= " -T$outputformat" if defined $outputformat;
 107
 108 if ($dotflags ne '') {
 109   print STDERR "Running through \`dot $dotflags'\n" if $verbose;
 110   open STDOUT, "| dot $dotflags";
 111 }
 112
 113 # create a project with specified files
 114 our $classmodule = "graphincludes::project::" . $class;
 115 eval "require $classmodule" or die "cannot locate $classmodule in " . join ':', @INC;
 116 our $project = ($classmodule)->new($prefixstrip, @ARGV);
 117 $project->init();
 118
 119 @colors = $project->defaultcolors();
 120 foreach my $colspec (@colspecs) {
 121   foreach my $coldef (split /,/, $colspec->[2]) {
 122     my @coldef = split /=/, $coldef;
 123     $colors[$colspec->[1]]->{$coldef[0]} = $coldef[1];
 124   }
 125 }
 126
 127 # maybe get rid of shortcut deps (transitive reduction)
 128 $project->reduce() unless ($showalldeps);
 129
 130
 131 # print graph
 132
 133 print "strict digraph dependencies {\nrankdir=LR;\n";
 134
 135 sub sprintnode {
 136   my ($file, $min, $max) = @_;
 137   my $node = $project->filelabel($file,$max);
 138   if (!defined $node and $max > $min) {
 139     return sprintnode($file, $min, $max-1);
 140   } elsif ($min == $max) {
 141     my $fill='';
 142     $fill=",style=filled,fillcolor=" . $colors[2]->{$project->filelabel($file,2)}
 143       if defined $colors[2] and defined $project->filelabel($file,2) and
 144         defined $colors[2]->{$project->filelabel($file,2)};
 145     return $project->{NODEIDS}->{$node} . " [label=\"$node\"" . $fill . "];";
 146   } else {
 147     return "subgraph \"cluster $node\" {" . sprintnode($file, $min, $max-1) . '}';
 148   }
 149 }
 150
 151 foreach my $file (@{$project->{FILES}}) {
 152   print sprintnode($file, $minshow, $maxshow), "\n";
 153 }
 154
 155 foreach my $file (keys %{$project->{DEPS}}) {
 156   foreach my $dest (@{$project->{DEPS}->{$file}}) {
 157     print "$file -> $dest";
 158     my $special = $project->special_edge($file, $dest);
 159     print " [$special]" if defined $special;
 160     print ";\n";
 161   }
 162 }
 163
 164 print "}\n";
 165
 166 # wait for dot if needed
 167 if ($dotflags ne '') {
 168   close STDOUT;
 169   wait;
 170 }