diff options
| -rwxr-xr-x | gen-gdf.pl | 142 | ||||
| -rw-r--r-- | lib/CPAN/mapcpan.pm | 83 |
2 files changed, 142 insertions, 83 deletions
@@ -23,15 +23,16 @@ my $dbmap = CPAN::cpanmap->connect( "dbi:SQLite:dbname=" . $db_map, "", "" ); my $struct_graph; $struct_graph->{ gexf } = { version => "1.0" }; $struct_graph->{ gexf }->{ meta } = { creator => [ 'rtgi' ] }; -$struct_graph->{ gexf }->{ graph } = { type => 'dynamic' }; +$struct_graph->{ gexf }->{ graph } = { type => 'static' }; +# static si pas de dates $struct_graph->{ gexf }->{ graph }->{ attributes } = { class => 'node', - type => 'dynamic', + type => 'static', }; push @{ $struct_graph->{ gexf }->{ graph }->{ attributes }->{ attribute } }, { id => 0, - title => 'dist', + #title => 'dist', type => 'string', }; say "done"; @@ -39,70 +40,125 @@ say "done"; print "creating nodes ... "; $struct_graph->{ gexf }->{ graph }->{ nodes } = {}; -my $packages; -my $id_nodes; +my ($search, $packages, $id_nodes); if ( $type && $type eq 'author' ) { - my $author_list = LoadFile( $list ); - $packages = $dbmap->resultset( 'packages' )->search( - { -and => [ - author => { 'in', $author_list}, + if ( $list ) { + my $author < io $list; + my @author_list = split /\n/, $author; + $search = { + -and => [ + author => { 'in', \@author_list }, released => { '>', '1970-01-01' } ] - } - ); -} else { - $packages = $dbmap->resultset( 'packages' )->search( - { -and => [ + }; + } else { + $search = { + -and => [ author => { '!=', 'null' }, released => { '>', '1970-01-01' } ] - } - ); + }; + } +} else { + $search = { + -and => [ + author => { '!=', 'null' }, + released => { '>', '1970-01-01' } + ] + }; } +$packages = $dbmap->resultset( 'packages' )->search( $search ); +my $id_authors; +my $authors; +my $i=0; +my $id_edges = 1; while ( my $package = $packages->next ) { - my ( $year, $month, $day ) - = $package->released =~ /^(\d{4})-(\d{2})-(\d{2})/; - push @{ $struct_graph->{ gexf }->{ graph }->{ nodes }->{ node } }, { - id => $package->id, - label => $package->dist, - author => $package->author, - version => $package->version, - datefrom => join( '-', $year, $month, $day ), - }; - $id_nodes->{$package->id}++; + if ( $type eq 'author' ) { + if (!exists $id_authors->{$package->author}){ + $id_authors->{$package->author} = ++$i; + } + if ( !exists $authors->{ $package->author } ) { + push @{ $struct_graph->{ gexf }->{ graph }->{ nodes }->{ node } }, + { + id => $id_authors->{$package->author}, + label => $package->author, + }; + $authors->{ $package->author }++; + } + my @edges = $package->edges; + foreach my $edge ( @edges ) { + next if $edge->dist_to->author eq $package->author; + my $edges + = $struct_graph->{ gexf }->{ graph }->{ edges }->{ edge }; + my @check = grep { + $_->{ source } eq $package->author + && $_->{ target } eq $edge->dist_to->author + } @$edges; + if ( @check ) { + map { $_->{ cardinal }++ } @check; + } else { + if (!exists $id_authors->{$edge->dist_to->author}){ + $id_authors->{$edge->dist_to->author} = ++$i; + push @{ $struct_graph->{ gexf }->{ graph }->{ nodes }->{ node } }, + { + id => $id_authors->{$edge->dist_to->author}, + label => $edge->dist_to->author, + }; + $authors->{ $edge->dist_to->author }++; + } + push @{ $struct_graph->{ gexf }->{ graph }->{ edges } + ->{ edge } }, + { + id => $id_edges++, + cardinal => 1, + source => $id_authors->{$package->author}, + target => $id_authors->{$edge->dist_to->author}, + type => 'dir', + }; + } + } + } else { + my ( $year, $month, $day ) + = $package->released =~ /^(\d{4})-(\d{2})-(\d{2})/; + push @{ $struct_graph->{ gexf }->{ graph }->{ nodes }->{ node } }, + { + id => $package->id, + label => $package->dist, + author => $package->author, + version => $package->version, + datefrom => join( '-', $year, $month, $day ), + }; + $id_nodes->{ $package->id }++; + } } say "done"; print "creating edges ... "; my $id = 0; my $edges; -if ( $type && $type eq 'author' ) { - $edges = $dbmap->resultset( 'edges' ) - ->search( { dist_from => { 'in' => [ keys %$id_nodes ] }, } ); -} else { +if ( !$type ) { $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, + }; + } } -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, - }; -} say "done"; print "generating gdf ... "; my $xml = XMLout( $struct_graph, AttrIndent => 1, - - #GroupTags => { node => 'attvalue' }, KeepRoot => 1, ); $xml > io( $output_gdf ); diff --git a/lib/CPAN/mapcpan.pm b/lib/CPAN/mapcpan.pm index f93f8c8..440f62d 100644 --- a/lib/CPAN/mapcpan.pm +++ b/lib/CPAN/mapcpan.pm @@ -1,42 +1,3 @@ -package CPAN::cpanmap::edges; -use base 'DBIx::Class'; -use strict; -use warnings; - -__PACKAGE__->load_components( qw/ Core/ ); -__PACKAGE__->table( 'edges' ); - -__PACKAGE__->add_columns( - 'id' => { - 'data_type' => 'integer', - 'is_auto_increment' => 0, - 'default_value' => undef, - 'is_foreign_key' => 0, - 'name' => 'id', - 'is_nullable' => 0, - 'size' => 0 - }, - 'dist_from' => { - 'data_type' => 'integer', - 'is_auto_increment' => 0, - 'default_value' => undef, - 'is_foreign_key' => 0, - 'name' => 'dist_from', - 'is_nullable' => 0, - 'size' => 0 - }, - 'dist_to' => { - 'data_type' => 'integer', - 'is_auto_increment' => 0, - 'default_value' => undef, - 'is_foreign_key' => 0, - 'name' => 'dist_to', - 'is_nullable' => 0, - 'size' => 0 - }, -); -__PACKAGE__->set_primary_key('id'); - package CPAN::cpanmap::packages; use base 'DBIx::Class'; use strict; @@ -101,7 +62,49 @@ __PACKAGE__->add_columns( 'size' => 0 } ); -__PACKAGE__->set_primary_key('id'); +__PACKAGE__->set_primary_key( 'id' ); +__PACKAGE__->has_many( edges => 'CPAN::cpanmap::edges', 'dist_from' ); + +package CPAN::cpanmap::edges; +use base 'DBIx::Class'; +use strict; +use warnings; + +__PACKAGE__->load_components( qw/ Core/ ); +__PACKAGE__->table( 'edges' ); + +__PACKAGE__->add_columns( + 'id' => { + 'data_type' => 'integer', + 'is_auto_increment' => 0, + 'default_value' => undef, + 'is_foreign_key' => 0, + 'name' => 'id', + 'is_nullable' => 0, + 'size' => 0 + }, + 'dist_from' => { + 'data_type' => 'integer', + 'is_auto_increment' => 0, + 'default_value' => undef, + 'is_foreign_key' => 0, + 'name' => 'dist_from', + 'is_nullable' => 0, + 'size' => 0 + }, + 'dist_to' => { + 'data_type' => 'integer', + 'is_auto_increment' => 0, + 'default_value' => undef, + 'is_foreign_key' => 0, + 'name' => 'dist_to', + 'is_nullable' => 0, + 'size' => 0 + }, +); +__PACKAGE__->set_primary_key( 'id' ); +__PACKAGE__->belongs_to( dist_from => 'CPAN::cpanmap::packages' ); +__PACKAGE__->belongs_to( dist_to => 'CPAN::cpanmap::packages' ); package CPAN::cpanmap; use base 'DBIx::Class::Schema'; |