File Coverage

blib/lib/Chart/Composite.pm
Criterion Covered Total %
statement 515 624 82.5
branch 117 188 62.2
condition 7 21 33.3
subroutine 22 24 91.7
pod 0 2 0.0
total 661 859 76.9


line stmt bran cond sub pod time code
1             #====================================================================
2             # Chart::Composite
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             #
11             #---------------------------------------------------------------------
12             # History:
13             #----------
14             # $RCSfile: Composite.pm,v $ $Revision: 1.4 $ $Date: 2003/02/14 13:25:30 $
15             # $Author: dassing $
16             # $Log: Composite.pm,v $
17             # Revision 1.4 2003/02/14 13:25:30 dassing
18             # Circumvent division of zeros
19             #
20             #====================================================================
21              
22             package Chart::Composite;
23              
24 8     8   238 use Chart::Base 2.3;
  8         215  
  8         180  
25 8     8   162 use GD;
  8         77  
  8         147  
26 8     8   155 use Carp;
  8         152  
  8         139  
27 8     8   150 use strict;
  8         75  
  8         114  
28              
29             @Chart::Composite::ISA = qw(Chart::Base);
30             $Chart::Composite::VERSION = '2.3';
31              
32             #>>>>>>>>>>>>>>>>>>>>>>>>>>#
33             # public methods go here #
34             #<<<<<<<<<<<<<<<<<<<<<<<<<<#
35              
36             ## have to override set, so we can pass the options to the
37             ## sub-objects later
38             sub set {
39 21     21 0 563   my $self = shift;
40 21         8081   my %opts = @_;
41              
42             # basic error checking on the options, just warn 'em
43 21 50       288   unless ($#_ % 2) {
44 0         0     carp "Whoops, some option to be set didn't have a value.\n",
45                      "You might want to look at that.\n";
46               }
47              
48             # store the options they gave us
49 21 100       301   unless ($self->{'opts'}) {
50 8         92     $self->{'opts'} = {};
51               }
52              
53             # now set 'em
54 21         256   for (keys %opts) {
55 87         1600     $self->{$_} = $opts{$_};
56 87         2333     $self->{'opts'}{$_} = $opts{$_};
57               }
58              
59             # now return
60 21         452   return;
61             }
62              
63              
64             ## get the information to turn the chart into an imagemap
65             ## had to override it to reassemble the @data array correctly
66             sub imagemap_dump {
67 1     1 0 14   my $self = shift;
68 1         10   my ($i, $j);
69 1         11   my @map;
70 1         10   my $dataset_count = 0;
71              
72             # croak if they didn't ask me to remember the data, or if they're asking
73             # for the data before I generate it
74 1 50 33     29   unless (($self->{'imagemap'} =~ /^true$/i) && $self->{'imagemap_data'}) {
75 0         0     croak "You need to set the imagemap option to true, and then call the png method, before you can get the imagemap data";
76               }
77              
78             #make a copy of the imagemap data
79             #this is the data of the first component
80 1         134   for $i (1..$#{$self->{'sub_0'}->{'imagemap_data'}}) {
  1         25  
81 1         11     for $j (0..$#{$self->{'sub_0'}->{'imagemap_data'}->[$i]}-1) {
  1         18  
82 6         48        $map[$i][$j] = \@{$self->{'sub_0'}->{'imagemap_data'}->[$i][$j]} ;
  6         75  
83                 }
84 1         13     $dataset_count++;
85               }
86             #and add the data of the second component
87 1         10   for $i (1..$#{$self->{'sub_1'}->{'imagemap_data'}}) {
  1         14  
88 1         9     for $j (0..$#{$self->{'sub_1'}->{'imagemap_data'}->[$i]}-1) {
  1         13  
89 6         50       $map[$i+$dataset_count][$j] = \@{$self->{'sub_1'}->{'imagemap_data'}->[$i][$j]} ;
  6         68  
90                 }
91               }
92               
93              
94             # return their copy
95 1         17   return \@map;
96              
97             }
98              
99             sub __print_array {
100 0     0   0    my @a = @_;
101 0         0    my $i;
102                
103 0         0    my $li = $#a;
104                
105 0         0    $li++;
106 0         0    print STDERR "Anzahl der Elemente = $li\n"; $li--;
  0         0  
107                
108                for ($i=0; $i<=$li; $i++) {
109 0         0       print STDERR "\t$i\t$a[$i]\n";
110 0         0    }
111             }
112                
113             #>>>>>>>>>>>>>>>>>>>>>>>>>>>#
114             # private methods go here #
115             #<<<<<<<<<<<<<<<<<<<<<<<<<<<#
116              
117             ## make sure the data isn't really weird
118             ## and collect some basic info about it
119             sub _check_data {
120 8     8   83   my $self = shift;
121 8         78   my $length = 0;
122              
123             # first things first, make sure we got the composite_info
124 8 50 33     175   unless (($self->{'composite_info'}) && ($#{$self->{'composite_info'}} == 1)) {
  8         180  
125 0         0     croak "Chart::Composite needs to be told what kind of components to use";
126               }
127              
128             # make sure we don't end up dividing by zero if they ask for
129             # just one y_tick
130 8 50       115   if ($self->{'y_ticks'} == 1) {
131 0         0     $self->{'y_ticks'} = 2;
132 0         0     carp "The number of y_ticks displayed must be at least 2";
133               }
134              
135             # remember the number of datasets
136 8         75   $self->{'num_datasets'} = $#{$self->{'dataref'}};
  8         124  
137              
138             # remember the number of points in the largest dataset
139 8         84   $self->{'num_datapoints'} = 0;
140 8         91   for (0..$self->{'num_datasets'}) {
141 47 100       421     if (scalar(@{$self->{'dataref'}[$_]}) > $self->{'num_datapoints'}) {
  47         616  
142 8         108       $self->{'num_datapoints'} = scalar(@{$self->{'dataref'}[$_]});
  8         92  
143                 }
144               }
145              
146             # find the longest x-tick label, and remember how long it is
147 8         80   for (@{$self->{'dataref'}[0]}) {
  8         88  
148 60 100       2045     if (length ($_) > $length) {
149 10         142       $length = length ($_);
150                 }
151               }
152 8         91   $self->{'x_tick_label_length'} = $length;
153              
154             # now split the data into sub-objects
155 8         94   $self->_split_data;
156              
157 8         96   return;
158             }
159              
160              
161             ## create sub-objects for each type, store the appropriate
162             ## data sets in each one, and stick the correct values into
163             ## them (ie. 'gd_obj');
164             sub _split_data {
165 8     8   77   my $self = shift;
166 8         110   my @types = ($self->{'composite_info'}[0][0],$self->{'composite_info'}[1][0]);
167 8         76   my ($ref, $i, $j);
168              
169             ## Already checked for number of components in _check_data, above.
170             # # we can only do two at a time
171             # if ($self->{'composite_info'}[2]) {
172             # croak "Sorry, Chart::Composite can only do two chart types at a time";
173             # }
174              
175             # load the individual modules
176 8         406   require "Chart/".$types[0].".pm";
177 8         1288   require "Chart/".$types[1].".pm";
178              
179             # create the sub-objects
180 8         251   $self->{'sub_0'} = ("Chart::".$types[0])->new();
181 8         401   $self->{'sub_1'} = ("Chart::".$types[1])->new();
182              
183             # set the options (set the min_val, max_val, and y_ticks
184             # options intelligently so that the sub-objects don't get
185             # confused)
186 8         110   $self->{'sub_0'}->set (%{$self->{'opts'}});
  8         249  
187 8         97   $self->{'sub_1'}->set (%{$self->{'opts'}});
  8         228  
188 8 50       124   if (defined ($self->{'opts'}{'min_val1'})) {
189 0         0     $self->{'sub_0'}->set ('min_val' => $self->{'opts'}{'min_val1'});
190               }
191 8 100       106   if (defined ($self->{'opts'}{'max_val1'})) {
192 2         29     $self->{'sub_0'}->set ('max_val' => $self->{'opts'}{'max_val1'});
193               }
194 8 50       100   if (defined ($self->{'opts'}{'min_val2'})) {
195 0         0     $self->{'sub_1'}->set ('min_val' => $self->{'opts'}{'min_val2'});
196               }
197 8 100       158   if (defined ($self->{'opts'}{'max_val2'})) {
198 2         42     $self->{'sub_1'}->set ('max_val' => $self->{'opts'}{'max_val2'});
199               }
200 8 50       108   if ($self->{'opts'}{'y_ticks1'}) {
201 0         0     $self->{'sub_0'}->set ('y_ticks' => $self->{'opts'}{'y_ticks1'});
202               }
203 8 50       119   if ($self->{'opts'}{'y_ticks2'}) {
204 0         0     $self->{'sub_1'}->set ('y_ticks' => $self->{'opts'}{'y_ticks2'});
205               }
206             # f_y_tick for left and right axis
207 8 50       126   if (defined ($self->{'opts'}{'f_y_tick1'})) {
208 0         0     $self->{'sub_0'}->set ('f_y_tick' => $self->{'opts'}{'f_y_tick1'});
209               }
210 8 50       114   if (defined ($self->{'opts'}{'f_y_tick2'})) {
211 0         0     $self->{'sub_1'}->set ('f_y_tick' => $self->{'opts'}{'f_y_tick2'});
212               }
213              
214             # replace the gd_obj fields
215 8         93   $self->{'sub_0'}->{'gd_obj'} = $self->{'gd_obj'};
216 8         1270   $self->{'sub_1'}->{'gd_obj'} = $self->{'gd_obj'};
217              
218             # let the sub-objects know they're sub-objects
219 8         650   $self->{'sub_0'}->{'component'} = 'true';
220 8         93   $self->{'sub_1'}->{'component'} = 'true';
221              
222             # give each sub-object its data
223 8         115   $self->{'component_datasets'} = [];
224 8         95   for $i (0..1) {
225 16         147     $ref = [];
226 16         1043     $self->{'component_datasets'}[$i] = $self->{'composite_info'}[$i][1];
227 16         140     push @{$ref}, $self->{'dataref'}[0];
  16         179  
228 16         146     for $j (@{$self->{'composite_info'}[$i][1]}) {
  16         171  
229 39         571       $self->_color_role_to_index('dataset'.($j-1)); # allocate color index
230 39         347       push @{$ref}, $self->{'dataref'}[$j];
  39         468  
231                 }
232 16         387     $self->{'sub_'.$i}->_copy_data ($ref);
233               }
234              
235             # and let them check it
236 8         380   $self->{'sub_0'}->_check_data;
237 8         175   $self->{'sub_1'}->_check_data;
238              
239             # realign the y-axes if they want
240 8 100       115   if ($self->{'same_y_axes'} =~ /^true$/i) {
241 3 50       41     if ($self->{'sub_0'}{'min_val'} < $self->{'sub_1'}{'min_val'}) {
242 0         0       $self->{'sub_1'}{'min_val'} = $self->{'sub_0'}{'min_val'};
243                 }
244                 else {
245 3         35       $self->{'sub_0'}{'min_val'} = $self->{'sub_1'}{'min_val'};
246                 }
247              
248 3 50       40     if ($self->{'sub_0'}{'max_val'} > $self->{'sub_1'}{'max_val'}) {
249 0         0       $self->{'sub_1'}{'max_val'} = $self->{'sub_0'}{'max_val'};
250                 }
251                 else {
252 3         34       $self->{'sub_0'}{'max_val'} = $self->{'sub_1'}{'max_val'};
253                 }
254              
255 3         43     $self->{'sub_0'}->_check_data;
256 3         45     $self->{'sub_1'}->_check_data;
257               }
258            
259             # find out how big the y-tick labels will be from sub_0 and sub_1
260 8         101   $self->{'y_tick_label_length1'} = $self->{'sub_0'}->{'y_tick_label_length'};
261 8         98   $self->{'y_tick_label_length2'} = $self->{'sub_1'}->{'y_tick_label_length'};
262              
263             # now return
264 8         141   return;
265             }
266              
267             sub _draw_legend {
268 8     8   78   my $self = shift;
269 8         73   my ($length);
270              
271             # check to see if they have as many labels as datasets,
272             # warn them if not
273 8 50 66     74   if (($#{$self->{'legend_labels'}} >= 0) &&
  8         136  
  4         63  
274                    ((scalar(@{$self->{'legend_labels'}})) != $self->{'num_datasets'})) {
275 0         0     carp "The number of legend labels and datasets doesn\'t match";
276               }
277              
278             # init a field to store the length of the longest legend label
279 8 50       102   unless ($self->{'max_legend_label'}) {
280 8         116     $self->{'max_legend_label'} = 0;
281               }
282              
283             # fill in the legend labels, find the longest one
284 8         87   for (1..$self->{'num_datasets'}) {
285 39 100       472     unless ($self->{'legend_labels'}[$_-1]) {
286 15         175       $self->{'legend_labels'}[$_-1] = "Dataset $_";
287                 }
288 39         429     $length = length($self->{'legend_labels'}[$_-1]);
289 39 100       419     if ($length > $self->{'max_legend_label'}) {
290 12         118       $self->{'max_legend_label'} = $length;
291                 }
292               }
293              
294             # different legend types
295 8 100       139   if ($self->{'legend'} eq 'bottom') {
    100          
    100          
    50          
    0          
296 3         35     $self->_draw_bottom_legend;
297               }
298               elsif ($self->{'legend'} eq 'right') {
299 2         28     $self->_draw_right_legend;
300               }
301               elsif ($self->{'legend'}