File Coverage

blib/lib/Gnuplot/Builder/Template.pm
Criterion Covered Total %
statement 25 25 100.0
branch 2 2 100.0
condition n/a
subroutine 9 9 100.0
pod 2 2 100.0
total 38 38 100.0


line stmt bran cond sub pod time code
1             package Gnuplot::Builder::Template;
2 3     3   50876 use strict;
  3         8  
  3         75  
3 3     3   15 use warnings;
  3         6  
  3         100  
4 3     3   15 use Exporter 5.57 qw(import);
  3         57  
  3         85  
5 3     3   15 use Carp;
  3         7  
  3         244  
6 3     3   1571 use Gnuplot::Builder::JoinDict;
  3         7  
  3         1807  
7              
8             our @EXPORT_OK = qw(gusing gevery);
9              
10             sub _create_hyphen_validator {
11 6     6   10 my ($allowed_keys_arrayref) = @_;
12 6         13 my %allowed_keys = map { $_ => 1 } @$allowed_keys_arrayref;
  144         291  
13             return sub {
14 121     121   161 my ($dict) = @_;
15 121         347 foreach my $hyphen_key (grep { substr($_, 0, 1) eq "-" } $dict->get_all_keys) {
  4300         7452  
16 4294 100       9128 croak "Unknown key: $hyphen_key" if !$allowed_keys{$hyphen_key};
17             }
18 6         64 };
19             }
20              
21             our $USING;
22              
23             {
24             my @using_keys = grep { substr($_, 0, 1) eq "-" }
25             qw(
26             USE CASES | KEYS
27             ================+==============================================
28             | -x -y
29             filledcurves | -y1 -y2
30             | -z
31             polar | -t
32             image | -value
33             smooth kdensity | -weight -bandwidth
34             rgbalpha | -r -g -b -a
35             labels | -string -label
36             vectors | -xdelta -ydelta -zdelta
37             xerrorbars | -xlow -xhigh
38             yerrorbars | -ylow -yhigh
39             financebars | -date -open -low -high -close
40             candlesticks | -box_min -whisker_min -whisker_high -box_high
41             boxes | -x_width
42             boxplot | -boxplot_factor
43             circles | -radius -start_angle -end_angle
44             ellipses | -major_diam -minor_diam -angle
45             variable style | -pointsize -arrowstyle -linecolor
46             );
47            
48             $USING = Gnuplot::Builder::JoinDict->new(
49             separator => ":",
50             content => [map { $_ => undef } @using_keys],
51             validator => _create_hyphen_validator(\@using_keys),
52             );
53             }
54              
55             our $EVERY;
56              
57             {
58             my @every_keys =
59             qw(
60             -point_incr
61             -block_incr
62             -start_point
63             -start_block
64             -end_point
65             -end_block
66             );
67             $EVERY = Gnuplot::Builder::JoinDict->new(
68             separator => ":",
69             content => [$every_keys[0] => 1, map { $_ => undef } @every_keys[1 .. $#every_keys]],
70             validator => _create_hyphen_validator(\@every_keys),
71             filter => sub {
72             my ($dict) = @_;
73             my @values = $dict->get_all_values;
74             my ($first_def_index, $last_def_index);
75             foreach my $front_i (0 .. $#values) {
76             my $rear_i = $#values - $front_i;
77             if(!defined($first_def_index) && defined($values[$front_i])) {
78             $first_def_index = $front_i;
79             }
80             if(!defined($last_def_index) && defined($values[$rear_i])) {
81             $last_def_index = $rear_i;
82             }
83             if(defined($first_def_index) && defined($last_def_index)) {
84             last;
85             }
86             }
87             return () if !defined($first_def_index) || !defined($last_def_index);
88             return map {
89             defined($_) ? $_ : ""
90             } @values[$first_def_index .. $last_def_index];
91             }
92             );
93             }
94              
95             sub gusing {
96 96     96 1 36980 return $USING->set(@_);
97             }
98              
99             sub gevery {
100 18     18 1 6128 return $EVERY->set(@_);
101             }
102              
103             1;
104             __END__