diff options
author | Franck Cuny <franck.cuny@gmail.com> | 2013-09-28 15:12:03 -0700 |
---|---|---|
committer | Franck Cuny <franck.cuny@gmail.com> | 2013-09-28 15:12:03 -0700 |
commit | 3b95d4aec6334b0e18eed433120fd549eaa5fa36 (patch) | |
tree | dc849b8a5e5414cda9bd7836a7b356f4948015c1 /generate_dots.pl | |
download | cpan-explorer-3b95d4aec6334b0e18eed433120fd549eaa5fa36.tar.gz |
import cpan-explorer master
Diffstat (limited to '')
-rw-r--r-- | generate_dots.pl | 107 |
1 files changed, 107 insertions, 0 deletions
diff --git a/generate_dots.pl b/generate_dots.pl new file mode 100644 index 0000000..c30f4d8 --- /dev/null +++ b/generate_dots.pl @@ -0,0 +1,107 @@ +#!/usr/bin/perl +use strict; +use warnings; +use DBI; +use GraphViz; + + +my @drivers = DBI->available_drivers(); +die "Error, please install DBI::SQLite" unless (grep { $_ eq "SQLite" } @drivers); + +print "Generating graphviz .dot files for each package..\n"; +my $dbh = DBI->connect("dbi:SQLite:dbname=cpants_all.db","","", { AutoCommit => 0, PrintError => 1 }); + +print "Loading packages..\n"; +my $sth = $dbh->prepare("select id, dist from dist order by dist"); +$sth->execute; +die "$DBI::errstr" if ($dbh->err()); +my $packages = {}; +while (my ($package_id, $package_name) = $sth->fetchrow) { + $packages->{ int($package_id) } = $package_name; +} +$sth->finish; +print "done\n"; + +print "Loading dependencies..\n"; +$sth = $dbh->prepare("select id, dist, in_dist from prereq order by dist"); +$sth->execute; +die "$DBI::errstr\n" if ($dbh->err()); +my @dependencies = (); +while (my ($dependency_id, $user_id, $used_id) = $sth->fetchrow) { + my $user = int( ($user_id)?$user_id:0 ); + my $used = int( ($used_id)?$used_id:0 ); + my @dep = ($user,$used); + push(@dependencies, \@dep) if ($user != 0 && $used != 0); + +} +$sth->finish; +$dbh->disconnect; +print "done\n"; + +sub addRoots { + my ($g, $package, $n, $e) = @_; + $n = {} unless defined $n; + $e = {} unless defined $e; + $n->{$package} = 1; + for (@dependencies) { + my ($user, $used) = @$_; + if ($user == $package && $used != $package) { + #print " - $package use ".$packages->{ $used }." (id: $used)\n"; + $g->add_node($used, label => $packages->{ $used }); + + $g->add_edge($package, $used); + + unless (exists($n->{$used})) { + ($g,$n, $e) = addRoots($g, $used, $n, $e); + } + } + } + ($g,$n, $e) +} + +sub addLeaves { + my ($g, $package, $n, $e) = @_; + $n = {} unless defined $n; + $e = {} unless defined $e; + $n->{$package} = 1; + for (@dependencies) { + my ($user, $used) = @$_; + if ($used == $package && $user != $package) { + #print " - $package use ".$packages->{ $used }." (id: $used)\n"; + $g->add_node($user, label => $packages->{ $user }); + + $g->add_edge($user, $package); + + unless (exists($n->{$user})) { + ($g,$n, $e) = addLeaves($g, $user, $n, $e); + } + } + } + ($g,$n, $e) +} + +print "Generating graphs..\n"; +use Data::Dumper; +while(my ($package_id, $package_name) = each(%$packages)) { + if ($package_name eq "Moose") { + print " - loading $package_name dependencies..\n"; + my $g = GraphViz->new( overlap => 'compress', ratio => 'compress' ); + my $n = {}; + my $e = {}; + + # core + $g->add_node($package_id, label => $packages->{$package_id}, color => 'red'); + + ($g,$n, $e) = addRoots($g, $package_id); + + #($g, $n, $e) = addLeaves($g, $package_id); + + print " - generating $package_name content..\n"; + #$full_graph->as_png("graphs/$package_name/$package_name.png"); + #$full_graph->as_dot("graphs/$package_name/$package_name.dot"); + $g->as_png("graphs/$package_name.png"); + } + +} + + |