File Coverage

blib/lib/Spreadsheet/HTML/File/Loader.pm
Criterion Covered Total %
statement 79 185 42.7
branch 12 66 18.1
condition 1 35 2.8
subroutine 28 30 93.3
pod n/a
total 120 316 37.9


line stmt bran cond sub pod time code
1             package Spreadsheet::HTML::File::Loader;
2 5     5   52 use Carp;
  5         9  
  5         291  
3 5     5   24 use strict;
  5         25  
  5         113  
4 5     5   30 use warnings FATAL => 'all';
  5         7  
  5         5298  
5              
6 5     5   1889 eval "use Spreadsheet::Read";
  0         0  
  0         0  
7             our $NO_READER = $@;
8              
9 5     5   4361 eval "use URI";
  5         34320  
  5         98  
10             our $NO_URI = $@;
11 5     5   39069 eval "use LWP::Simple";
  5         361167  
  5         44  
12             our $NO_LWP = $@;
13 5     5   5945 eval "use File::Temp";
  5         107332  
  5         384  
14             our $NO_TEMP = $@;
15 5     5   35 eval "use File::Basename";
  5         10  
  5         310  
16             our $NO_BASE = $@;
17              
18              
19             sub _parse {
20 5     5   7 my ($args,$data) = @_;
21              
22 5 50       19 if ($args->{file} =~ m{^https?://}) {
23 0 0 0     0 if ($NO_URI or $NO_LWP or $NO_TEMP or $NO_BASE) {
      0        
      0        
24 0         0 return [[ "cannot download $args->{file}" ],[ 'please install URI, LWP::Simple, File::Basename and/or File::Temp' ]];
25             } else {
26 0         0 my $uri = URI->new( $args->{file} );
27 0         0 my @ext = qw( .html .htm .json .jsn .yaml .yml .gif .png .jpg .jpeg .csv .xls .xlsx .sxc .ods );
28 0         0 my (undef,undef,$suffix) = File::Basename::fileparse( $uri->path, @ext );
29 0         0 my (undef,$newfile) = File::Temp::tmpnam();
30 0         0 unlink $newfile;
31 0         0 $args->{file} = $newfile . $suffix;
32 0         0 my $error = LWP::Simple::getstore( $uri->as_string, $args->{file} );
33 0 0       0 return [[ "cannot download " . $uri->as_string ],[ "RC code $error" ]] if LWP::Simple::is_error( $error );
34 0 0       0 $args->{_unlink} = defined( $args->{_unlink} ) ? $args->{_unlink} : 1;
35             }
36             }
37              
38 5         10 my $file = $args->{file};
39 5 100       40 if ($file =~ /\.html?$/) {
    100          
    100          
    50          
40 1         5 return Spreadsheet::HTML::File::HTML::_parse( $args );
41             } elsif ($file =~ /\.jso?n$/) {
42 1         4 return Spreadsheet::HTML::File::JSON::_parse( $args );
43             } elsif ($file =~ /\.ya?ml$/) {
44 1         5 return Spreadsheet::HTML::File::YAML::_parse( $args );
45             } elsif ($file =~ /\.(gif|png|jpe?g)$/) {
46 0         0 return Spreadsheet::HTML::File::Image::_parse( $args, $data );
47             }
48              
49 2 50 33     64 return [[ "cannot load $file" ],[ 'No such file or directory' ]] unless -r $file or $file eq '-';
50 0 0       0 return [[ "cannot load $file" ],[ 'please install Spreadsheet::Read' ]] if $NO_READER;
51              
52             my $workbook = ReadData( $file,
53             attr => $args->{preserve},
54             clip => $args->{clip},
55             cells => $args->{cells},
56             rc => $args->{rc} || 1,
57             sep => $args->{sep},
58             strip => $args->{strip},
59             quote => $args->{quote},
60             parser => $args->{parser},
61 0   0     0 );
62              
63 0 0       0 close $file if ref($file) eq 'GLOB';
64              
65 0         0 my $parsed = $workbook->[ $args->{worksheet} ];
66              
67 0 0 0     0 if ($args->{preserve} and ref $parsed->{attr} eq 'ARRAY' and scalar@{$parsed->{attr}}) {
  0   0     0  
68              
69 0         0 my %attr_map = _attr_map();
70 0         0 for my $row (1 .. $#{ $parsed->{attr} }) {
  0         0  
71 0         0 for my $col (1 .. $#{ $parsed->{attr}[$row] }) {
  0         0  
72 0         0 my $attr = $parsed->{attr}[$row][$col];
73 0         0 my %styles;
74 0         0 for my $key (keys %$attr) {
75 0         0 my $map = $attr_map{$key};
76 0 0 0     0 next unless $map and $attr->{$key};
77 0 0       0 if ($map->[0]) {
78 0         0 $styles{$map->[1]} = $map->[2];
79             } else {
80 0         0 $styles{$map->[1]} = $attr->{$key};
81             }
82             }
83 0         0 $args->{ sprintf '-r%sc%s', $col - 1, $row - 1 } = { style => { %styles } };
84             }
85             }
86             }
87              
88 0         0 return [ Spreadsheet::Read::rows( $parsed ) ];
89             }
90              
91             sub _attr_map {(
92 0     0   0 font => [ 0, 'font-family' ],
93             size => [ 0, 'font-size' ],
94             valign => [ 0, 'vertical-align' ],
95             halign => [ 0, 'text-align' ],
96             fgcolor => [ 0, 'color' ],
97             bgcolor => [ 0, 'background-color' ],
98             bold => [ 1, 'font-weight', 'bold' ],
99             uline => [ 1, 'text-decoration', 'underline' ],
100             italic => [ 1, 'font-style', 'italic' ],
101             hidden => [ 1, 'display', 'none' ],
102             )}
103              
104             =head1 NAME
105              
106             Spreadsheet::HTML::File::Loader - Load data from files.
107              
108             =head1 DESCRIPTION
109              
110             This is a container for L file loading methods.
111             These package is not meant to be directly used. Instead, use the
112             Spreadsheet::HTML interface:
113              
114             use Spreadsheet::HTML;
115             my $generator = Spreadsheet::HTML->new( file => 'foo.xls' );
116             print $generator->generate();
117              
118             # or
119             use Spreadsheet::HTML qw( generate );
120             print generate( file => 'foo.xls' );
121              
122             =head1 SUPPORTED FORMATS
123              
124             =over 4
125              
126             =item * CSV/XLS
127              
128             Parses with (requires) L. (See its documentation for
129             customizing its options, such as C for specifying separators other
130             than a comma.
131              
132             generate( file => 'foo.csv' )
133             generate( file => 'foo.csv', sep => '|' )
134              
135             =item * HTML
136              
137             Parses with (requires) L.
138              
139             generate( file => 'foo.htm' )
140             generate( file => 'foo.html' )
141              
142             =item * JSON
143              
144             Parses with (requires) L.
145              
146             generate( file => 'foo.jsn' )
147             generate( file => 'foo.json' )
148              
149             =item * YAML
150              
151             Parses with (requires) L.
152              
153             generate( file => 'foo.yml' )
154             generate( file => 'foo.yaml' )
155              
156             =item * JPEG
157              
158             Parses with (requires) L.
159              
160             generate( file => 'foo.jpg' )
161             generate( file => 'foo.jpeg' )
162             generate( file => 'foo.jpeg', block => 2 )
163             generate( file => 'foo.jpeg', block => 2, blend => 1 )
164             generate( file => 'foo.jpeg', alpha => '#ffffff' )
165              
166             =item * PNG
167              
168             Parses with (requires) L.
169              
170             generate( file => 'foo.png' )
171             generate( file => 'foo.png', block => 2 )
172             generate( file => 'foo.png', block => 2, blend => 1 )
173             generate( file => 'foo.png', alpha => '#ffffff' )
174              
175             =item * GIF
176              
177             Parses with (requires) L.
178              
179             generate( file => 'foo.gif' )
180             generate( file => 'foo.gif', block => 2 )
181             generate( file => 'foo.gif', block => 2, blend => 1 )
182             generate( file => 'foo.gif', alpha => '#ffffff' )
183              
184             =back
185              
186             =head1 SEE ALSO
187              
188             =over 4
189              
190             =item * L
191              
192             The interface for this functionality.
193              
194             =back
195              
196             =cut
197              
198             1;
199              
200              
201              
202             package Spreadsheet::HTML::File::YAML;
203 5     5   30 use Carp;
  5         9  
  5         316  
204 5     5   24 use strict;
  5         6  
  5         135  
205 5     5   23 use warnings FATAL => 'all';
  5         9  
  5         855  
206              
207 5     5   1716 eval "use YAML";
  0         0  
  0         0  
208             our $NOT_AVAILABLE = $@;
209              
210             sub _parse {
211 1     1   2 my $args = shift;
212 1         3 my $file = $args->{file};
213 1 50       28 return [[ "cannot load $file" ],[ 'No such file or directory' ]] unless -r $file;
214 0 0       0 return [[ "cannot load $file" ],[ 'please install YAML' ]] if $NOT_AVAILABLE;
215              
216 0         0 my $data = YAML::LoadFile( $file );
217 0         0 return $data;
218             }
219              
220             1;
221              
222              
223              
224             package Spreadsheet::HTML::File::JSON;
225 5     5   25 use Carp;
  5         7  
  5         277  
226 5     5   23 use strict;
  5         8  
  5         124  
227 5     5   23 use warnings FATAL => 'all';
  5         65  
  5         927  
228              
229 5     5   1716 eval "use JSON";
  0         0  
  0         0  
230             our $NOT_AVAILABLE = $@;
231              
232             sub _parse {
233 1     1   2 my $args = shift;
234 1         2 my $file = $args->{file};
235 1 50       22 return [[ "cannot load $file" ],[ 'No such file or directory' ]] unless -r $file;
236 0 0       0 return [[ "cannot load $file" ],[ 'please install JSON' ]] if $NOT_AVAILABLE;
237              
238 0 0       0 open my $fh, '<', $file or return [[ "cannot load $file" ],[ $! ]];
239 0         0 my $data = decode_json( do{ local $/; <$fh> } );
  0         0  
  0         0  
240 0         0 close $fh;
241 0         0 return $data;
242             }
243              
244             1;
245              
246              
247              
248             package Spreadsheet::HTML::File::HTML;
249 5     5   24 use Carp;
  5         19  
  5         266  
250 5     5   31 use strict;
  5         9  
  5         144  
251 5     5   25 use warnings FATAL => 'all';
  5         8  
  5         1028  
252              
253 5     5   1731 eval "use HTML::TableExtract";
  0         0  
  0         0  
254             our $NOT_AVAILABLE = $@;
255              
256             sub _parse {
257 1     1   2 my $args = shift;
258 1         3 my $file = $args->{file};
259 1 50       23 return [[ "cannot load $file" ],[ 'No such file or directory' ]] unless -r $file;
260 0 0         return [[ "cannot load $file" ],[ 'please install HTML::TableExtract' ]] if $NOT_AVAILABLE;
261              
262 0           my @data;
263 0           my $extract = HTML::TableExtract->new( keep_headers => 1, decode => 0 );
264 0           $extract->parse_file( $file );
265 0           my $table = ($extract->tables)[ $args->{worksheet} - 1 ];
266 0 0         return [ $table ? $table->rows : [undef] ];
267             }
268              
269             1;
270              
271              
272              
273             package Spreadsheet::HTML::File::Image;
274 5     5   26 use Carp;
  5         5  
  5         263  
275 5     5   22 use strict;
  5         6  
  5         115  
276 5     5   22 use warnings FATAL => 'all';
  5         8  
  5         4616  
277              
278 5     5   1827 eval "use Imager";
  0         0  
  0         0  
279             our $NOT_AVAILABLE = $@;
280              
281             sub _parse {
282 0     0     my ($args,$data) = @_;
283 0           my $file = $args->{file};
284 0 0         return [[ "cannot load $file" ],[ 'No such file or directory' ]] unless -r $file;
285 0 0         return [[ "cannot load $file" ],[ 'please install Imager' ]] if $NOT_AVAILABLE;
286              
287 0           my $imager = Imager->new;
288 0 0         my @images = $imager->read_multi( file => $file ) or return [[ "cannot load $file" ],[ $imager->errstr ]];
289 0   0       my $image = $images[ $args->{worksheet} - 1 ] || $images[0];
290            
291 0 0 0       $args->{block} = $args->{block} && $args->{block} =~ /\D/ ? 8 : ($args->{block} || 0) < 1 ? 8 : $args->{block};
    0 0        
292 0           $args->{fill} = join( 'x', int( $image->getheight / $args->{block} ), int( $image->getwidth / $args->{block} ) );
293 0   0       $args->{table} ||= { cellspacing => 0, border => 0, cellpadding => 0 };
294              
295 0           my $r = 0;
296 0           for (my $x = 0; $x < $image->getwidth; $x += $args->{block}) {
297 0           my $c = 0;
298 0           for (my $y = 0; $y < $image->getheight; $y += $args->{block}) {
299            
300 0           my (@x,@y);
301 0           for my $i ($x .. $x + $args->{block}) {
302 0           for my $j ($y .. $y + $args->{block}) {
303 0           push @x, $i;
304 0           push @y, $j;
305             }
306             }
307              
308 0           my $primary;
309 0 0         if ($args->{block} == 1) {
310 0           $primary = join '', map sprintf( "%02X", $_ ), ($image->getpixel( x => $x[0], y => $y[0] )->rgba)[0..2];
311             } else {
312 0 0         if ($args->{blend}) {
313 0           my %average = ( r => 0, g => 0, b => 0 );
314 0           for my $pixel ($image->getpixel( x => \@x, y => \@y )) {
315 0 0         next unless ref $pixel;
316 0           my @rgba = $pixel->rgba;
317 0           $average{r} += $rgba[0];
318 0           $average{g} += $rgba[1];
319 0           $average{b} += $rgba[2];
320             }
321 0           $_ /= ($args->{block} * $args->{block}) for values %average;
322 0           $primary = join '', map sprintf( "%02X", $_ ), @average{qw(r g b)};
323             } else {
324 0           my %block;
325 0           for my $pixel ($image->getpixel( x => \@x, y => \@y )) {
326 0 0         next unless ref $pixel;
327 0           my $color = join '', map sprintf( "%02X", $_ ), ($pixel->rgba)[0..2];
328 0           $block{$color}++;
329             }
330 0           $primary = (sort { $block{$b} <=> $block{$a} } keys %block)[0];
  0            
331             }
332             }
333              
334 0 0         if ($args->{alpha}) {
335 0           $args->{alpha} =~ s/^#//;
336 0           $args->{alpha} = uc( $args->{alpha} );
337             }
338              
339             $args->{"-r${c}c${r}"} = {
340             width => $args->{block} * 2,
341             height => $args->{block},
342             style => { 'background-color' => "#$primary" },
343 0 0 0       } unless $args->{alpha} and $args->{alpha} eq $primary;
344              
345 0           $c++;
346             }
347              
348 0           $r++;
349             }
350              
351 0           return $data;
352             }
353              
354             1;
355              
356              
357              
358             =head1 AUTHOR
359              
360             Jeff Anderson, C<< >>
361              
362             =head1 LICENSE AND COPYRIGHT
363              
364             Copyright 2016 Jeff Anderson.
365              
366             This program is free software; you can redistribute it and/or modify it
367             under the terms of the the Artistic License (2.0). You may obtain a
368             copy of the full license at:
369              
370             L
371              
372             Any use, modification, and distribution of the Standard or Modified
373             Versions is governed by this Artistic License. By using, modifying or
374             distributing the Package, you accept this license. Do not use, modify,
375             or distribute the Package, if you do not accept this license.
376              
377             If your Modified Version has been derived from a Modified Version made
378             by someone other than you, you are nevertheless required to ensure that
379             your Modified Version complies with the requirements of this license.
380              
381             This license does not grant you the right to use any trademark, service
382             mark, tradename, or logo of the Copyright Holder.
383              
384             This license includes the non-exclusive, worldwide, free-of-charge
385             patent license to make, have made, use, offer to sell, sell, import and
386             otherwise transfer the Package with respect to any patent claims
387             licensable by the Copyright Holder that are necessarily infringed by the
388             Package. If you institute patent litigation (including a cross-claim or
389             counterclaim) against any party alleging that the Package constitutes
390             direct or contributory patent infringement, then this Artistic License
391             to you shall terminate on the date that such litigation is filed.
392              
393             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
394             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
395             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
396             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
397             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
398             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
399             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
400             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
401              
402             =cut
403              
404             1;