File Coverage

blib/lib/SVG/Sparkline.pm
Criterion Covered Total %
statement 139 141 98.5
branch 48 50 96.0
condition 8 9 88.8
subroutine 32 34 94.1
pod 4 4 100.0
total 231 238 97.0


line stmt bran cond sub pod time code
1             package SVG::Sparkline;
2              
3 31     31   1654219 use warnings;
  31         67  
  31         1706  
4 30     30   138 use strict;
  30         43  
  30         800  
5 30     30   122 use Carp;
  30         46  
  30         1832  
6 30     30   18228 use SVG;
  30         437235  
  30         199  
7              
8 30     30   64411 use overload '""' => \&to_string;
  30         28756  
  30         250  
9              
10 30     30   2348 use 5.008000;
  30         85  
  30         33163  
11             our $VERSION = 1.11;
12              
13             my %valid_parms = map { $_ => 1 } qw(
14             -allns color -sized
15             height width xscale yscale pady padx
16             color bgcolor mark values
17             );
18              
19             sub new
20             {
21 225     225 1 101903 my ($class, $type, $args) = @_;
22 225 100       659 croak "No Sparkline type specified.\n" unless defined $type;
23             # Use eval to load plugin.
24 224     28   14853 eval "use SVG::Sparkline::$type;"; ## no critic (ProhibitStringyEval)
  28     28   14923  
  27     26   61  
  27     26   532  
  28     20   2879  
  28     15   70  
  28     14   399  
  26     12   2159  
  26     8   45  
  26     8   381  
  26     6   983  
  26     5   45  
  26     5   355  
  20     5   523  
  20     5   33  
  20     5   278  
  15     4   81  
  15     3   17  
  15         182  
  14         498  
  14         21  
  14         174  
  12         63  
  12         13  
  12         135  
  8         40  
  8         11  
  8         90  
  8         39  
  8         10  
  8         90  
  6         26  
  6         8  
  6         62  
  5         22  
  5         7  
  5         49  
  5         25  
  5         5  
  5         59  
  5         25  
  5         6  
  5         124  
  5         27  
  5         11  
  5         59  
  5         25  
  5         5  
  5         52  
  4         22  
  4         5  
  4         50  
  3         14  
  3         5  
  3         35  
25 224 100       681 croak "Unrecognized Sparkline type '$type'.\n" if $@;
26 223 100       551 croak "Missing arguments hash.\n" unless defined $args;
27 222 100       684 croak "Arguments not supplied as a hash reference.\n" unless 'HASH' eq ref $args;
28 221         455 _no_unrecognized_parameters( $type, $args );
29              
30 221         1050 my $self = bless {
31             -allns => 0,
32             color => '#000',
33             -sized => 1,
34 221         415 %{$args},
35             }, $class;
36              
37 221         584 $self->_validate_pos_param( 'height', 12 );
38 219         419 $self->_validate_pos_param( 'width', 0 );
39 217         331 $self->_validate_pos_param( 'xscale' );
40 215         346 $self->_validate_pos_param( 'yscale' );
41 215         384 $self->_validate_nonneg_param( 'pady', 1 );
42 214         312 $self->_validate_nonneg_param( 'padx', 0 );
43 213         363 $self->_validate_mark_param();
44 203         298 foreach my $arg (qw/color bgcolor/)
45             {
46 405 100       945 next unless exists $self->{$arg};
47 212 100       429 croak "The value of $arg is not a valid color.\n"
48             unless _is_color( $self->{$arg} );
49             }
50              
51 201         474 $self->{xoff} = -$self->{padx};
52 201         430 $self->_make( $type );
53              
54 170         410 return $self;
55             }
56              
57 0     0 1 0 sub get_height { return $_[0]->{height}; }
58 0     0 1 0 sub get_width { return $_[0]->{width}; }
59              
60             sub to_string
61             {
62 189     189 1 3844 my ($self) = @_;
63 189         549 my $str = $self->{_SVG}->xmlify();
64             # Cleanup
65 189 100       72792 $str =~ s/ xmlns:(?:svg|xlink)="[^"]+"//g unless $self->{'-allns'};
66 189 100       472 unless( $self->{'-sized'} )
67             {
68             # If I try to keep them from being created, default '100%' values
69             # show up instead.
70 6         46 $str =~ s/(]*) height="[^"]+"/$1/;
71 6         45 $str =~ s/(]*) width="[^"]+"/$1/;
72             }
73 189         1265 return $str;
74             }
75              
76             sub _make
77             {
78 201     201   233 my ($self, $type) = @_;
79 201         751 $self->{_SVG} = "SVG::Sparkline::$type"->make( $self );
80 170         247 return;
81             }
82              
83             sub _no_unrecognized_parameters {
84 221     221   302 my ( $type, $args ) = @_;
85 221         465 my $class = "SVG::Sparkline::$type";
86 221         228 foreach my $parm (keys %{$args}) {
  221         1003  
87 410 50 66     1207 croak "Parameter '$parm' not recognized for '$type'\n"
88             unless exists $valid_parms{$parm} || $class->valid_param( $parm );
89             }
90 221         446 return;
91             }
92              
93             sub _validate_pos_param
94             {
95 872     872   1008 my ($self, $name, $default) = @_;
96 872 100 100     8153 croak "'$name' must have a positive numeric value.\n"
97             if exists $self->{$name} && $self->{$name} <= 0;
98 866 100       1343 return if exists $self->{$name};
99              
100 835 100       1451 $self->{$name} = $default if defined $default;
101 835         782 return;
102             }
103              
104             sub _validate_nonneg_param
105             {
106 429     429   443 my ($self, $name, $default) = @_;
107 429 100 100     960 croak "'$name' must be a non-negative numeric value.\n"
108             if exists $self->{$name} && $self->{$name} < 0;
109 427 100       673 return if exists $self->{$name};
110              
111 405 50       907 $self->{$name} = $default if defined $default;
112 405         396 return;
113             }
114              
115             sub _validate_mark_param
116             {
117 213     213   220 my ($self) = @_;
118              
119 213 100       484 return unless exists $self->{mark};
120              
121 84 100       200 croak "'mark' parameter must be an array reference.\n"
122             unless 'ARRAY' eq ref $self->{mark};
123 83         216 croak "'mark' array parameter must have an even number of elements.\n"
124 83 100       71 unless 0 == (@{$self->{mark}}%2);
125              
126 82         79 my @marks = @{$self->{mark}};
  82         158  
127 82         153 while(@marks)
128             {
129 84         142 my ($index, $color) = splice( @marks, 0, 2 );
130 84 100       604 croak "'$index' is not a valid mark index.\n"
131             unless $index =~ /^(?:first|last|high|low|\d+)$/;
132 77 100       121 croak "'$color' is not a valid mark color.\n"
133             unless _is_color( $color );
134             }
135 74         87 return;
136             }
137              
138             sub _is_color
139             {
140 314     314   8420 my ($color) = @_;
141 314 100       1336 return 1 if $color =~ /^#[[:xdigit:]]{3}$/;
142 101 100       169 return 1 if $color =~ /^#[[:xdigit:]]{6}$/;
143 99 100       217 return 1 if $color =~ /^rgb\(\d+,\d+,\d+\)$/;
144 98 100       159 return 1 if $color =~ /^rgb\(\d+%,\d+%,\d+%\)$/;
145 97 100       477 return 1 if $color =~ /^[[:alpha:]]+$/;
146 18         84 return;
147             }
148              
149             1;
150              
151             __END__