#!/usr/bin/env perl

# graph-includes - create a graphviz graph of source-files
# dependencies, with an emphasis on getting usable graphs even for
# large projects

# (c) 2005 Yann Dirson <ydirson@altern.org>
# Distributed under version 2 of the GNU GPL.

use warnings;
use strict;

use File::Basename qw(dirname);
use lib dirname($0).'/lib';

use Getopt::Long qw(GetOptions);
use List::Util qw(sum);
use File::Find qw(find);
use graphincludes::params;

#FIXME: also set arrow head
our $paperparams='-Gnodesep=0.1 -Granksep=0.1 -Nfontsize=5 -Efontsize=5';
our %paper = (
	      a4     => '11.6,8.2',
	      a3     => '16.5,11.6',
	      letter => '11,8.5',
	     );

our $showalldeps=0;
our $class='default';
our $language='C';
our (@colors);
our ($outfile, $prefixstrip, $paper);

our $usage = <<EOF;
Usage: $0 [options] src/*.[ch]
Options:
    -class {default|uniqueincludes|<your-own-class>}
                           Select "class" of source code
    -language <lang>       Select language syntax for dependency extraction (default: C)
    -fileregexp <perl-regexp>
                           Use this regexp to identify interesting files inside directories
                           (overrides per-language default regexp)
    -Include <directory>   Adds a directory to the path where to look for project's include files
    -sysInclude <directory> Adds a directory to the path where to look for system include files
    -prefixstrip <prefix>  Strip <prefix> (eg. "src/") from filenames in the graph
    -group <min>-<max>     Draw file groups of levels <min> through <max> (default: 1 1)
    -color <n>:<label>=<color>[,<label>=<color>...]
                           Use specified colors to show members of level-<n> group labelled <label>
    -alldeps               Do not apply transitive reduction to the graph

    -showdropped           Show in special color edges dropped during transitive reduction
    -focus <node-label>    Like -showdropped but only for edges starting from given node

    -output <outfile>.<fmt>
                           Format to output file, using <fmt> as target format
    -paper a4|a3|letter    Select paper size of multi-paged postscript output

    -verbose               Show progress
    -debug                 Loads of debuging output

    -version               Display this program's version
    -help                  This help text
EOF

our @colspecs;

# memorize command-line for the report
our @commandline = @ARGV;

GetOptions ('alldeps' => \$showalldeps,
	    'showdropped' => \$graphincludes::params::showdropped,

	    'focus=s' => \@graphincludes::params::focus,
	    'class=s' => \$class,
	    'language=s' => \$language,
	    'fileregexp=s' => \$graphincludes::params::filename_regexp,

	    'Include=s' => \@graphincludes::params::inclpath,
	    'sysInclude=s' => \@graphincludes::params::sysinclpath,

	    'group=s' => sub {
	      my (undef, $range) = @_;
	      ($graphincludes::params::minshow, $graphincludes::params::maxshow) = split /-/, $range;
	    },
	    'color=s@' => sub {
	      my (undef, $colspec) = @_;
	      my @temp = split /:/, $colspec;
	      push @colspecs, [$temp[1], $temp[2]];
	    },
	    'output=s' => \$outfile,
	    'paper=s'  => \$paper,

	    'prefixstrip=s' => \$prefixstrip,

	    'verbose+' => \$graphincludes::params::verbose,
	    'debug' => \$graphincludes::params::debug,
	    'help' => sub { print $usage; exit 0; },
	    'version' => sub { print "$0 version $graphincludes::params::VERSION\n"; exit 0; },

	   ) or print STDERR $usage and exit 1;

if (@ARGV == 0) {
  print STDERR $usage;
  exit 1;
}

# deal with non-default output formats

our $dotflags = '';
our $outputformat;

if (defined $paper) {
  die "Unkown paper size \`$paper'" unless defined $paper{$paper};
  # paper output format is postscript on stdout unless otherwise specified
  $outputformat = 'ps';
  $dotflags .= " $paperparams -Gpage=" . $paper{$paper};
}

if (defined $outfile) {
  $dotflags .= " -o $outfile";

  $outfile =~ m/.*\.([^.]+)$/ or die "cannot guess output format";
  $outputformat = $1;
}

$dotflags .= " -T$outputformat" if defined $outputformat;

if ($dotflags ne '') {
  print STDERR "Running through \`dot $dotflags'\n" if $graphincludes::params::verbose;
  open STDOUT, "| dot $dotflags";
}

# create a project with specified files
our $classmodule = "graphincludes::project::" . $class;
eval "require $classmodule" or die "cannot load $classmodule from " . join ':', @INC;
$classmodule->set_language ($language) or die "cannot set language to '$language'";
our @files;
foreach my $arg (@ARGV) {
  if (-d $arg) {
    find ( { no_chdir => 0,
	     wanted => sub {
	       if ($classmodule->accepts_file ($_)) {
		 push @files, $File::Find::name;
		 print STDERR "Adding $File::Find::name\n" if $graphincludes::params::debug;
	       }
	     } }, $arg);
  } elsif (-r $arg) {
    push @files, $arg;
  } else {
    die "file does not exist: $arg";
  }
}
our $project = ($classmodule)->new(prefixstrip => $prefixstrip,
				   files       => \@files);
$project->init();

@colors = $project->defaultcolors();
foreach my $colspec (@colspecs) {
  foreach my $coldef (split /,/, $colspec->[2]) {
    my @coldef = split /=/, $coldef;
    $colors[$colspec->[1]]->{$coldef[0]} = $coldef[1];
  }
}

our $stat_nfiles = scalar @{$project->{FILES}};
# NOTE: $stat_nedges below is a cut'n'paste of $stat_ndeps
our $stat_ndeps = sum (map { scalar keys %{$project->{DEPS}{$_}} } (keys %{$project->{DEPS}}));

if (!defined $stat_ndeps) {
  print STDERR "$0: found no dependency\n";
  exit 0;
}

# maybe get rid of shortcut deps (transitive reduction)
$project->reduce() unless ($showalldeps);

our $stat_nnodes = scalar keys %{$project->{NODES}};
our $stat_nleaves = $stat_nnodes - scalar keys %{$project->{DEPS}};
# NOTE: $stat_ndeps above is a cut'n'paste of $stat_nedges
our $stat_nedges = sum (map { scalar keys %{$project->{DEPS}{$_}} } (keys %{$project->{DEPS}}));

# print graph

print "strict digraph dependencies {\nrankdir=LR;\n";

sub sprintnode {
  my ($file, $min, $max) = @_;
  my $node = $project->filelabel($file,$max);
  if (!defined $node and $max > $min) {
    return sprintnode($file, $min, $max-1);
  } elsif ($min == $max) {
    my $fill='';
    $fill=",style=filled,fillcolor=" . $colors[2]->{$project->filelabel($file,2)}
      if defined $colors[2] and defined $project->filelabel($file,2) and
	defined $colors[2]->{$project->filelabel($file,2)};
    return $project->{NODEIDS}->{$node} . " [label=\"$node\"" . $fill . "];";
  } else {
    return "subgraph \"cluster $node\" {" . sprintnode($file, $min, $max-1) . '}';
  }
}

foreach my $file (@{$project->{FILES}}) {
  print sprintnode($file, $graphincludes::params::minshow, $graphincludes::params::maxshow), "\n";
}

foreach my $file ($project->get_dep_origins) {
  foreach my $dest ($project->get_dependencies($file)) {
    print "$file -> $dest";
    my $special = $project->special_edge($file, $dest);
    # special handling for label, as array
    push @{$special->{label}}, '[' . $project->get_dependency_weight($file, $dest) . ']';
    $special->{label} = join '\n', @{$special->{label}};
    #
    print " [", join (',', map {$_ . '="' . $special->{$_} . '"'} keys %$special), "]" if defined $special;
    print ";\n";
  }
}

print "}\n";


# print report

our $report = 'graph-includes.report';
$report = $outfile . '.' . $report if defined $outfile;
open REPORT, ">$report" or die "cannot open $report for writing: $!";
print REPORT "\n    Graph-includes report";
print REPORT "\n    =====================\n";

print REPORT "\nGeneral statistics:";
print REPORT "\n-------------------\n\n";
print REPORT "$stat_nfiles files, $stat_nnodes nodes (",
  int(100*($stat_nfiles-$stat_nnodes)/$stat_nfiles), "% dropped)\n";
print REPORT "$stat_ndeps dependencies, $stat_nedges edges (",
  int(100*($stat_ndeps-$stat_nedges)/$stat_ndeps), "% dropped)\n";
print REPORT "$stat_nleaves leaf node(s)\n";

print REPORT "\n";
print REPORT scalar keys %{$project->{REPORT}->{HDR}}, " dependencies not found\n";
print REPORT scalar keys %{$project->{REPORT}->{SYS}}, " dependencies identified as system headers\n";

print REPORT "\nDeclared dependencies not found:";
print REPORT "\n--------------------------------\n\n";
for my $dep (sort keys %{$project->{REPORT}->{HDR}}) {
  print REPORT " $dep\n";
  for my $src (@{$project->{REPORT}->{HDR}->{$dep}}) {
    print REPORT "  from $src\n";
  }
}

print REPORT "\nUsed system headers:";
print REPORT "\n--------------------\n\n";
for my $dep (sort keys %{$project->{REPORT}->{SYS}}) {
  print REPORT " $dep\n";
}

print REPORT "\nCommand-line used:";
print REPORT "\n------------------\n\n";
# display arguments separated by space, quoting any argument with embedded whitespace
print REPORT "$0 ", join ' ', map { m/\s/ ? "\"$_\"" : $_ } @commandline;

print REPORT "\n\nThis was $0 version $graphincludes::params::VERSION\n";
print REPORT "\n=== End of report ===\n";
close REPORT;

# wait for dot if needed
if ($dotflags ne '') {
  close STDOUT;
  wait;
}
