1 files changed, 99 insertions, 43 deletions

diff --git a/gen-gdf.pl b/gen-gdf.pl
index 28ad958..eafd379 100755
--- a/gen-gdf.pl
+++ b/gen-gdf.pl
@@ -23,15 +23,16 @@ 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 } = { type    => 'static' }; 
+# static si pas de dates
 $struct_graph->{ gexf }->{ graph }->{ attributes } = {
     class => 'node',
-    type  => 'dynamic',
+    type  => 'static',
 };
 push @{ $struct_graph->{ gexf }->{ graph }->{ attributes }->{ attribute } },
     {
     id    => 0,
-    title => 'dist',
+    #title => 'dist',
     type  => 'string',
     };
 say "done";
@@ -39,70 +40,125 @@ say "done";
 print "creating nodes ... ";
 $struct_graph->{ gexf }->{ graph }->{ nodes } = {};
 
-my $packages;
-my $id_nodes;
+my ($search, $packages, $id_nodes);
 if ( $type && $type eq 'author' ) {
-    my $author_list = LoadFile( $list );
-    $packages = $dbmap->resultset( 'packages' )->search(
-        {   -and => [
-                author   => { 'in', $author_list},
+    if ( $list ) {
+        my $author < io $list;
+        my @author_list = split /\n/, $author;
+        $search = {
+            -and => [
+                author   => { 'in', \@author_list },
                 released => { '>',  '1970-01-01' }
             ]
-        }
-    );
-} else {
-    $packages = $dbmap->resultset( 'packages' )->search(
-        {   -and => [
+        };
+    } else {
+        $search = {
+            -and => [
                 author   => { '!=', 'null' },
                 released => { '>',  '1970-01-01' }
             ]
-        }
-    );
+        };
+    }
+} else {
+    $search = {
+        -and => [
+            author   => { '!=', 'null' },
+            released => { '>',  '1970-01-01' }
+        ]
+    };
 }
 
+$packages = $dbmap->resultset( 'packages' )->search( $search );
+my $id_authors;
+my $authors;
+my $i=0;
+my $id_edges = 1;
 while ( my $package = $packages->next ) {
-    my ( $year, $month, $day )
-        = $package->released =~ /^(\d{4})-(\d{2})-(\d{2})/;
-    push @{ $struct_graph->{ gexf }->{ graph }->{ nodes }->{ node } }, {
-        id       => $package->id,
-        label    => $package->dist,
-        author   => $package->author,
-        version => $package->version,
-        datefrom     => join( '-', $year, $month, $day ),
-    };
-    $id_nodes->{$package->id}++;
+    if ( $type eq 'author' ) {
+        if (!exists $id_authors->{$package->author}){
+            $id_authors->{$package->author} = ++$i;
+        }
+        if ( !exists $authors->{ $package->author } ) {
+            push @{ $struct_graph->{ gexf }->{ graph }->{ nodes }->{ node } },
+                {
+                id    => $id_authors->{$package->author},
+                label => $package->author,
+                };
+            $authors->{ $package->author }++;
+        }
+        my @edges = $package->edges;
+        foreach my $edge ( @edges ) {
+            next if $edge->dist_to->author eq $package->author;
+            my $edges
+                = $struct_graph->{ gexf }->{ graph }->{ edges }->{ edge };
+            my @check = grep {
+                       $_->{ source } eq $package->author
+                    && $_->{ target } eq $edge->dist_to->author
+            } @$edges;
+            if ( @check ) {
+                map { $_->{ cardinal }++ } @check;
+            } else {
+                if (!exists $id_authors->{$edge->dist_to->author}){
+                    $id_authors->{$edge->dist_to->author} = ++$i;
+                    push @{ $struct_graph->{ gexf }->{ graph }->{ nodes }->{ node } },
+                        {
+                        id    => $id_authors->{$edge->dist_to->author},
+                        label => $edge->dist_to->author,
+                        };
+                    $authors->{ $edge->dist_to->author }++;
+                }
+                push @{ $struct_graph->{ gexf }->{ graph }->{ edges }
+                        ->{ edge } },
+                    {
+                        id => $id_edges++,
+                    cardinal => 1,
+                    source   => $id_authors->{$package->author},
+                    target   => $id_authors->{$edge->dist_to->author},
+                    type     => 'dir',
+                    };
+            }
+        }
+    } else {
+        my ( $year, $month, $day )
+            = $package->released =~ /^(\d{4})-(\d{2})-(\d{2})/;
+        push @{ $struct_graph->{ gexf }->{ graph }->{ nodes }->{ node } },
+            {
+            id       => $package->id,
+            label    => $package->dist,
+            author   => $package->author,
+            version  => $package->version,
+            datefrom => join( '-', $year, $month, $day ),
+            };
+        $id_nodes->{ $package->id }++;
+    }
 }
 say "done";
 
 print "creating edges ... ";
 my $id = 0;
 my $edges;
-if ( $type && $type eq 'author' ) {
-    $edges = $dbmap->resultset( 'edges' )
-        ->search( { dist_from => { 'in' => [ keys %$id_nodes ] }, } );
-} else {
+if ( !$type ) {
     $edges = $dbmap->resultset( 'edges' )->search;
+    while ( my $edge = $edges->next ) {
+        next unless exists $id_nodes->{ $edge->dist_from };
+        next unless exists $id_nodes->{ $edge->dist_to };
+        push @{ $struct_graph->{ gexf }->{ graph }->{ edges }->{ edge } },
+            {
+            cardinal => 1,
+            source   => $edge->dist_from,
+            target   => $edge->dist_to,
+            type     => 'dir',
+            id       => ++$id,
+            };
+    }
 }
 
-while ( my $edge = $edges->next ) {
-    next unless exists $id_nodes->{ $edge->dist_from };
-    next unless exists $id_nodes->{ $edge->dist_to };
-    push @{ $struct_graph->{ gexf }->{ graph }->{ edges }->{ edge } }, {
-        cardinal => 1,
-        source   => $edge->dist_from,
-        target   => $edge->dist_to,
-        type => 'dir',
-        id => ++$id,
-    };
-}
 say "done";
 
 print "generating gdf ... ";
 my $xml = XMLout(
     $struct_graph,
     AttrIndent => 1,
-
-    #GroupTags  => { node => 'attvalue' },
     KeepRoot => 1,
 );
 $xml > io( $output_gdf );