File Coverage

blib/lib/Chart/Kaleido.pm
Criterion Covered Total %
statement 103 135 76.3
branch 14 32 43.7
condition 10 29 34.4
subroutine 20 27 74.0
pod 0 9 0.0
total 147 232 63.3


line stmt bran cond sub pod time code
1             package Chart::Kaleido;
2              
3             # ABSTRACT: Base class for Chart::Kaleido
4              
5 1     1   574 use 5.010;
  1         4  
6 1     1   5 use strict;
  1         3  
  1         47  
7 1     1   6 use warnings;
  1         2  
  1         40  
8              
9             our $VERSION = '0.014'; # VERSION
10              
11 1     1   8 use Moo;
  1         4  
  1         10  
12 1     1   396 use Config;
  1         2  
  1         35  
13 1     1   5 use JSON;
  1         2  
  1         8  
14 1     1   152 use Types::Standard qw(Int Str);
  1         3  
  1         6  
15 1     1   2099 use File::Which qw(which);
  1         1102  
  1         56  
16 1     1   1477 use IPC::Run qw();
  1         35644  
  1         27  
17 1     1   7 use namespace::autoclean;
  1         2  
  1         12  
18              
19 1     1   80 use constant KALEIDO => 'kaleido';
  1         2  
  1         400  
