File Coverage

blib/lib/App/Basis/ConvertText2/Plugin/Sparkline.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3              
4             App::Basis::ConvertText2::Plugin::Sparkline
5              
6             =head1 SYNOPSIS
7              
8             my $content = "1,2,3,4,5,6,7,8" ;
9             my $params = {} ;
10             my $obj = App::Basis::ConvertText2::Plugin::Sparkline->new() ;
11             my $out = $obj->process( 'sparkline', $content, $params) ;
12              
13             =head1 DESCRIPTION
14              
15             Convert a text string of comma separated numbers into a sparkline image PNG
16              
17             =cut
18              
19             # ----------------------------------------------------------------------------
20              
21             package App::Basis::ConvertText2::Plugin::Sparkline;
22             $App::Basis::ConvertText2::Plugin::Sparkline::VERSION = '0.4';
23 1     1   2050 use 5.10.0;
  1         16  
  1         47  
24 1     1   7 use strict;
  1         1  
  1         30  
25 1     1   6 use warnings;
  1         1  
  1         28  
26 1     1   438 use GD::Sparkline;
  0            
  0            
27             use Path::Tiny;
28             use Capture::Tiny qw(capture);
29             use Moo;
30             use App::Basis::ConvertText2::Support;
31             use namespace::clean;
32              
33             has handles => (
34             is => 'ro',
35             init_arg => undef,
36             default => sub {[qw{sparkline}]}
37             );
38              
39             # -----------------------------------------------------------------------------
40              
41             my %_colour_schemes = (
42             orange => { b => 'transparent', a => 'ffcc66', l => 'ff6000' },
43             blue => { b => 'transparent', a => 'ccffff', l => '3399cc' },
44             red => { b => 'transparent', a => 'ccaaaa', l => '990000' },
45             green => { b => 'transparent', a => '99ff99', l => '006600' },
46             mono => { b => 'ffffff', a => 'ffffff', l => '000000' }
47             );
48              
49             # -----------------------------------------------------------------------------
50              
51             =item color_schemes
52              
53             return a list of the color schemes available
54              
55             =cut
56              
57             sub color_schemes {
58             my $self = shift;
59             my @schemes = sort keys %_colour_schemes;
60             return @schemes;
61             }
62              
63             # -----------------------------------------------------------------------------
64              
65             =item process (sparkline)
66              
67             create a simple sparkline image, with some nice defaults
68              
69             parameters
70             text - comma separated list of integers for the sparkline
71             filename - filename to save the created sparkline image as
72              
73             hashref params of
74             bgcolor - background color in hex (123456) or transparent - optional
75             line - color or the line, in hex (abcdef) - optional
76             color - area under the line, in hex (abcdef) - optional
77             scheme - color scheme, only things in red blue green orange mono are valid - optional
78             size - size of image, default 80x20, widthxheight - optional
79              
80             =cut
81              
82             sub process {
83             my $self = shift;
84             my ( $tag, $content, $params, $cachedir ) = @_;
85             my $scheme = $params->{scheme};
86             my ( $b, $a, $l ) = ( $params->{bgcolor}, $params->{color}, $params->{line} );
87              
88             $params->{size} ||= "80x20";
89             $params->{size} =~ /^\s*(\d+)\s*x\s*(\d+)\s*$/;
90             my ( $w, $h ) = ( $1, $2 );
91              
92             if ( !$h ) {
93             $w = 80;
94             $h = 20;
95             }
96              
97             die "Missing content" if ( !$content );
98             die "Does not appear to be comma separated integers" if ( $content !~ /^[,\d ]+$/ );
99              
100             # we can use the cache or process everything ourselves
101             my $sig = create_sig( $content, $params );
102             my $filename = cachefile( $cachedir, "$sig.png" );
103             if ( !-f $filename ) {
104             $content =~ s/^\n*//gsm; # remove any leading new lines
105             if ( $content !~ /\n$/sm ) { # make sure we have a trailing new line
106             $content .= "\n";
107             }
108              
109             if ($scheme) {
110             $scheme = lc $scheme;
111             if ( !$_colour_schemes{$scheme} ) {
112             warn "Unknown color scheme $params->{scheme}";
113             $scheme = ( sort keys %_colour_schemes )[0];
114             }
115             $b = $_colour_schemes{ $params->{scheme} }{b}; # background color
116             $a = $_colour_schemes{ $params->{scheme} }{a}; # area under line color
117             $l = $_colour_schemes{ $params->{scheme} }{l}; # top line color
118             }
119             else {
120             $b ||= 'transparent';
121             $a = 'cccccc';
122             $l = '333333';
123             }
124              
125             my $args = { b => $b, a => $a, l => $l, s => $content, w => $w, h => $h };
126             my $spark = GD::Sparkline->new($args);
127             if ($spark) {
128             my $png = $spark->draw();
129             if ($png) {
130             path($filename)->spew_raw($png) ;
131             }
132             }
133             }
134              
135             my $out;
136             if (-f $filename) {
137              
138             # create something suitable for the HTML
139             $out = create_img_src( $filename, $params->{title} );
140             }
141              
142             return $out;
143             }
144              
145             # ----------------------------------------------------------------------------
146              
147             1;
148              
149             __END__