File Coverage

blib/lib/SVG/TT/Graph.pm
Criterion Covered Total %
statement 124 161 77.0
branch 34 60 56.6
condition 7 15 46.6
subroutine 18 21 85.7
pod 6 7 85.7
total 189 264 71.5


line stmt bran cond sub pod time code
1             package SVG::TT::Graph;
2              
3 3     3   300146 use strict;
  3         19  
  3         82  
4 3     3   14 use Carp;
  3         6  
  3         147  
5 3     3   1503 use Template;
  3         64866  
  3         91  
6 3     3   20 use POSIX;
  3         5  
  3         27  
7             require 5.6.1;
8              
9             our $VERSION = '0.26';
10             our $AUTOLOAD;
11             our $TEMPLATE_FH;
12              
13             =head1 NAME
14              
15             SVG::TT::Graph - Base module for generating SVG graphics
16              
17             =head1 SYNOPSIS
18              
19             package SVG::TT::Graph::GRAPH_TYPE;
20             use SVG::TT::Graph;
21             use base qw(SVG::TT::Graph);
22             our $VERSION = $SVG::TT::Graph::VERSION;
23             our $TEMPLATE_FH = \*DATA;
24              
25             sub _set_defaults {
26             my $self = shift;
27              
28             my %default = (
29             'keys' => 'value',
30             );
31             while( my ($key,$value) = each %default ) {
32             $self->{config}->{$key} = $value;
33             }
34             }
35              
36              
37             # optional - called when object is created
38             sub _init {
39             my $self = shift;
40             # any testing you want to do.
41              
42             }
43              
44             ...
45              
46             1;
47             __DATA__
48             <!-- SVG Template goes here -->
49              
50              
51             In your script:
52              
53             use SVG::TT::Graph::GRAPH_TYPE;
54              
55             my $width = '500',
56             my $heigh = '300',
57             my @fields = qw(field_1 field_2 field_3);
58              
59             my $graph = SVG::TT::Graph::GRAPH_TYPE->new({
60             # Required for some graph types
61             'fields' => \@fields,
62             # .. other config options
63             'height' => '500',
64             });
65              
66             my @data = qw(23 56 32);
67             $graph->add_data({
68             'data' => \@data,
69             'title' => 'Sales 2002',
70             });
71              
72             # find a config options value
73             my $config_value = $graph->config_option();
74             # set a config option value
75             $graph->config_option($config_value);
76              
77             # All graphs support SVGZ (compressed SVG) if
78             # Compress::Zlib is available. Use either the
79             # 'compress' => 1 config option, or:
80             $graph->compress(1);
81              
82             # All graph SVGs can be tidied if XML::Tidy
83             # is installed. Use either the 'tidy' => 1
84             # config option, or:
85             $graph->tidy(1);
86              
87             print "Content-type: image/svg+xml\n\n";
88             print $graph->burn();
89              
90             =head1 DESCRIPTION
91              
92             This package is a base module for creating graphs in Scalable Vector Format
93             (SVG). Do not use this module directly. Instead, use one of the following
94             modules to create the plot of your choice:
95              
96             =over
97              
98             =item L<SVG::TT::Graph::Line>
99              
100             =item L<SVG::TT::Graph::Bar>
101              
102             =item L<SVG::TT::Graph::BarHorizontal>
103              
104             =item L<SVG::TT::Graph::BarLine>
105              
106             =item L<SVG::TT::Graph::Pie>
107              
108             =item L<SVG::TT::Graph::TimeSeries>
109              
110             =item L<SVG::TT::Graph::XY>
111              
112             =back
113              
114             If XML::Tidy is installed, the SVG files generated can be tidied. If
115             Compress::Zlib is available, the SVG files can also be compressed to SVGZ.
116              
117             =cut
118              
119             sub new {
120 21     21 0 10308 my ($proto,$conf) = @_;
121 21   33     102 my $class = ref($proto) || $proto;
122 21         37 my $self = {};
123              
124 21         45 bless($self, $class);
125              
126 21 50       143 if($self->can('_set_defaults')) {
127             # Populate with local defaults
128 21         82 $self->_set_defaults();
129             } else {
130 0         0 croak "$class should have a _set_defaults method";
131             }
132              
133             # overwrite defaults with user options
134 21         42 while( my ($key,$value) = each %{$conf} ) {
  35         112  
135 14         38 $self->{config}->{$key} = $value;
136             }
137              
138             # Allow the inheriting modules to do checks
139 21 50       81 if($self->can('_init')) {
140 21         72 $self->_init();
141             }
142              
143 16         42 return $self;
144             }
145              
146             =head1 METHODS
147              
148             =head2 add_data()
149              
150             my @data_sales_02 = qw(12 45 21);
151              
152             $graph->add_data({
153             'data' => \@data_sales_02,
154             'title' => 'Sales 2002',
155             });
156              
157             This method allows you do add data to the graph object.
158             It can be called several times to add more data sets in.
159              
160             =cut
161              
162             sub add_data {
163 10     10 1 10516 my ($self, $conf) = @_;
164             # create an array
165 10 100       38 unless(defined $self->{'data'}) {
166 5         10 my @data;
167 5         17 $self->{'data'} = \@data;
168             }
169              
170             croak 'no fields array ref'
171             unless defined $self->{'config'}->{'fields'}
172 10 50 33     67 && ref($self->{'config'}->{'fields'}) eq 'ARRAY';
173              
174 10 50 33     50 if(defined $conf->{'data'} && ref($conf->{'data'}) eq 'ARRAY') {
175 10         12 my %new_data;
176 10         14 @new_data{ map { s/&/&amp;/; $_ } @{$self->{'config'}->{'fields'}}} = @{$conf->{'data'}};
  30         47  
  30         63  
  10         28  
  10         40  
177 10         30 my %store = (
178             'data' => \%new_data,
179             );
180 10 50       35 $store{'title'} = $conf->{'title'} if defined $conf->{'title'};
181 10         11 push (@{$self->{'data'}},\%store);
  10         27  
182 10         25 return 1;
183             }
184 0         0 return undef;
185             }
186              
187             =head2 clear_data()
188              
189             my $graph->clear_data();
190              
191             This method removes all data from the object so that you can
192             reuse it to create a new graph but with the same config options.
193              
194             =cut
195              
196             sub clear_data {
197 7     7 1 4222 my $self = shift;
198 7         18 my @data;
199 7         50 $self->{'data'} = \@data;
200             }
201              
202              
203             =head2 get_template()
204              
205             print $graph->get_template();
206              
207             This method returns the TT template used for making the graph.
208              
209             =cut
210              
211             sub get_template {
212 21     21 1 2331 my $self = shift;
213              
214             # Template filehandle
215 21         100 my $template_fh_sr = $self->_get_template_fh_sr();
216 21 50       55 croak ref($self) . ' must have a template' if not $template_fh_sr;
217              
218 21         30 my $template_fh = $$template_fh_sr;
219              
220             # Read in TT template
221 21         57 my $start = tell $template_fh;
222 21         32 my $template = '';
223 21         160 while(<$template_fh>) {
224 10746         10197 chomp;
225 10746         17850 $template .= $_ . "\n";
226             }
227              
228             # This method may be used again, so return to start of filehandle
229 21         161 seek $template_fh, $start, 0;
230              
231 21         314 return $template;
232             }
233              
234             sub _get_template_fh_sr {
235 21     21   44 my ($self) = @_;
236              
237 21         42 my $ns_ref = \%main::;
238 21         93 for my $node ( split m<::>, ref $self ) {
239 84         238 $ns_ref = $ns_ref->{"${node}::"};
240             }
241              
242 21         46 return *{$ns_ref->{'TEMPLATE_FH'}}{'SCALAR'};
  21         97  
243             }
244              
245             =head2 burn()
246              
247             print $graph->burn();
248              
249             This method processes the template with the data and
250             config which has been set and returns the resulting SVG.
251              
252             This method will croak unless at least one data set has
253             been added to the graph object.
254              
255             =cut
256              
257             sub burn {
258 14     14 1 12524 my $self = shift;
259              
260             # Check we have at least one data value
261             croak "No data available"
262 14 50       26 unless scalar(@{$self->{'data'}}) > 0;
  14         120  
263              
264             # perform any calculations prior to burn
265 7 100       76 $self->calculations() if $self->can('calculations');
266              
267 7         44 my $template = $self->get_template();
268             my %vals = (
269             'data' => $self->{'data'}, # the data
270             'config' => $self->{'config'}, # the configuration
271 7         82 'calc' => $self->{'calc'}, # the calculated values
272             'sin' => \&_sin_it,
273             'cos' => \&_cos_it,
274             'predefined_color' => \&_predefined_color,
275             'random_color' => \&_random_color,
276             );
277              
278             # euu - hack!! - maybe should just be a method
279 7         23 $self->{sin} = \&_sin_it;
280 7         22 $self->{cos} = \&_cos_it;
281              
282             # set up TT object
283 7         27 my %config = (
284             POST_CHOMP => 1,
285             INCLUDE_PATH => '/',
286             #STRICT => 1, # we should probably enable this for strict checking
287             #DEBUG => 'undef', # TT warnings on, useful for debugging, finding undef values
288             );
289 7         53 my $tt = Template->new( \%config );
290 7         26755 my $file;
291              
292 7         31 my $template_response = $tt->process( \$template, \%vals, \$file );
293 7 50       17838 if($tt->error()) {
294 0 0       0 croak "Template error: " . $tt->error . "\n" if $tt->error;
295             }
296              
297             # tidy SVG if required
298 7 50       200 if ($self->tidy()) {
299 0 0       0 if (eval "require XML::Tidy") {
300             # remove the doctype tag temporarily because it seems to cause trouble
301 0         0 $file =~ s/(<!doctype svg .+?>)//si;
302 0         0 my $doctype = $1;
303             # tidy
304 0         0 my $tidy_obj = XML::Tidy->new( 'xml' => $file );
305 0         0 $tidy_obj->tidy();
306 0         0 $file = $tidy_obj->toString();
307             # re-add the doctype
308 0 0       0 if (defined $doctype) {
309 0         0 $file =~ s/(<\?xml.+?\?>)/$1\n$doctype/si;
310             }
311             # even more tidy
312 0         0 $file = $self->_tidy_more($file);
313             } else {
314 0         0 croak "Error tidying the SVG file: XML::Tidy does not seem to be installed properly";
315             }
316             }
317              
318             # compress SVG if required
319 7 50       47 if ($self->compress()) {
320 0 0       0 if (eval "require Compress::Zlib") {
321 0         0 $file = Compress::Zlib::memGzip($file);
322             } else {
323 0         0 croak "Error compressing the SVG file: Compress::Zlib does not seem to be installed properly";
324             }
325             }
326              
327 7         70 return $file;
328             }
329              
330              
331              
332             sub _sin_it {
333 12     12   1066 return sin(shift);
334             }
335              
336              
337             sub _cos_it {
338 12     12   4925 return cos(shift);
339             }
340              
341              
342             =head2 compress()
343              
344             $graph->compress(1);
345              
346             If Compress::Zlib is installed, the content of the SVG file can be compressed.
347             This get/set method controls whether or not to compress. The default is 0 (off).
348              
349             =cut
350              
351             sub compress {
352 28     28 1 68 my ($self, $val) = @_;
353             # set the default compress value
354 28 100       79 if (not defined $self->{config}->{compress}) {
355 14         44 $self->{config}->{compress} = 0;
356             }
357             # set the user-defined compress value
358 28 100       60 if (defined $val) {
359 14         22 $self->{config}->{compress} = $val;
360             }
361             # get the compress value
362 28         86 return $self->{config}->{compress};
363             }
364              
365              
366             =head2 tidy()
367              
368             $graph->tidy(1);
369              
370             If XML::Tidy is installed, the content of the SVG file can be formatted in a
371             prettier way. This get/set method controls whether or not to tidy. The default
372             is 0 (off). The limitations of tidy are described at this URL:
373             L<http://search.cpan.org/~pip/XML-Tidy-1.12.B55J2qn/Tidy.pm#tidy%28%29>
374              
375             =cut
376              
377             sub tidy {
378 28     28 1 66 my ($self, $val) = @_;
379             # set the default tidy value
380 28 100       87 if (not defined $self->{config}->{tidy}) {
381 14         40 $self->{config}->{tidy} = 0;
382             }
383             # set the user-defined tidy value
384 28 100       59 if (defined $val) {
385 14         23 $self->{config}->{tidy} = $val;
386             }
387             # get the tidy value
388 28         79 return $self->{config}->{tidy};
389             }
390              
391              
392             sub _tidy_more {
393             # Remove extra spaces in the SVG <path> tag
394 0     0   0 my ($self, $svg_string) = @_;
395 0         0 while ($svg_string =~ s/(<path .*? )\s+(.*?"\s*?\/>)/$1$2/mgi) {};
396 0         0 return $svg_string;
397             }
398              
399              
400             sub _random_color {
401             # Generate the rgb code for a randomly selected color
402 0     0   0 my $rgb = 'rgb('.int(rand(256)).','.int(rand(256)).','.int(rand(256)).')';
403 0         0 return $rgb;
404             }
405              
406              
407             sub _predefined_color {
408             # Get the hexadecimal code for one of 12 predefined colors
409 15     15   2404087 my ($num) = shift;
410 15         76 my @colors = ("#ff0000", "#0000ff", "#00ff00", "#ffcc00", "#00ccff",
411             "#ff00ff", "#00ffff", "#ffff00", "#cc6666", "#663399", "#339900", "#9966FF");
412 15         20 my $hex;
413 15 50       53 if ($num-1 < scalar @colors) {
414 15         31 $hex = $colors[$num-1];
415             }
416 15         118 return $hex;
417             }
418              
419             # Calculate a scaling range and divisions to be aesthetically pleasing
420             # Parameters:
421             # value range
422             # Returns
423             # (revised range, division size, division precision)
424             sub _range_calc () {
425 2     2   6 my ($self, $range) = @_;
426              
427 2         3 my ($max,$division);
428 2         4 my $count = 0;
429 2         4 my $value = $range;
430              
431 2 50       5 if ($value == 0) {
432             # Can't do much really
433 0         0 $division = 0.2;
434 0         0 $max = 1;
435 0         0 return ($max,$division,1);
436             }
437              
438 2 50 33     10 if (($value < 1) and ($value > 0)) {
439 0         0 while ($value < 1) {
440 0         0 $value *= 10;
441 0         0 $count++;
442             }
443 0         0 $division = 1;
444 0         0 while ($count--) {
445 0         0 $division /= 10;
446             }
447 0         0 $max = ceil($range / $division) * $division;
448             }
449             else {
450 2         5 while ($value > 10) {
451 2         5 $value /= 10;
452 2         6 $count++;
453             }
454 2         3 $division = 1;
455 2         7 while ($count--) {
456 2         4 $division *= 10;
457             }
458 2         14 $max = ceil($range / $division) * $division;
459             }
460              
461 2 50       11 if (int($max / $division) <= 2) {
    50          
462 0         0 $division /= 5;
463 0         0 $max = ceil($range / $division) * $division;
464             }
465             elsif (int($max / $division) <= 5) {
466 0         0 $division /= 2;
467 0         0 $max = ceil($range / $division) * $division;
468             }
469              
470 2 50       7 if ($division >= 1) {
471 2         4 $count = 0;
472             }
473             else {
474 0         0 $count = length($division) - 2;
475             }
476              
477 2         9 return ($max,$division,$count);
478             }
479              
480              
481             # Returns true if config value exists, is defined and not ''
482             sub _is_valid_config() {
483 16     16   34 my ($self,$name) = @_;
484 16   100     126 return ((exists $self->{config}->{$name}) && (defined $self->{config}->{$name}) && ($self->{config}->{$name} ne ''));
485             }
486              
487              
488             =head2 config methods
489              
490             my $value = $graph->method();
491             $graph->method($value);
492              
493             This object provides autoload methods for all config
494             options defined in the _set_default method within the
495             inheriting object.
496              
497             See the SVG::TT::Graph::GRAPH_TYPE documentation for a list.
498              
499             =cut
500              
501             ## AUTOLOAD FOR CONFIG editing
502              
503             sub AUTOLOAD {
504 34     34   5027 my $name = $AUTOLOAD;
505 34         205 $name =~ s/.*://;
506              
507 34 50       86 croak "No object supplied" unless $_[0];
508 34 100       87 if(defined $_[0]->{'config'}->{$name}) {
509 26 100       48 if(defined $_[1]) {
510             # set the value
511 6         11 $_[0]->{'config'}->{$name} = $_[1];
512             }
513 26 50       153 return $_[0]->{'config'}->{$name} if defined $_[0]->{'config'}->{$name};
514 0         0 return undef;
515             } else {
516 8         717 croak "Method: $name can not be used with " . ref($_[0]);
517             }
518             }
519              
520              
521             # As we have AUTOLOAD we need this
522       0     sub DESTROY {
523             }
524              
525              
526             1;
527             __END__
528              
529             =head1 EXAMPLES
530              
531             For examples look at the project home page http://leo.cuckoo.org/projects/SVG-TT-Graph/
532              
533             =head1 EXPORT
534              
535             None by default.
536              
537             =head1 ACKNOWLEDGEMENTS
538              
539             Thanks to Foxtons for letting us put this on CPAN, Todd Caine for heads up on
540             reparsing the template (but not using atm), David Meibusch for TimeSeries and a
541             load of other ideas, Stephen Morgan for creating the TT template and SVG, and
542             thanks for all the patches by Andrew Ruthven and others.
543              
544             =head1 AUTHOR
545              
546             Leo Lapworth <LLAP@cuckoo.org>
547              
548             =head1 MAINTAINER
549              
550             Florent Angly <florent.angly@gmail.com>
551              
552             =head1 COPYRIGHT AND LICENSE
553              
554             Copyright (C) 2003, Leo Lapworth
555              
556             This module is free software; you can redistribute it or
557             modify it under the same terms as Perl itself.
558              
559             =head1 SEE ALSO
560              
561             L<SVG::TT::Graph::Line>,
562             L<SVG::TT::Graph::Bar>,
563             L<SVG::TT::Graph::BarHorizontal>,
564             L<SVG::TT::Graph::BarLine>,
565             L<SVG::TT::Graph::Pie>,
566             L<SVG::TT::Graph::TimeSeries>,
567             L<SVG::TT::Graph::XY>,
568             L<Compress::Zlib>,
569             L<XML::Tidy>
570              
571             =cut