File Coverage

blib/lib/Chart/Base.pm
Criterion Covered Total %
statement 975 1269 76.8
branch 277 454 61.0
condition 83 129 64.3
subroutine 47 58 81.0
pod 0 15 0.0
total 1382 1925 71.8


line stmt bran cond sub pod time code
1             #===================================================================
2             # Chart::Base
3             #
4             # written by david bonner
5             # dbonner@cs.bu.edu
6             #
7             # maintained by the Chart Group
8             # Chart@wettzell.ifag.de
9             #---------------------------------------------------------------------
10             # History:
11             # --------
12             # $RCSfile: Base.pm,v $ $Revision: 1.8 $ $Date: 2003/04/08 16:03:41 $
13             # $Author: dassing $
14             # $Log: Base.pm,v $
15             # Revision 1.8 2003/04/08 16:03:41 dassing
16             # _draw_y_grid_lines does plot all lines now
17             #
18             # Revision 1.7 2003/03/20 15:01:11 dassing
19             # Some print statements did not go to STDERR
20             #
21             # Revision 1.6 2003/01/14 13:38:37 dassing
22             # Big changes for Version 2.0
23             #
24             # Revision 1.5 2002/06/19 12:36:58 dassing
25             # Correcting some undefines
26             #
27             # Revision 1.4 2002/06/06 07:38:25 dassing
28             # Updates in Function _find_y_scale by David Pottage
29             #
30             # Revision 1.3 2002/05/31 13:18:02 dassing
31             # Release 1.1
32             #
33             # Revision 1.2 2002/05/29 16:13:20 dassing
34             # Changes included by David Pottage
35             #
36             #=======================================================================
37              
38             package Chart::Base;
39              
40 58     58   2456 use GD;
  58         617  
  58         3380  
41 58     58   1389 use strict;
  58         602  
  58         1008  
42 58     58   1171 use Carp;
  58         546  
  58         2040  
43 58     58   937 use FileHandle;
  58         2124  
  58         1140  
44              
45             $Chart::Base::VERSION = '2.3';
46              
47 58     58   3088 use vars qw(%named_colors);
  58         538  
  58         950  
