Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
# perl plot_use_graph.pl ~/Plack/lib/**/**.pm
package Parser::Package {
use Class::Accessor::Lite(
new => 1,
ro => [ qw (name includes) ],
);
}
package Parser {
use strict;
use warnings;
use Path::Class;
use PPI;
sub parse {
my ($class, $file) = @_;
my $document = PPI::Document->new($file);
my $name = $document->find_first('PPI::Statement::Package')->namespace;
my $includes = [ map {
[$_->children]->[2]->content;
} @{$document->find('PPI::Statement::Include')} ];
Parser::Package->new(
name => $name,
includes => $includes,
);
}
};
package Parser::Graphviz {
use strict;
use warnings;
use GraphViz;
use Class::Accessor::Lite(
ro => [ qw (graph known_packages) ],
);
sub new {
my ($class) = @_;
my $graph = GraphViz->new(
rankdir => 'BT',
);
bless {
graph => $graph,
}, $class;
}
sub add_file {
my ($self, $file) = @_;
my $package = eval { Parser->parse($file) };
return unless $package;
for my $include (@{$package->includes}) {
$self->_link($package->name => $include);
}
}
sub as_png {
my ($self, $path) = @_;
$self->graph->as_png($path);
}
sub _link {
my ($self, $from, $to) = @_;
warn "link $from -> $to";
$self->_ensure_node($from);
$self->_ensure_node($to);
$self->graph->add_edge($from => $to);
}
sub _ensure_node {
my ($self, $node) = @_;
return if $self->{known_nodes}->{$node};
warn "node $node";
$self->graph->add_node($node);
$self->{known_nodes}->{$node}++;
}
};
use strict;
use warnings;
my $g = Parser::Graphviz->new;
for my $file (@ARGV) {
$g->add_file($file);
}
$g->as_png('a.png');
# perl use_count_ranking.pl ~/Plack/lib/**/**.pm
package Parser::Package {
use Class::Accessor::Lite(
new => 1,
ro => [ qw (name includes) ],
);
}
package Parser {
use strict;
use warnings;
use Path::Class;
use PPI;
sub parse {
my ($class, $file) = @_;
my $document = PPI::Document->new($file);
my $name = $document->find_first('PPI::Statement::Package')->namespace;
my $includes = [ map {
[$_->children]->[2]->content;
} @{$document->find('PPI::Statement::Include')} ];
Parser::Package->new(
name => $name,
includes => $includes,
);
}
};
package Parser::Ranking {
use strict;
use warnings;
use Class::Accessor::Lite(
ro => [ qw (counts) ],
);
sub new {
my ($class) = @_;
bless {
counts => {},
}, $class;
}
sub add_file {
my ($self, $file) = @_;
my $package = eval { Parser->parse($file) };
return unless $package;
for my $include (@{$package->includes}) {
$self->counts->{$include}++;
}
}
sub ranking {
my ($self) = @_;
my $pairs = [%{$self->counts}];
my $list = [];
while (my ($class, $count) = splice @$pairs, 0, 2) {
push @$list, [$class, $count];
}
@$list = sort { $b->[1] <=> $a->[1] } @$list;
for my $line (@$list) {
print join("\t", @$line, "\n");
}
}
};
use strict;
use warnings;
my $g = Parser::Ranking->new;
for my $file (@ARGV) {
$g->add_file($file);
}
$g->ranking;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment