summary refs log tree commit diff
path: root/gen-gdf.pl
diff options
context:
space:
mode:
authorfranck cuny <franck@lumberjaph.net>2009-04-03 17:55:58 +0200
committerfranck cuny <franck@lumberjaph.net>2009-04-03 17:55:58 +0200
commit4f4ff259d3deec52bd7a7c14aecaf2760cde3f85 (patch)
treea694b4c8ec8294752cb890d537cd923ae2439e77 /gen-gdf.pl
parentinitial import (diff)
downloadcpan-graph-4f4ff259d3deec52bd7a7c14aecaf2760cde3f85.tar.gz
use XML::Simple, generate gdf
Diffstat (limited to '')
-rwxr-xr-xgen-gdf.pl68
1 files changed, 34 insertions, 34 deletions
diff --git a/gen-gdf.pl b/gen-gdf.pl
index 72ce349..ec8709c 100755
--- a/gen-gdf.pl
+++ b/gen-gdf.pl
@@ -1,7 +1,10 @@
-#!/opt/perl/bin/perl -w
+#!/usr/bin/perl -w
 use strict;
 use feature ':5.10';
 use Getopt::Long;
+use XML::Simple;
+use YAML::Syck;
+use IO::All;
 
 use lib ( 'lib' );
 use CPAN::mapcpan;
@@ -13,48 +16,45 @@ my $options = GetOptions(
 
 my $dbmap = CPAN::cpanmap->connect( "dbi:SQLite:dbname=" . $db_map, "", "" );
 
-my $array_edges;
-my $hash_nodes;
+my $struct_graph;
 
 my $packages = $dbmap->resultset( 'packages' )->search;
-say "create nodes";
+print "creating nodes ... ";
+
+$struct_graph->{graph}->{attributes} = {
+    class => "node",
+    type => "dynamic",
+};
+
 while ( my $package = $packages->next ) {
-    $hash_nodes->{ $package->id } = {
-        tests  => $package->tests_success,
-        name   => $package->dist,
-        author => $package->author,
-        date   => $package->released,
+    $struct_graph->{ graph }->{ nodes }->{ $package->id } = {
+        id       => $package->id,
+        label    => $package->dist,
+        author   => $package->author,
+        date     => $package->released,
+        attvalue => [ { id => 0, value => $package->dist } ],
     };
 }
+say "done";
 
 my $edges = $dbmap->resultset( 'edges' )->search;
-say "create edges";
+say "creating edges ... ";
 while ( my $edge = $edges->next ) {
-    push @$array_edges,
+    push @{ $struct_graph->{ graph }->{ edges } },
         {
-        node1    => $edge->dist_from,
-        node2    => $edge->dist_to,
-        directed => 'true',
+        cardinal => 1,
+        source   => $edge->dist_from,
+        target   => $edge->dist_to,
+        attvalue => [ { id => 3, value => 'prereq' } ],
         };
 }
+say "done";
 
-#my $out = "nodedef>name VARCHAR,label VARCHAR,tests INTEGER,author VARCHAR,date VARCHAR\n";
-#foreach my $key ( keys %$hash_nodes ) {
-    #$out
-        #.= $key . ","
-        #. $hash_nodes->{ $key }->{ name } . ","
-        #. $hash_nodes->{ $key }->{ tests } . ","
-        #. $hash_nodes->{ $key }->{ author } . ","
-        #. $hash_nodes->{ $key }->{ date } . "\n";
-#}
-#$out .= "edgedef>node1 VARCHAR,node2 VARCHAR,directed BOOLEAN\n";
-#foreach my $edge ( @$array_edges ) {
-    #$out
-        #.= $edge->{ node1 } . ","
-        #. $edge->{ node2 } . ","
-        #. $edge->{ directed } . "\n";
-#}
-
-#open my $fh_gdf, '>', $output_gdf or die $!;
-#print $fh_gdf $out;
-#close $fh_gdf;
\ No newline at end of file
+print "generating gdf ... ";
+my $xml = XMLout(
+    $struct_graph,
+    AttrIndent => 1,
+    GroupTags  => { node => 'attvalue' }
+);
+$xml > io( $output_gdf );
+say "done";
\ No newline at end of file