48              
49              
50             #>>>>>>>>>>>>>>>>>>>>>>>>>>#
51             # public methods go here #
52             #<<<<<<<<<<<<<<<<<<<<<<<<<<#
53              
54             ## standard nice object creator
55             sub new {
56 76     76 0 322015   my $proto = shift;
57 76   33     1411   my $class = ref($proto) || $proto;
58 76         17818   my $self = {};
59              
60 76         2138   bless $self, $class;
61 76         1401   $self->_init(@_);
62              
63 76         1033   return $self;
64             }
65              
66              
67             ## main method for customizing the chart, lets users
68             ## specify values for different parameters
69             sub set {
70 185     185 0 2510   my $self = shift;
71 185         6090   my %opts = @_;
72               
73             # basic error checking on the options, just warn 'em
74 185 50       2306   unless ($#_ % 2) {
75 0         0     carp "Whoops, some option to be set didn't have a value.\n",
76                      "You might want to look at that.\n";
77               }
78              
79               
80             # set the options
81 185         2225   for (keys %opts) {
82              
83 656         6800     $self->{$_} = $opts{$_};
84                 
85             # if someone wants to change the grid_lines color, we should set all
86             # the colors of the grid_lines
87 656 100       8088     if ($_ =~ /^colors$/ ) {
88 38         345       my %hash = %{$opts{$_}};
  38         628  
89 38         2307       foreach my $key (sort keys %hash){
90 159 100       1757           if ($key =~ /^grid_lines$/) {
91 2         23             $self->{'colors'}{'y_grid_lines'} = $hash{'grid_lines'};
92 2         20             $self->{'colors'}{'x_grid_lines'} = $hash{'grid_lines'};
93 2         22             $self->{'colors'}{'y2_grid_lines'} = $hash{'grid_lines'};
94                      }
95                   }
96                 }
97               }
98              
99             # now return
100 185         2295   return 1;
101             }
102              
103              
104             ## Graph API
105             sub add_pt {
106 0     0 0 0   my $self = shift;
107 0         0   my @data = @_;
108              
109             # error check the data (carp, don't croak)
110 0 0 0     0   if ($self->{'dataref'} && ($#{$self->{'dataref'}} != $#data)) {
  0         0  
111 0         0     carp "New point to be added has an incorrect number of data sets";
112 0         0     return 0;
113               }
114              
115             # copy it into the dataref
116 0         0   for (0..$#data) {
117 0         0     push @{$self->{'dataref'}->[$_]}, $data[$_];
  0         0  
118               }
119               
120             # now return
121 0         0   return 1;
122             }
123              
124              
125             ## more Graph API
126             sub add_dataset {
127 216     216 0 15368   my $self = shift;
128 216         15958   my @data = @_;
129              
130             # error check the data (carp, don't croak)
131 216 50 66     3896   if ($self->{'dataref'} && ($#{$self->{'dataref'}->[0]} != $#data)) {
  160         6853  
132 0         0     carp "New data set to be added has an incorrect number of points";
133               }
134              
135             # copy it into the dataref
136 216         2210   push @{$self->{'dataref'}}, [ @data ];
  216         26799  
137               
138             # now return
139 216         6112   return 1;
140             }
141              
142             # it's also possible to add a complete datafile
143             sub add_datafile {
144 0     0 0 0    my $self = shift;
145 0         0    my $filename = shift;
146 0         0    my $format = shift;
147 0         0    my ($File, @array);
148                
149             # do some ugly checking to see if they gave me
150             # a filehandle or a file name
151 0 0       0    if ((ref \$filename) eq 'SCALAR') {
    0          
152             # they gave me a file name
153 0 0       0     open ($File, $filename) or croak "Can't open the datafile: $filename.\n";
154                }
155                elsif ((ref \$filename) =~ /^(?:REF|GLOB)$/) {
156             # either a FileHandle object or a regular file handle
157 0         0     $File = $filename;
158                }
159                else {
160 0         0     carp "I'm not sure what kind of datafile you gave me,\n",
161                       "but it wasn't a filename or a filehandle.\n";
162                }
163              
164             #add the data
165 0         0    while(<$File>) {
166 0         0       @array = split;
167 0 0       0       if ( @array != ( )) {
168 0 0       0         if ($format =~ m/^pt$/i) {
    0          
169 0         0           $self->add_pt(@array);
170                     }
171                     elsif ($format =~ m/^set$/i) {
172 0         0           $self->add_dataset(@array);
173                     }
174                     else {
175 0         0           carp "Tell me what kind of file you gave me: 'pt' or 'set'\n";
176                     }
177                   }
178                }
179 0         0    close ($File);
180             }
181              
182             ## even more Graph API
183             sub clear_data {
184 0     0 0 0   my $self = shift;
185              
186             # undef the internal data reference
187 0         0   $self->{'dataref'} = undef;
188              
189             # now return
190 0         0   return 1;
191             }
192              
193              
194             ## and the last of the Graph API
195             sub get_data {
196 0     0 0 0   my $self = shift;
197 0         0   my $ref = [];
198 0         0   my ($i, $j);
199              
200             # give them a copy, not a reference into the object
201 0         0   for $i (0..$#{$self->{'dataref'}}) {
  0         0  
202 0         0     @{ $ref->[$i] } = @{ $self->{'dataref'}->[$i] }
  0         0  
  0         0  
203             ## speedup, compared to...
204             # for $j (0..$#{$self->{'dataref'}->[$i]}) {
205             # $ref->[$i][$j] = $self->{'dataref'}->[$i][$j];
206             # }
207               }
208              
209             # return it
210 0         0   return $ref;
211             }
212              
213              
214             ## called after the options are set, this method
215             ## invokes all my private methods to actually
216             ## draw the chart and plot the data
217             sub png {
218 60     60 0 876   my $self = shift;
219 60         793   my $file = shift;
220 60         2441   my $dataref = shift;
221 60         644   my $fh;
222              
223             # do some ugly checking to see if they gave me
224             # a filehandle or a file name
225 60 100       996   if ((ref \$file) eq 'SCALAR') {
    50          
226             # they gave me a file name
227             # Try to delete an existing file
228 58 50       2563     if ( -f $file ) {
229 58         14123        my $number_deleted_files = unlink $file;
230 58 50       5196        if ( $number_deleted_files != 1 ) {
231 0         0           croak "Error: File \"$file\" did already exist, but it fails to delete it";
232                    }
233                 }
234 58         1465     $fh = FileHandle->new (">$file");
235 58 50       22661     if( !defined $fh) {
236 0         0        croak "Error: File \"$file\" could not be created!\n";
237                 }
238               }
239               elsif ((ref \$file) =~ /^(?:REF|GLOB)$/) {
240             # either a FileHandle object or a regular file handle
241 2         19     $fh = $file;
242               }
243               else {
244 0         0     croak "I'm not sure what you gave me to write this png to,\n",
245                       "but it wasn't a filename or a filehandle.\n";
246               }
247              
248             # allocate the background color
249 60         1303   $self->_set_colors();
250              
251             # make sure the object has its copy of the data
252 60         1114   $self->_copy_data($dataref);
253              
254             # do a sanity check on the data, and collect some basic facts
255             # about the data
256 60         1462   $self->_check_data();
257              
258             # pass off the real work to the appropriate subs
259 60         1445   $self->_draw();
260              
261             # now write it to the file handle, and don't forget
262             # to be nice to the poor ppl using nt
263 60         888   binmode $fh;
264              
265 60         751245   print $fh $self->{'gd_obj'}->png();
266               
267             # now exit
268 60         995   return 1;
269             }
270              
271              
272             ## called after the options are set, this method
273             ## invokes all my private methods to actually
274             ## draw the chart and plot the data
275             sub cgi_png {
276 0     0 0 0   my $self = shift;
277 0         0   my $dataref = shift;
278              
279             # allocate the background color
280 0         0   $self->_set_colors();
281              
282             # make sure the object has its copy of the data
283 0         0   $self->_copy_data($dataref);
284              
285             # do a sanity check on the data, and collect some basic facts
286             # about the data
287 0         0   $self->_check_data();
288              
289             # pass off the real work to the appropriate subs
290 0         0   $self->_draw();
291              
292             # print the header (ripped the crlf octal from the CGI module)
293 0 0       0   if ($self->{no_cache} =~ /^true$/i) {
294 0         0       print "Content-type: image/png\015\012Pragma: no-cache\015\012\015\012";
295               } else {
296 0         0       print "Content-type: image/png\015\012\015\012";
297               }
298              
299             # now print the png, and binmode it first so nt likes us
300 0         0   binmode STDOUT;
301 0         0   print STDOUT $self->{'gd_obj'}->png();
302              
303             # now exit
304 0         0   return 1;
305             }
306              
307             ## called after the options are set, this method
308             ## invokes all my private methods to actually
309             ## draw the chart and plot the data
310             sub scalar_png {
311 0     0 0 0   my $self = shift;
312 0         0   my $dataref = shift;
313              
314             # make sure the object has its copy of the data
315 0         0   $self->_copy_data($dataref);
316              
317             # do a sanity check on the data, and collect some basic facts
318             # about the data
319 0         0   $self->_check_data();
320              
321             # pass off the real work to the appropriate subs
322 0         0   $self->_draw();
323              
324             # returns the png image as a scalar value, so that
325             # the programmer-user can do whatever the heck
326             # s/he wants to with it
327 0         0   $self->{'gd_obj'}->png();
328             }
329              
330              
331             ## called after the options are set, this method
332             ## invokes all my private methods to actually
333             ## draw the chart and plot the data
334             sub jpeg {
335 0     0 0 0   my $self = shift;
336 0         0   my $file = shift;
337 0         0   my $dataref = shift;
338 0         0   my $fh;
339              
340             # do some ugly checking to see if they gave me
341             # a filehandle or a file name
342 0 0       0   if ((ref \$file) eq 'SCALAR') {
    0          
343             # they gave me a file name
344 0         0     $fh = FileHandle->new (">$file");
345             # they gave me a file name
346             # Try to delete an existing file
347 0 0       0     if ( -f $file ) {
348 0         0        my $number_deleted_files = unlink $file;
349 0 0       0        if ( $number_deleted_files != 1 ) {
350 0         0           croak "Error: File \"$file\" did already exist, but it fails to delete it";
351                    }
352                 }
353 0         0     $fh = FileHandle->new (">$file");
354 0 0       0     if( !defined $fh) {
355 0         0        croak "Error: File \"$file\" could not be created!\n";
356                 }
357               }
358               elsif ((ref \$file) =~ /^(?:REF|GLOB)$/) {
359             # either a FileHandle object or a regular file handle
360 0         0     $fh = $file;
361               }
362               else {
363 0         0     croak "I'm not sure what you gave me to write this jpeg to,\n",
364                       "but it wasn't a filename or a filehandle.\n";
365               }
366              
367             # allocate the background color
368 0         0   $self->_set_colors();
369              
370             # make sure the object has its copy of the data
371 0         0   $self->_copy_data($dataref);