summary refs log tree commit diff
diff options
context:
space:
mode:
authorfranck cuny <franck@lumberjaph.net>2009-04-06 13:21:37 +0200
committerfranck cuny <franck@lumberjaph.net>2009-04-06 13:21:37 +0200
commit145539eb62f1575d17652a957672d51af7543ed1 (patch)
tree741c66611d498a7cfe38530f77afc78e1af2243c
parentuse XML::Simple, generate gdf (diff)
downloadcpan-graph-145539eb62f1575d17652a957672d51af7543ed1.tar.gz
apply patch from julian, got a valid gdf file
-rwxr-xr-xgen-gdf.pl54
1 files 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";