public
Last active

  • Download Gist
gistfile1.pl
Perl
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
use strict;
use warnings;
use Class::Sniff;
 
sub package_of {
my ($path) = @_;
 
if ($path !~ m|/?lib/(.*)\.pm$|) {
die;
}
 
my $result = $1;
$result =~ s|/|::|g;
return $result;
}
 
sub new_methods {
my ($sniffer) = @_;
my %count_of;
 
for my $method ($sniffer->methods) {
$count_of{$method}++;
}
 
my $klass = $sniffer->target_class;
for my $method (keys %{ $sniffer->exported->{ $klass } }) {
$count_of{$method}--;
}
 
grep { $_ } map {
my $method = $_;
 
($count_of{$method} > 0)? $method : undef;
} (keys %count_of);
}
 
my @sniffs = map {
my $package = package_of($_);
eval "use $package";
 
Class::Sniff->new({ class => $package });
} @ARGV;
 
my $labels = join "\n", map {
my @methods = new_methods($_);
 
my $label = '{\N\n|' . join('\l', sort @methods) . '\l}';
$label =~ s/"/\\"/g;
 
sprintf('"%s" [label="%s"]', $_->target_class, $label);
} @sniffs;
 
my $sniff = pop @sniffs;
my $graphviz = $sniff->combine_graphs(@sniffs)->as_graphviz;
 
# it's dirty...
$graphviz =~ s/}/$labels }/g;
$graphviz =~ s/shape=box/shape=record/g;
 
print $graphviz;

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.