20              
21              
22             has timeout => (
23             is => 'ro',
24             isa => Int,
25             default => 30,
26             );
27              
28             has base_args => (
29             is => 'ro',
30             init_arg => 0,
31             default => sub { [] },
32             );
33              
34             has _default_chromium_args => (
35             is => 'ro',
36             default => sub {
37             [
38             qw(
39             --disable-gpu
40             --allow-file-access-from-files
41             --disable-breakpad
42             --disable-dev-shm-usage
43             )
44             ];
45             }
46             );
47              
48             has disable_gpu => (
49             is => 'ro',
50             default => 1,
51             );
52              
53             has _stall_timeout => (
54             is => 'lazy',
55             builder =>
56 1     1   23 sub { IPC::Run::timeout( $_[0]->timeout, name => 'stall timeout' ) },
57             );
58              
59             has _h => ( is => 'rw' );
60              
61             has _ios => (
62             is => 'ro',
63             default => sub {
64             return { map { $_ => '' } qw(in out err) };
65             },
66             );
67              
68             # class attributes
69 0     0 0 0 sub all_formats { [] }
70 0     0 0 0 sub scope_name { "" }
71 0     0 0 0 sub scope_flags { [] }
72              
73             sub DEMOLISH {
74 0     0 0 0 my ($self) = @_;
75 0         0 $self->shutdown_kaleido;
76             }
77              
78             sub _reset {
79 1     1   4 my ($self) = @_;
80 1         6 $self->_ios->{in} = '';
81 1         4 $self->_ios->{out} = '';
82 1         3 $self->_ios->{err} = '';
83             }
84              
85             sub kaleido_args {
86 5     5 0 1336 my ($self) = @_;
87              
88 5         10 my @args = @{ $self->base_args };
  5         35  
89 5 50       56 unless ( $self->disable_gpu ) {
90 0         0 @args = grep { $_ ne '--disable-gpu' } @args;
  0         0  
91             }
92              
93 1     1   7 no strict 'refs';
  1         2  
  1         1149  
94             push @args, map {
95 20         77 my $val = $self->$_;
96 20 100       38 if ( defined $val ) {
97 5         18 my $flag = $_;
98 5         28 $flag =~ s/_/-/g;
99              
100             # too bad Perl does not have a core boolean type..
101 5 50 33     22 if ( ref($val) =~ /^(JSON::.*::Boolean|boolean)$/ and $val ) {
102 0         0 "--$flag";
103             }
104             else {
105 5         26 "--$flag=$val";
106             }
107             }
108             else {
109 15         32 ();
110             }
111 5         13 } @{ $self->scope_flags };
  5         26  
112              
113 5         64 return \@args;
114             }
115              
116             sub ensure_kaleido {
117 3     3 0 20 my ( $self, $override_args ) = @_;
118 3   33     35 $override_args //= $self->kaleido_args;
119              
120 3 100 66     38 unless ( $self->_h and $self->_h->pumpable ) {
121 1         7 $self->_reset;
122             my $h = IPC::Run::start(
123 1         3 [ KALEIDO, @{ $self->kaleido_args } ],
124             \$self->_ios->{in},
125             \$self->_ios->{out},
126             \$self->_ios->{err},
127 1         2 $self->_stall_timeout,
128             );
129 1         11432 $self->_h($h);
130              
131 1         43 $self->_stall_timeout->start;
132 1         347 my $resp = $self->_get_kaleido_out;
133 1 50 33     38 if ( exists $resp->{code} and $resp->{code} == 0 ) {
134 1         29 return $resp->{version};
135             }
136             else {
137 0         0 die $resp->{message};
138             }
139             }
140             }
141              
142             sub shutdown_kaleido {
143 0     0 0 0 my ($self) = @_;
144              
145 0 0       0 if ( $self->_h ) {
146 0         0 eval { $self->finish; };
  0         0  
147 0 0       0 if ($@) {
148 0         0 $self->_h->kill_kill;
149             }
150             }
151             }
152              
153             sub do_transform {
154 3     3 0 9 my ( $self, $data ) = @_;
155              
156 3         20 $self->ensure_kaleido;
157              
158 3         221 my $json = JSON->new->allow_blessed(1)->convert_blessed(1);
159 3         106 $self->_ios->{in} .= $json->encode($data) . "\n";
160 3         603 $self->_stall_timeout->start;
161 3         875 my $resp = $self->_get_kaleido_out;
162 3         57 return $resp;
163             }
164              
165             sub version {
166 0     0 0 0 my ( $class, $force_check ) = @_;
167              
168 0 0       0 if ( $class->_check_alien($force_check) ) {
169 0         0 return Alien::Plotly::Kaleido->version;
170             }
171             else {
172 0         0 state $version;
173 0 0 0     0 if ( not $version or $force_check ) {
174 0         0 $version = $class->_detect_kaleido_version;
175             }
176 0         0 return $version;
177             }
178             }
179              
180             sub _get_kaleido_out {
181 4     4   24 my ($self) = @_;
182              
183 4         18 while (1) {
184 19         126 $self->_h->pump;
185 19         1560268 my $out = $self->_ios->{out};
186 19         1097 my @lines = split( /\n/, $out );
187 19 100       87 next unless @lines;
188              
189 15         42 for my $line (@lines) {
190 15         27 my $data;
191 15         27 eval { $data = decode_json($line); };
  15         1970  
192 15 100       78 next if $@;
193 4         125 $self->_stall_timeout->reset;
194 4         536 $self->_ios->{out} = ''; # clear out buffer
195 4         25 return $data;
196             }
197             }
198             }
199              
200             sub _check_alien {
201 1     1   3 my ( $class, $force_check ) = @_;
202              
203 1         1 state $has_alien;
204              
205 1 50 33     6 if ( !defined $has_alien or $force_check ) {
206 1         2 $has_alien = 0;
207 1         3 eval { require Alien::Plotly::Kaleido; };
  1         541  
208 1 50 33     25650 if ( !$@ and Alien::Plotly::Kaleido->install_type eq 'share' ) {
209             $ENV{PATH} = join(
210             $Config{path_sep},
211             Alien::Plotly::Kaleido->bin_dir,
212 1   50     19927 $ENV{PATH} // ''
213             );
214 1         679 $has_alien = 1;
215             }
216             }
217 1         6 return $has_alien;
218             }
219              
220             sub _kaleido_available {
221 1     1   3 my ( $class, $force_check ) = @_;
222              
223 1         1 state $available;
224 1 50 33     8 if ( !defined $available or $force_check ) {
225 1         3 $available = 0;
226 1 0 33     4 if ( not $class->_check_alien($force_check)
227             and ( not which(KALEIDO) ) )
228             {
229 0         0 die "Kaleido tool (its 'kaleido' command) must be installed and "
230             . "in PATH in order to export images. "
231             . "Either install Alien::Plotly::Kaleido from CPAN, or install "
232             . "it manually (see https://github.com/plotly/Kaleido/releases)";
233             }
234 1         3 $available = 1;
235             }
236 1         5 return $available;
237             }
238              
239             sub _detect_kaleido_version {
240 0     0     my ($class) = @_;
241              
242 0           my $kaleido = which('kaleido');
243 0 0         if ($kaleido) {
244 0           my $kaleido = $class->new;
245 0           my $args = [ 'plotly', '--disable-gpu' ];
246 0           my $version = $kaleido->ensure_kaleido($args);
247 0           $kaleido->shutdown_kaleido;
248 0           return $version;
249             }
250              
251 0           die "Failed to detect kaleido version";
252             }
253              
254             __PACKAGE__->_kaleido_available;
255              
256             1;
257              
258             __END__
259              
260             =pod
261              
262             =encoding UTF-8
263              
264             =head1 NAME
265              
266             Chart::Kaleido - Base class for Chart::Kaleido
267              
268             =head1 VERSION
269              
270             version 0.014
271              
272             =head1 SYNOPSIS
273              
274             use Chart::Kaleido::Plotly;
275             use JSON;
276              
277             my $data = decode_json(<<'END_OF_TEXT');
278             { "data": [{"y": [1,2,1]}] }
279             END_OF_TEXT
280              
281             my $kaleido = Chart::Kaleido::Plotly->new();
282             $kaleido->save( file => "foo.png", plot => $data,
283             width => 1024, height => 768 );
284              
285             =head1 DESCRIPTION
286              
287             This is base class that wraps plotly's kaleido command.
288             Instead of this class you would mostly want to use
289             its subclass like L<Chart::Kaleido::Plotly>.
290              
291             =head1 ATTRIBUTES
292              
293             =head2 timeout
294              
295             =head1 SEE ALSO
296              
297             L<https://github.com/plotly/Kaleido>
298              
299             L<Chart::Kaleido::Plotly>,
300             L<Alien::Plotly::Kaleido>
301              
302             =head1 AUTHOR
303              
304             Stephan Loyd <sloyd@cpan.org>
305              
306             =head1 CONTRIBUTOR
307              
308             =for stopwords Gabor Szabo
309              
310             Gabor Szabo <gabor@szabgab.com>
311              
312             =head1 COPYRIGHT AND LICENSE
313              
314             This software is copyright (c) 2020-2023 by Stephan Loyd.
315              
316             This is free software; you can redistribute it and/or modify it under
317             the same terms as the Perl 5 programming language system itself.
318              
319             =cut