line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
=head1 NAME |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
App::Basis::ConvertText2::Plugin::Chart |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 SYNOPSIS |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
my $content = "apples,bananas,cake,cabbage,edam,fromage,tomatoes,chips |
9
|
|
|
|
|
|
|
1,2,3,5,11,22,33,55 |
10
|
|
|
|
|
|
|
1,2,3,5,11,22,33,55 |
11
|
|
|
|
|
|
|
1,2,3,5,11,22,33,55 |
12
|
|
|
|
|
|
|
1,2,3,5,11,22,33,55 |
13
|
|
|
|
|
|
|
" ; |
14
|
|
|
|
|
|
|
my $params = { |
15
|
|
|
|
|
|
|
size => "600x480", |
16
|
|
|
|
|
|
|
title => "chart1", |
17
|
|
|
|
|
|
|
xaxis => 'things xways', |
18
|
|
|
|
|
|
|
yaxis => 'Vertical things', |
19
|
|
|
|
|
|
|
format => 'pie', |
20
|
|
|
|
|
|
|
legends => 'a,b,c,d,e,f,g,h' |
21
|
|
|
|
|
|
|
} ; |
22
|
|
|
|
|
|
|
my $obj = App::Basis::ConvertText2::Plugin::Chart->new() ; |
23
|
|
|
|
|
|
|
my $out = $obj->process( 'chart', $content, $params) ; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 DESCRIPTION |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
Convert comma separated text strings into charts image PNG |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=cut |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
package App::Basis::ConvertText2::Plugin::Chart; |
34
|
|
|
|
|
|
|
$App::Basis::ConvertText2::Plugin::Chart::VERSION = '0.4'; |
35
|
1
|
|
|
1
|
|
2334
|
use 5.10.0; |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
59
|
|
36
|
1
|
|
|
1
|
|
8
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
34
|
|
37
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
33
|
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# the different graph types |
40
|
1
|
|
|
1
|
|
449
|
use GD::Graph::lines; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
use GD::Graph::lines3d; |
42
|
|
|
|
|
|
|
use GD::Graph::bars; |
43
|
|
|
|
|
|
|
use GD::Graph::bars3d; |
44
|
|
|
|
|
|
|
use GD::Graph::pie; |
45
|
|
|
|
|
|
|
use GD::Graph::points; |
46
|
|
|
|
|
|
|
use GD::Graph::linespoints; |
47
|
|
|
|
|
|
|
use GD::Graph::area; |
48
|
|
|
|
|
|
|
use GD::Graph::mixed; |
49
|
|
|
|
|
|
|
use GD; |
50
|
|
|
|
|
|
|
use Capture::Tiny qw(capture); |
51
|
|
|
|
|
|
|
use Path::Tiny; |
52
|
|
|
|
|
|
|
use Moo; |
53
|
|
|
|
|
|
|
use App::Basis; |
54
|
|
|
|
|
|
|
use App::Basis::ConvertText2::Support; |
55
|
|
|
|
|
|
|
use namespace::autoclean; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
has handles => ( |
58
|
|
|
|
|
|
|
is => 'ro', |
59
|
|
|
|
|
|
|
init_arg => undef, |
60
|
|
|
|
|
|
|
default => sub { [qw{chart}] } |
61
|
|
|
|
|
|
|
); |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# BEGIN { |
64
|
|
|
|
|
|
|
# load up the X11 colour names |
65
|
|
|
|
|
|
|
GD::Graph::colour::read_rgb("/etc/X11/rgb.txt"); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# } |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
my %_chart_formats = ( |
72
|
|
|
|
|
|
|
mixed => 'GD::Graph::mixed', |
73
|
|
|
|
|
|
|
area => 'GD::Graph::area', |
74
|
|
|
|
|
|
|
lines => 'GD::Graph::lines', |
75
|
|
|
|
|
|
|
points => 'GD::Graph::points', |
76
|
|
|
|
|
|
|
linespoints => 'GD::Graph::linespoints', |
77
|
|
|
|
|
|
|
bars => 'GD::Graph::bars', |
78
|
|
|
|
|
|
|
lines3d => 'GD::Graph::lines3d', |
79
|
|
|
|
|
|
|
pie => 'GD::Graph::pie' |
80
|
|
|
|
|
|
|
); |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
83
|
|
|
|
|
|
|
sub chart_formats { |
84
|
|
|
|
|
|
|
my @charts = sort keys %_chart_formats; |
85
|
|
|
|
|
|
|
return @charts; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub _split_csv_data { |
91
|
|
|
|
|
|
|
my $data = shift; |
92
|
|
|
|
|
|
|
my @d = (); |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
my $j = 0; |
95
|
|
|
|
|
|
|
foreach my $line ( split( /\n/, $data ) ) { |
96
|
|
|
|
|
|
|
last if ( !$line ); |
97
|
|
|
|
|
|
|
my @row = split( /,/, $line ); |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
for ( my $i = 0; $i <= $#row; $i++ ) { |
100
|
|
|
|
|
|
|
undef $row[$i] if ( $row[$i] eq 'undef' ); |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# dont' bother with any zero values either |
103
|
|
|
|
|
|
|
undef $row[$i] if ( $row[$i] =~ /^0\.?0?$/ ); |
104
|
|
|
|
|
|
|
push @{ $d[$j] }, $row[$i]; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
$j++; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
return @d; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=item chart |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
create a simple chart image, with some nice defaults |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
parameters |
119
|
|
|
|
|
|
|
data - comma separated lines of chart data |
120
|
|
|
|
|
|
|
filename - filename to save the created chart image as |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
hashref params of |
123
|
|
|
|
|
|
|
size - size of image, default 400x300, widthxheight - optional |
124
|
|
|
|
|
|
|
title - title for the chart |
125
|
|
|
|
|
|
|
xaxis - label for x axis |
126
|
|
|
|
|
|
|
yaxis - label for y axis |
127
|
|
|
|
|
|
|
format - chart format mixed, area, lines, points, linespoints, bars, lines3d, pie |
128
|
|
|
|
|
|
|
types - space separated list of types, in the same order as the data sets. Possible values are: lines bars points area linespoints |
129
|
|
|
|
|
|
|
overwrite - If set to 0, bars of different data sets will be drawn next to each other. If set to 1, they will be drawn in front of each other. Default: 0. |
130
|
|
|
|
|
|
|
legends - csv of legends for graph, these correspond to the data sets |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=cut |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub process { |
135
|
|
|
|
|
|
|
my $self = shift; |
136
|
|
|
|
|
|
|
my ( $tag, $content, $params, $cachedir ) = @_; |
137
|
|
|
|
|
|
|
my ( @data, $chart, $format ); |
138
|
|
|
|
|
|
|
my @types = (); |
139
|
|
|
|
|
|
|
$params->{size} ||= "400x300"; |
140
|
|
|
|
|
|
|
my ( $x, $y ) = ( $params->{size} =~ /^\s*(\d+)\s*x\s*(\d+)\s*$/ ); |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
# strip any ending linefeed |
143
|
|
|
|
|
|
|
chomp $content; |
144
|
|
|
|
|
|
|
return "" if ( !$content ); |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
my $sig = create_sig( $content, $params ); |
147
|
|
|
|
|
|
|
my $filename = cachefile( $cachedir, "$sig.png" ); |
148
|
|
|
|
|
|
|
if ( !-f $filename ) { |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# open the csv file, read contents, calc max, add into data array |
151
|
|
|
|
|
|
|
@data = _split_csv_data($content); |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
$format = $params->{format} || "mixed"; |
154
|
|
|
|
|
|
|
$format = lc $format; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
if ( !$y ) { |
157
|
|
|
|
|
|
|
$x = 400; |
158
|
|
|
|
|
|
|
$y = 300; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
die "Unknown format type $format" if ( !$_chart_formats{$format} ); |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
# get the name of the GD::Graph format class to instantiate and do it |
164
|
|
|
|
|
|
|
$chart = $_chart_formats{$format}->new( $x, $y ); |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
if ( $format eq "lines3d" ) { |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
# always assume stacked bars when using lines3d |
169
|
|
|
|
|
|
|
$chart->set( bar_spacing => 6 ); |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
if ( $params->{types} ) { |
173
|
|
|
|
|
|
|
@types = split( /\s/, $params->{types} ); |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
else { |
176
|
|
|
|
|
|
|
$params->{types} = "points " x scalar(@data); |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# set the types |
180
|
|
|
|
|
|
|
$chart->set( |
181
|
|
|
|
|
|
|
types => [@types], |
182
|
|
|
|
|
|
|
default_type => $types[0] || "points", |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
bgclr => 'white', |
185
|
|
|
|
|
|
|
fgclr => 'black', |
186
|
|
|
|
|
|
|
boxclr => 'ivory', |
187
|
|
|
|
|
|
|
accentclr => 'black', |
188
|
|
|
|
|
|
|
valuesclr => 'black', |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
labelclr => 'black', |
191
|
|
|
|
|
|
|
axislabelclr => 'black', |
192
|
|
|
|
|
|
|
legendclr => 'black', |
193
|
|
|
|
|
|
|
valuesclr => 'black', |
194
|
|
|
|
|
|
|
textclr => 'black', |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# shadow_depth => 2, |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
x_label => $params->{xaxis} || "", |
199
|
|
|
|
|
|
|
y_label => $params->{yaxis} || "", |
200
|
|
|
|
|
|
|
title => $params->{title} || "", |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
overwrite => $params->{overwrite} || 0, |
203
|
|
|
|
|
|
|
bar_spacing => 6, |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
long_ticks => 1, |
206
|
|
|
|
|
|
|
x_ticks => 1, |
207
|
|
|
|
|
|
|
x_labels_vertical => 1, |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
legend_marker_width => 24, |
210
|
|
|
|
|
|
|
line_width => 3, |
211
|
|
|
|
|
|
|
marker_size => 5, |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
legend_placement => 'RC', |
214
|
|
|
|
|
|
|
); |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# set the colours for the charts |
217
|
|
|
|
|
|
|
# white, lgray, gray, dgray, black, lblue, blue, dblue, gold, lyellow, yellow, dyellow, |
218
|
|
|
|
|
|
|
# lgreen, green, dgreen, lred, red, dred, lpurple, purple, dpurple, lorange, orange, |
219
|
|
|
|
|
|
|
# pink, dpink, marine, cyan, lbrown, dbrown. |
220
|
|
|
|
|
|
|
$chart->set( dclrs => [qw(marine blue lred dgreen orange salmon lbrown gold lgreen yellow gray dred lpurple)] ); |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
# set the font things |
223
|
|
|
|
|
|
|
$chart->set_title_font(gdGiantFont); |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
# pie legends are written on the slices, so we don't have this method |
226
|
|
|
|
|
|
|
if ( $format eq 'pie' ) { |
227
|
|
|
|
|
|
|
$chart->set_value_font(gdMediumBoldFont); |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
else { |
230
|
|
|
|
|
|
|
# legends comma seperated to allow spaces in descriptions |
231
|
|
|
|
|
|
|
$chart->set_legend( split( /,/, $params->{legends} || "" ) ); |
232
|
|
|
|
|
|
|
$chart->set_legend_font(gdMediumBoldFont); |
233
|
|
|
|
|
|
|
$chart->set_x_label_font(gdMediumBoldFont); |
234
|
|
|
|
|
|
|
$chart->set_y_label_font(gdMediumBoldFont); |
235
|
|
|
|
|
|
|
$chart->set_x_axis_font(gdMediumBoldFont); |
236
|
|
|
|
|
|
|
$chart->set_y_axis_font(gdMediumBoldFont); |
237
|
|
|
|
|
|
|
$chart->set_values_font(gdMediumBoldFont); |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
my ( $stdout, $stderr, $exit ) = capture { |
241
|
|
|
|
|
|
|
my $gd = $chart->plot( \@data ); |
242
|
|
|
|
|
|
|
path($filename)->spew_raw( $gd->png ) if ($$gd); |
243
|
|
|
|
|
|
|
}; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
my $out; |
247
|
|
|
|
|
|
|
if ( -f $filename ) { |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
# create something suitable for the HTML |
250
|
|
|
|
|
|
|
$out = create_img_src( $filename, $params->{title} ); |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
return $out; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
1; |