summaryrefslogtreecommitdiff
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
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