#!/usr/bin/perl

=head1 NAME

xref.pl - graphing subroutine cross-reference reports for Perl modules

=cut

=head1 SYNOPSIS

To graph the subroutine cross-reference of 'Functional.pm':

  % perl -MO=Xref,-r Functional.pm > examples/Functional.xref
  % ./xref_aux.pl Functional.xref > Functional.png
  % gqview Functional.png
  # (or your favourite image viewer)

=head1 DESCRIPTION

xref.pl uses the information gleamed by the B::Xref module to draw a
pretty graph showing how subroutines in a module call each other.

For example, the "GraphViz.png" image shows that:

=over 4

=item * _as_debug can call _attributes

=item * both _parse_dot and _as_generic can call run

=back

Unfortunately, it is quite hard to understand this without looking at
the picture, hence this program and the GraphViz module ;-)

A couple of options are available by changing variables in the
program. It is expected that these become command-line options for the
next version.

=head1 AUTHOR

Leon Brocard E<lt>F<acme@astray.com>E<gt>

=head1 COPYRIGHT

Copyright (C) 2000, Leon Brocard

This module is free software; you can redistribute it or modify it
under the same terms as Perl itself.

=cut

use strict;
use lib '../lib';
use GraphViz;
use IO::File;

my $multiple_edges = 0;
my $show_lines = 0;

$multiple_edges = 1 if $show_lines;

my $fh = IO::File->new(shift || 'Functional.xref') || die "$!";

my $g = GraphViz->new();

my %edges;

while (defined(my $line = <$fh>)) {
  chomp $line;
  my($file, $subroutine, $line, $package, $proto, $name, $type) = split /\s+/, $line;
  next if $file =~ /^\//;
  next unless $proto =~ /&/;
  next if $subroutine eq '(definitions)';

#  warn "$file $subroutine $package $proto $name $type\n";

#warn "$subroutine -> $package $name\n";

  my $subcluster = $subroutine;
  $subcluster =~ s|::.*?$||;
  $subroutine =~ s|^.*::||;

  my $namecluster = $package;

#warn "# $subroutine ($subcluster) -> $name ($namecluster)\n";

  my $subnode = $g->add_node($subroutine, cluster => $subcluster);
  my $namenode = $g->add_node($name, cluster => $namecluster);

  next if !$multiple_edges && $edges{$subnode}->{$namenode}++;

  my $edge = { from =>  $subnode,
	         to => $namenode,
	     };

  if ($show_lines) {
    $g->add_edge($subnode => $namenode, label => $line);
  } else {
    $g->add_edge($subnode => $namenode);
  }
}

print $g->as_png;
#print $g->_as_debug;
#print $g->as_text;