diff options
author | franck cuny <franck@lumberjaph.net> | 2009-04-08 11:46:59 +0200 |
---|---|---|
committer | franck cuny <franck@lumberjaph.net> | 2009-04-08 11:46:59 +0200 |
commit | f23d0b91562cc7a5b7ec2e37209bef5aeae5b8fb (patch) | |
tree | cdf08809ac21e08dfa085eb881ec8620212c6ef6 | |
parent | check date (diff) | |
download | cpan-graph-f23d0b91562cc7a5b7ec2e37209bef5aeae5b8fb.tar.gz |
can generate a graph for authors
Diffstat (limited to '')
-rwxr-xr-x | gen-gdf.pl | 42 |
1 files changed, 30 insertions, 12 deletions
diff --git a/gen-gdf.pl b/gen-gdf.pl index e8537af..bd04c9a 100755 --- a/gen-gdf.pl +++ b/gen-gdf.pl @@ -40,15 +40,25 @@ print "creating nodes ... "; $struct_graph->{ gexf }->{ graph }->{ nodes } = {}; my $packages; - -$packages = $dbmap->resultset( 'packages' )->search( - { -and => [ - author => { '!=', 'null' }, - released => { '>', '1970-01-01' } - ] - } -); - +my $id_nodes; +if ( $type && $type eq 'author' ) { + my $author_list = LoadFile( $list ); + $packages = $dbmap->resultset( 'packages' )->search( + { -and => [ + author => { 'in', $author_list}, + released => { '>', '1970-01-01' } + ] + } + ); +} else { + $packages = $dbmap->resultset( 'packages' )->search( + { -and => [ + author => { '!=', 'null' }, + released => { '>', '1970-01-01' } + ] + } + ); +} while ( my $package = $packages->next ) { my ( $year, $month, $day ) @@ -60,21 +70,29 @@ while ( my $package = $packages->next ) { version => $package->version, datefrom => join( '/', $year, $month, $day ), }; + $id_nodes->{$package->id}++; } say "done"; print "creating edges ... "; my $id = 0; -$struct_graph->{ gexf }->{ graph }->{ edges } = {}; -my $edges = $dbmap->resultset( 'edges' )->search; +my $edges; +if ( $type && $type eq 'author' ) { + $edges = $dbmap->resultset( 'edges' ) + ->search( { dist_from => { 'in' => [ keys %$id_nodes ] }, } ); +} else { + $edges = $dbmap->resultset( 'edges' )->search; +} + while ( my $edge = $edges->next ) { + next unless exists $id_nodes->{ $edge->dist_from }; + next unless exists $id_nodes->{ $edge->dist_to }; push @{ $struct_graph->{ gexf }->{ graph }->{ edges }->{ edge } }, { cardinal => 1, source => $edge->dist_from, target => $edge->dist_to, type => 'dir', id => ++$id, - #attvalue => [ { id => 3, value => 'prereq' } ], }; } say "done"; |