File Coverage

File:blib/lib/SVG/Sparkline.pm
Coverage:97.0%

linestmtbrancondsubtimecode
1package SVG::Sparkline;
2
3
31
31
31
31
317238
48
596
use warnings;
4
30
30
30
30
69
25
403
use strict;
5
30
30
30
30
66
24
1017
use Carp;
6
30
30
30
30
32331
292847
267
use SVG;
7
8
30
30
30
30
32795
38
1162
use overload '""' => \&to_string;
9
10
30
30
30
30
1019
118
18605
use 5.008000;
11our $VERSION = 0.35;
12
13my %valid_parms = map { $_ => 1 } qw(
14        -allns color -sized
15        height width xscale yscale pady padx
16        color bgcolor mark values
17);
18
19sub new
20{
21
221
221
1919407
    my ($class, $type, $args) = @_;
22
221
100
533
    croak "No Sparkline type specified.\n" unless defined $type;
23    # Use eval to load plugin.
24
220
28
27
27
28
28
28
26
26
26
26
26
26
20
20
20
15
15
15
13
13
13
10
10
10
8
8
8
7
7
7
6
6
6
5
5
5
5
5
5
5
5
5
5
5
5
5
5
5
4
4
4
3
3
3
28
28
26
26
20
15
13
10
8
7
6
5
5
5
5
5
4
3
7861
9368
45
750
1473
30
651
898
28
497
384
21
444
243
17
344
40
13
252
191
11
225
29
9
164
22
8
134
20
5
109
13
6
98
11
5
81
15
4
79
12
4
79
12
4
86
13
3
83
10
2
65
9
3
48
    eval "use SVG::Sparkline::$type;"; ## no critic (ProhibitStringyEval)
25
220
100
477
    croak "Unrecognized Sparkline type '$type'.\n" if $@;
26
219
100
633
    croak "Missing arguments hash.\n" unless defined $args;
27
218
100
642
    croak "Arguments not supplied as a hash reference.\n" unless 'HASH' eq ref $args;
28
217
270
    _no_unrecognized_parameters( $type, $args );
29
30
217
5138
    my $self = bless {
31        -allns => 0,
32        color => '#000',
33        -sized => 1,
34
217
413
        %{$args},
35    }, $class;
36
37
217
359
    $self->_validate_pos_param( 'height', 12 );
38
215
235
    $self->_validate_pos_param( 'width', 0 );
39
213
242
    $self->_validate_pos_param( 'xscale' );
40
211
219
    $self->_validate_pos_param( 'yscale' );
41
211
275
    $self->_validate_nonneg_param( 'pady', 1 );
42
210
216
    $self->_validate_nonneg_param( 'padx', 0 );
43
209
266
    $self->_validate_mark_param();
44
199
178
    foreach my $arg (qw/color bgcolor/)
45    {
46
397
100
606
        next unless exists $self->{$arg};
47
208
100
286
        croak "The value of $arg is not a valid color.\n"
48            unless _is_color( $self->{$arg} );
49    }
50
51
197
260
    $self->{xoff} = -$self->{padx};
52
197
224
    $self->_make( $type );
53
54
166
727
    return $self;
55}
56
57
0
0
0
sub get_height { return $_[0]->{height}; }
58
0
0
0
sub get_width { return $_[0]->{width}; }
59
60sub to_string
61{
62
185
185
4305
    my ($self) = @_;
63
185
1286
    my $str = $self->{_SVG}->xmlify();
64    # Cleanup
65
185
100
55042
    $str =~ s/ xmlns:(?:svg|xlink)="[^"]+"//g unless $self->{'-allns'};
66
185
100
260
    unless( $self->{'-sized'} )
67    {
68        # If I try to keep them from being created, default '100%' values
69        # show up instead.
70
6
49
        $str =~ s/(<svg[^>]*) height="[^"]+"/$1/;
71
6
30
        $str =~ s/(<svg[^>]*) width="[^"]+"/$1/;
72    }
73
185
1644
    return $str;
74}
75
76sub _make
77{
78
197
197
190
    my ($self, $type) = @_;
79
197
2730
    $self->{_SVG} = "SVG::Sparkline::$type"->make( $self );
80
166
139
    return;
81}
82
83sub _no_unrecognized_parameters {
84
217
217
242
    my ( $type, $args ) = @_;
85
217
231
    my $class = "SVG::Sparkline::$type";
86
217
217
148
471
    foreach my $parm (keys %{$args}) {
87
406
50
67
1026
        croak "Parameter '$parm' not recognized for '$type'\n"
88            unless exists $valid_parms{$parm} || $class->valid_param( $parm );
89    }
90
217
252
    return;
91}
92
93sub _validate_pos_param
94{
95
856
856
690
    my ($self, $name, $default) = @_;
96
856
100
100
1974
    croak "'$name' must have a positive numeric value.\n"
97        if exists $self->{$name} && $self->{$name} <= 0;
98
850
100
874
    return if exists $self->{$name};
99
100
819
100
929
    $self->{$name} = $default if defined $default;
101
819
589
    return;
102}
103
104sub _validate_nonneg_param
105{
106
421
421
353
    my ($self, $name, $default) = @_;
107
421
100
100
861
    croak "'$name' must be a non-negative numeric value.\n"
108        if exists $self->{$name} && $self->{$name} < 0;
109
419
100
450
    return if exists $self->{$name};
110
111
397
50
629
    $self->{$name} = $default if defined $default;
112
397
259
    return;
113}
114
115sub _validate_mark_param
116{
117
209
209
179
    my ($self) = @_;
118
119
209
100
288
    return unless exists $self->{mark};
120
121
84
100
199
    croak "'mark' parameter must be an array reference.\n"
122        unless 'ARRAY' eq ref $self->{mark};
123
83
240
    croak "'mark' array parameter must have an even number of elements.\n"
124
83
100
54
        unless 0 == (@{$self->{mark}}%2);
125
126
82
82
54
126
    my @marks = @{$self->{mark}};
127
82
106
    while(@marks)
128    {
129
84
118
        my ($index, $color) = splice( @marks, 0, 2 );
130
84
100
1072
        croak "'$index' is not a valid mark index.\n"
131            unless $index =~ /^(?:first|last|high|low|\d+)$/;
132
77
100
91
        croak "'$color' is not a valid mark color.\n"
133            unless _is_color( $color );
134    }
135
74
86
    return;
136}
137
138sub _is_color
139{
140
310
310
71166
    my ($color) = @_;
141
310
100
752
    return 1 if $color =~ /^#[[:xdigit:]]{3}$/;
142
101
100
119
    return 1 if $color =~ /^#[[:xdigit:]]{6}$/;
143
99
100
127
    return 1 if $color =~ /^rgb\(\d+,\d+,\d+\)$/;
144
98
100
119
    return 1 if $color =~ /^rgb\(\d+%,\d+%,\d+%\)$/;
145
97
100
303
    return 1 if $color =~ /^[[:alpha:]]+$/;
146
18
355
    return;
147}
148
1491; # Magic true value required at end of module