File Coverage

blib/lib/Graph/Writer/DSM.pm
Criterion Covered Total %
statement 46 54 85.1
branch 1 2 50.0
condition 3 6 50.0
subroutine 10 11 90.9
pod n/a
total 60 73 82.1


line stmt bran cond sub pod time code
1             package Graph::Writer::DSM;
2             $Graph::Writer::DSM::VERSION = '0.008';
3 1     1   301410 use Modern::Perl;
  1         1498  
  1         4  
4 1     1   155 use base qw( Graph::Writer );
  1         1  
  1         415  
5 1     1   932 use List::MoreUtils qw( uniq first_index apply );
  1         9597  
  1         5  
6 1     1   1559 use Chart::Gnuplot;
  1         16503  
  1         31  
7 1     1   6 use File::Temp;
  1         3  
  1         536  
8              
9             =head1 NAME
10              
11             Graph::Writer::DSM - draw graph as a DSM matrix
12              
13             =head1 VERSION
14              
15             version 0.008
16              
17             =head1 DESCRIPTION
18              
19             Write graph as a quadractic matrix N x N, where N is the number of vertices in
20             the graph. It is useful to visualize graphs with at least 1k vertices.
21              
22             See more about DSM: L.
23              
24             =head1 SYNOPSIS
25              
26             use Graph;
27             use Graph::Writer::DSM;
28             my $graph = Graph->new();
29             my $writer = Graph::Writer::DSM->new(%OPTIONS);
30             $writer->write_graph($graph, "output.png");
31              
32             =head1 METHODS
33              
34             =head1 new()
35              
36             Like L, this module provide some extra parameters
37             to new() method.
38              
39             $writer = Graph::Writer::DSM->new(color => 'red');
40              
41             Supported parameters are:
42              
43             =over 4
44              
45             =item pointsize
46              
47             Default: 0.2.
48              
49             =item color
50              
51             Default: 'blue'.
52              
53             =item tics_label
54              
55             Default: false.
56              
57             =back
58              
59             =cut
60            
61             sub _init {
62 2     2   4682 my ($self, %param) = @_;
63 2         9 $self->SUPER::_init();
64 2   50     17 $self->{_dsm_point_size} = $param{pointsize} // 0.2;
65 2   50     8 $self->{_dsm_color} = $param{color} // 'blue';
66 2   50     8 $self->{_dsm_tics_label} = $param{tics_label} // undef;
67             }
68              
69             sub _move_file_to_filehandle {
70 1     1   15 my ($file, $FILEHANDLE) = @_;
71 1         84 open FILE, '<', $file;
72 1         22 local $/ = undef;
73 1         37 my $FILE = ;
74 1         9 close FILE;
75 1         19 print $FILEHANDLE $FILE;
76 1         26 unlink $file;
77             }
78              
79             =head1 write_graph()
80              
81             Write a specific graph to a named file:
82              
83             $writer->write_graph($graph, $file);
84              
85             The $file argument can either be a filename, or a filehandle for a previously
86             opened file.
87              
88             =cut
89              
90             sub _write_graph {
91 1     1   137 my ($self, $graph, $FILE) = @_;
92 1         5 my @vertices = uniq sort $graph->vertices;
93 1         69 my $output_temp = File::Temp::tempnam('/tmp', 'chart') . '.png';
94              
95 1 50       259 if ($self->{_dsm_tics_label}) {
96 0         0 my $i = -1;
97 0     0   0 my @y_labels = map { $i++; "'$_ $i' $i" } apply { s/.*\///; $_ } @vertices;
  0         0  
  0         0  
  0         0  
  0         0  
98 0         0 $self->{_dsm_ytics} = { labels => \@y_labels };
99 0         0 $self->{_dsm_x2tics} = [0 .. $#vertices];
100             }
101             else {
102 1         4 $self->{_dsm_ytics} = [0, $#vertices];
103 1         4 $self->{_dsm_x2tics} = [0, $#vertices];
104             }
105              
106             my $chart = Chart::Gnuplot->new(
107             x2range => [0, $#vertices],
108             xrange => [0, $#vertices],
109             yrange => [$#vertices, 0],
110             output => $output_temp,
111             bg => 'white',
112             xtics => undef,
113             x2tics => $self->{_dsm_x2tics},
114             ytics => $self->{_dsm_ytics},
115 1         11 size => 'ratio 1',
116             terminal => 'png',
117             );
118 1         402 my @points = ();
119 1         5 my @edges = $graph->edges;
120 1         78 foreach my $edge (@edges) {
121 2     2   18 my $col = first_index { $_ eq $edge->[0] } @vertices;
  2         8  
122 2     5   9 my $row = first_index { $_ eq $edge->[1] } @vertices;
  5         8  
123 2         6 push @points, [$row, $col];
124             }
125             my $dataSet = Chart::Gnuplot::DataSet->new(
126             points => \@points,
127             style => 'points',
128             color => $self->{_dsm_color},
129             pointtype => 5,
130             pointsize => $self->{_dsm_point_size},
131 1         10 );
132 1         282 $chart->plot2d($dataSet);
133 1         4484 _move_file_to_filehandle($output_temp, \*$FILE);
134 1         23 return 1;
135             }
136            
137             1;
138              
139             =head1 SEE ALSO
140              
141             L, L, L.
142              
143             =head1 COPYRIGHT
144              
145             Copyright (c) 2013, Joenio Costa