diff options
Diffstat (limited to 'gen-gdf.pl')
-rwxr-xr-x | gen-gdf.pl | 48 |
1 files changed, 31 insertions, 17 deletions
diff --git a/gen-gdf.pl b/gen-gdf.pl index 106752e..d01dd40 100755 --- a/gen-gdf.pl +++ b/gen-gdf.pl @@ -14,42 +14,54 @@ my $options = GetOptions( 'out=s' => \my $output_gdf, 'dbmap=s' => \my $db_map ); - +print "preparing gexf ... "; 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 }->{ attributes } = { + class => 'node', + type => 'dynamic', +}; +push @{ $struct_graph->{ gexf }->{ graph }->{ attributes }->{ attribute } }, + { + id => 0, + title => 'dist', + type => 'string', + }; +say "done"; -my $packages = $dbmap->resultset( 'packages' )->search; print "creating nodes ... "; - -$struct_graph->{graph}->{attributes} = { - class => "node", - type => "dynamic", -}; +$struct_graph->{ gexf }->{ graph }->{ nodes } = {}; +my $packages = $dbmap->resultset( 'packages' )->search; while ( my $package = $packages->next ) { my ( $year, $month, $day ) = $package->released =~ /^(\d{4})-(\d{2})-(\d{2})/; - $struct_graph->{ graph }->{ nodes }->{ $package->id } = { + push @{ $struct_graph->{ gexf }->{ graph }->{ nodes }->{ node } }, { id => $package->id, label => $package->dist, author => $package->author, - date => join( '/', $year, $month, $day ), - attvalue => [ { id => 0, value => $package->dist } ], + datefrom => join( '/', $year, $month, $day ), }; } say "done"; +print "creating edges ... "; +my $id = 0; +$struct_graph->{ gexf }->{ graph }->{ edges } = {}; my $edges = $dbmap->resultset( 'edges' )->search; -say "creating edges ... "; while ( my $edge = $edges->next ) { - push @{ $struct_graph->{ graph }->{ edges } }, - { + push @{ $struct_graph->{ gexf }->{ graph }->{ edges }->{ edge } }, { cardinal => 1, source => $edge->dist_from, target => $edge->dist_to, - attvalue => [ { id => 3, value => 'prereq' } ], - }; + type => 'dir', + id => ++$id, + #attvalue => [ { id => 3, value => 'prereq' } ], + }; } say "done"; @@ -57,7 +69,9 @@ print "generating gdf ... "; my $xml = XMLout( $struct_graph, AttrIndent => 1, - GroupTags => { node => 'attvalue' } + + #GroupTags => { node => 'attvalue' }, + KeepRoot => 1, ); $xml > io( $output_gdf ); -say "done"; \ No newline at end of file +say "done"; |