From 145539eb62f1575d17652a957672d51af7543ed1 Mon Sep 17 00:00:00 2001 From: franck cuny Date: Mon, 6 Apr 2009 13:21:37 +0200 Subject: apply patch from julian, got a valid gdf file --- gen-gdf.pl | 54 ++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 38 insertions(+), 16 deletions(-) diff --git a/gen-gdf.pl b/gen-gdf.pl index ec8709c..4ac0c65 100755 --- a/gen-gdf.pl +++ b/gen-gdf.pl @@ -13,40 +13,60 @@ 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->{ gexf }->{ graph }->{ nodes } = {}; +my $packages = $dbmap->resultset( 'packages' )->search; +while ( my $package = $packages->next ) { -$struct_graph->{graph}->{attributes} = { - class => "node", - type => "dynamic", -}; + my $datefrom + = ( $package->released ) + ? substr( $package->released, 0, 10 ) + : '1997-01-01'; + $datefrom =~ s/1970-01-01/1997-01-01/; -while ( my $package = $packages->next ) { - $struct_graph->{ graph }->{ nodes }->{ $package->id } = { + #my $dateto = ""; + push @{ $struct_graph->{ gexf }->{ graph }->{ nodes }->{ node } }, { id => $package->id, label => $package->dist, author => $package->author, - date => $package->released, + datefrom => $datefrom, + + #dateto => $dateto, attvalue => [ { id => 0, value => $package->dist } ], }; } say "done"; +print "creating edges ... "; +$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' } ], - }; + + #attvalue => [ { id => 3, value => 'prereq' } ], + }; } say "done"; @@ -54,7 +74,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"; -- cgit 1.4.1