#!/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,2006 Yann Dirson <ydirson@altern.org>
# Distributed under version 2 of the GNU GPL.

use warnings;
use strict;

use File::Basename qw(dirname);
use File::Spec::Functions qw(catdir canonpath);
use lib catdir(dirname($0), 'lib');

#BEGIN { print STDERR '@INC=', join (':', @INC)}

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

our $showalldeps=0;
our $class='default';
our $language='C';
our (@colors, @nodestylers, @edgestylers);
our ($outfile, $prefixstrip, $paper);
our $rendererclass = 'graphincludes::renderer::dot';

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
    -consolidate <min>-<max>
                           Consolidate 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

    -renderer <engine>     Select the rendering program to produce a graph for (default: dot)
    -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,

	    'renderer=s' => sub {
	      my (undef, $renderer) = @_;
	      $rendererclass = 'graphincludes::renderer::' . $renderer;
	    },

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

	    'consolidate=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[0], $temp[1]];
	    },
	    '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;
}

eval "require $rendererclass" or die "cannot load '$rendererclass': $@";
my $renderer = new $rendererclass;

# deal with non-default output formats

$renderer->set_multipage($paper) if defined $paper;
$renderer->set_outputfile($outfile) if defined $outfile;

# create a project with specified files
our $classmodule = "graphincludes::project::" . $class;
eval "require $classmodule" or die "cannot load '$classmodule': $@";
$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, canonpath($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";
  }
}

# generate "level 0" graph
our $project = ($classmodule)->new(prefixstrip => $prefixstrip,
				   files       => \@files);
push @graphincludes::params::sysinclpath, $project->get_default_sysincludes();
$project->init();

# Generate group graphs according to filelabel()
# Since we may use coloring according to groups, regardless of which groups the
# nodes we draw are from, we must compute graphs for all group levels
my @previous = ('files');
for (my $i = 1; $i <= $project->nlevels; $i++) {
  $project->apply_transform('DEPS::Transform::CompatGroup',
			    {level => $i,
			     labeller => $project,
			     previous => \@previous},
			    "level$i-groups",
			    'files' );
  DEPS::Transform::CompatGroup::fixup_dep($project->{TRANSGRAPH},
					  $previous[$#previous], "level$i-groups", 'files');
  push @previous, "level$i-groups";
}

my $graphtodraw;

# consolidate graphs as requested by --group flag
if ($graphincludes::params::maxshow != $graphincludes::params::minshow) {
  my @graphnames = map { ($_==0) ? 'files':"level$_-groups" } ($graphincludes::params::minshow .. $graphincludes::params::maxshow);
  $graphtodraw = "consolidation $graphincludes::params::minshow-$graphincludes::params::maxshow";
  $project->apply_transform('DEPS::Transform::Consolidate',
			    {},
			    $graphtodraw,
			    @graphnames );
} elsif ($graphincludes::params::maxshow == 0) {
  $graphtodraw = 'files';
} else {
  $graphtodraw = 'level'.$graphincludes::params::maxshow.'-groups';
}

# maybe get rid of shortcut deps (transitive reduction)
unless ($showalldeps) {
  $project->apply_transform('DEPS::Transform::TransitiveReduction',
			    {},
			    'reduction',
			    $graphtodraw );
  $graphtodraw = 'reduction';
}

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

# assign a role to each color: background, outline
{
  use DEPS::Style::Node::PerGroup;
  my @roles = qw(bgcolor bordercolor); my $role=0;
  for (my $i=$#colors; $i >= $graphincludes::params::minshow; $i--) {
    if (defined($colors[$i])) {
      die "not enough supported color roles to color level $i"
	if $role >= 2;
      push @nodestylers, new DEPS::Style::Node::PerGroup(attribute  => $roles[$role],
							 valuemap   => $colors[$i],
							 transgraph => $project->{TRANSGRAPH},
							 graph      => 'files',
							 refgraph   => "level$i-groups");
      $role++;
    }
  }
}

# number of ingredients and intra edges in nodes
use DEPS::Style::Node::GroupStats;
push @nodestylers, new DEPS::Style::Node::GroupStats();
# number of ingredients in edges
use DEPS::Style::Edge::WeightLabel;
push @edgestylers, new DEPS::Style::Edge::WeightLabel();

our $stat_nfiles = scalar $project->{ROOTGRAPH}->get_nodes;
# NOTE: $stat_nedges below is a cut'n'paste of $stat_ndeps
our $stat_ndeps = sum (map { scalar ($project->{ROOTGRAPH}->get_edges_from($_)) }
		           ($project->{ROOTGRAPH}->get_edge_origins) );

## the transformation graph
#$renderer->printgraph($project->{TRANSGRAPH},
#		      \@nodestylers, \@edgestylers);

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

# the graph to be drawn
my $thegraph = $project->{TRANSGRAPH}->get_node_from_name($graphtodraw)->{DATA};

#FIXME: ...
our $stat_nnodes = scalar $thegraph->get_nodes;
our $stat_nroots = $stat_nnodes - scalar ($thegraph->get_edge_origins);
# NOTE: $stat_ndeps above is a cut'n'paste of $stat_nedges
our $stat_nedges = sum (map { scalar ($thegraph->get_edges_from($_)) }
			    ($thegraph->get_edge_origins) );

# print graph
$renderer->printgraph($project->{TRANSGRAPH}->get_node_from_name($graphtodraw),
		      \@nodestylers, \@edgestylers);

# 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_nroots root 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 renderer to finish if needed
$renderer->wait();
