util/graphfuncs.pl

   1 #!env perl -w
   2 use strict;
   3 #use GraphViz;
   4 use Getopt::Long;
   5
   6 GetOptions \our %Conf, qw(--verbose|v no|n leaves|l cc|c=s@ allccs|a nodes);
   7
   8 my $signature = qr/^([\w']*) ::/o;
   9 my $fn;
  10 my %funcs;
  11 #my $g = GraphViz->new();
  12
  13 while (<>) {
  14         if($_ =~ $signature) { $fn = $1; next }
  15         #if($_ =~ $signature) { $fn = $1; $g->add_node($fn); next }
  16         if($fn) { $funcs{$fn} .= $_ }
  17 }
  18
  19 our %nodes;
  20 for my $key (keys %funcs) {
  21         for my $func (keys %funcs) {
  22                 next if $func eq $key;
  23                 print "$key -> $func\n" if $Conf{verbose} && $funcs{$key} =~ /\b$func\b/;
  24         push @{ $nodes{$key} }, $func if $funcs{$key} =~ /\b$func\b/;
  25 #               $g->add_edge($key, $func) if($funcs{$key} =~ $func)
  26         }
  27 }
  28
  29 if ($Conf{leaves}) {
  30     print "$_\n" for grep { not defined $nodes{$_} } keys %funcs;
  31 }
  32
  33 if ($Conf{cc}) {
  34     my %ccset = map { $_ => 1 } @{ $Conf{cc} };
  35     comp_cc(\%ccset);
  36     print "$_\n" for sort keys %ccset;
  37 }
  38
  39 if ($Conf{allccs}) {
  40     $|++ if $Conf{verbose};
  41     my %allccs;
  42     for my $f (keys %nodes) {
  43         print "." if $Conf{verbose};
  44         my %cc = ($f => 1);
  45         print "calculating cc for $f\n";
  46         $allccs{$f} = [ keys %{comp_cc(\%cc)} ];
  47     }
  48     print ::Y(\%allccs),"\n";
  49 }
  50 #print $g->as_png unless $Conf{no};
  51
  52 if ($Conf{nodes}) {
  53     print ::Y(\%nodes), "\n";
  54 }
  55
  56 sub comp_cc {
  57     my ($ccset) = @_;
  58     my $oldn = 0;
  59     #::YY(\%nodes);
  60     while ($oldn != keys %$ccset) {
  61         $oldn = keys %$ccset;
  62         for my $f (keys %$ccset) {
  63 #            $ccset->{$_} = 1 for @{ $nodes{$f} };
  64             for (@{ $nodes{$f} }) {
  65                 #print "Adding $_ based on $f\n" unless $ccset->{$_};
  66                 $ccset->{$_} = 1;
  67             }
  68         }
  69     }
  70     $ccset;
  71 }
  72
  73 sub ::Y { require YAML; YAML::Dump(@_) }
  74 sub ::YY { require Carp; Carp::confess(::Y(@_)) }