File Coverage

blib/lib/Term/Vspark.pm
Criterion Covered Total %
statement 64 70 91.4
branch 17 28 60.7
condition 7 15 46.6
subroutine 11 11 100.0
pod 1 2 50.0
total 100 126 79.3


line stmt bran cond sub pod time code
1             package Term::Vspark;
2              
3 3     3   107017 use strict;
  3         6  
  3         86  
4 3     3   10 use warnings;
  3         2  
  3         77  
5 3     3   14 use Carp qw{ croak };
  3         5  
  3         111  
6 3     3   1392 use utf8;
  3         21  
  3         13  
7              
8 3     3   1127 use Exporter::Shiny qw/show_graph vspark/;
  3         8109  
  3         15  
9              
10             our $VERSION = 0.34;
11              
12             sub _bar {
13 48     48   72 my (%args) = @_;
14              
15 48         34 my $value = $args{value};
16 48         32 my $max = $args{max};
17 48         32 my $columns = $args{columns};
18 48         30 my $char = $args{char};
19              
20 48 100       78 my @char_list = $char
21             ? ($char)
22             : (qw{ ▏ ▎ ▍ ▌ ▋ ▊ ▉ █});
23              
24             # calculate the length of the bar
25 48         45 my $length = $value * $columns / $max; # length of the bar
26 48 100       58 $length = $columns if $length > $columns;
27              
28             # empty $bar
29 48         37 my $bar = '';
30              
31             # build integer portion of the bar
32 48         29 my $integer = int $length;
33 48         51 $bar .= $char_list[-1] x $integer;
34              
35             # build decimal portion of the bar
36 48         33 my $decimal = $length - $integer;
37 48 100       56 if ($decimal > 0) {
38 9         8 my $index = int scalar @char_list * $decimal;
39 9         9 $bar .= $char_list[$index];
40             }
41              
42 48         79 return $bar;
43             }
44              
45             sub vspark {
46 7     7 1 22 my %args = @_;
47              
48 7 50       20 croak 'values is not an ArrayRef'
49             if ref $args{'values'} ne 'ARRAY';
50              
51 7 50 66     30 croak 'labels is not an ArrayRef'
52             if $args{'labels'} && ref $args{'labels'} ne 'ARRAY';
53              
54 7         9 my $max = $args{max};
55 7         11 my $columns = _term_width($args{columns});
56 7 100       5 my @labels = @{ $args{labels} || [] };
  7         23  
57 7         7 my @values = @{ $args{values} };
  7         11  
58 7         10 my $char = $args{char};
59              
60 7 50 66     20 croak 'the number of labels and values must be equal'
61             if $args{labels} && scalar @labels != scalar @values;
62              
63 7   66     17 $max //= _max_value(@values);
64 7         11 my $label_width = _max_label_width(@labels);
65 7         9 my $bar_width = $columns - $label_width;
66 7         5 my $graph = q{};
67              
68 7         13 for my $value (@values) {
69 48         29 my $label = shift @labels;
70 48         54 my $bar = _bar(
71             value => $value,
72             max => $max,
73             columns => $bar_width,
74             char => $char,
75             );
76              
77 48 100       130 $graph .= sprintf("%${label_width}s", " $label ") if defined $label;
78 48         85 $graph .= $bar . "\n";
79             }
80              
81 7         19 return $graph;
82             }
83              
84             # for backwards compatibility
85 7     7 0 1465 sub show_graph { vspark(@_) }
86              
87             sub _term_width {
88 7     7   9 my $columns = shift;
89 7 50 33     33 return $columns if $columns && $columns ne 'max';
90              
91 0         0 require Term::ReadKey;
92 0         0 my ($cols) = Term::ReadKey::GetTerminalSize(*STDOUT);
93 0 0       0 return 80 if !$cols;
94 0 0 0     0 return $cols if $columns && $columns eq 'max';
95 0 0       0 return 80 if $cols > 80;
96 0         0 return $cols;
97             }
98              
99             sub _max_value {
100 1     1   1 my @values = @_;
101 1         39 my @sorted = sort @values;
102 1 50       3 return 0 unless @sorted;
103 1         3 return $sorted[-1];
104             }
105              
106             sub _max_label_width {
107 7     7   9 my @labels = @_;
108              
109 7 100       12 return 0 if scalar @labels == 0;
110              
111 6         8 my @lengths = sort map { length $_ } @labels;
  36         53  
112 6         15 return $lengths[-1] + 2; # + 2 because of 1 space before and after label
113             }
114              
115             1;
116             __END__