summaryrefslogtreecommitdiff
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
Diffstat (limited to '')
-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";