File Coverage

blib/lib/SVGPDF/Image.pm
Criterion Covered Total %
statement 62 72 86.1
branch 22 30 73.3
condition 9 19 47.3
subroutine 6 6 100.0
pod 0 1 0.0
total 99 128 77.3


line stmt bran cond sub pod time code
1             #! perl
2              
3 2     2   877 use v5.26;
  2         21  
4 2     2   44 use Object::Pad;
  2         5  
  2         14  
5 2     2   185 use utf8;
  2         4  
  2         7  
6 2     2   38 use Carp;
  2         2  
  2         354  
7              
8             class SVGPDF::Image :isa(SVGPDF::Element);
9              
10 18     18 0 22 method process () {
  18         37  
  18         23  
11 18         46 my $atts = $self->atts;
12 18         48 my $xo = $self->xo;
13 18 50       43 return if $atts->{omit}; # for testing/debugging.
14              
15 18         96 my ( $x, $y, $w, $h, $link, $tf ) =
16             $self->get_params( $atts, qw( x:H y:V width:H height:V href:! transform:s ) );
17              
18 18   100     53 $x ||= 0; $y ||= 0;
  18   50     54  
19 18   50     24 $w ||= 0; $h ||= 0;
  18   50     25  
20              
21 18 50 33     42 unless ( $w && $h ) {
22 0         0 $self->_dbg( $self->name, " x=$x y=$y w=$w h=$h **skipped**" );
23 0         0 return;
24             }
25              
26 18         55 $self->_dbg( $self->name, " x=$x y=$y w=$w h=$h" );
27              
28 18         37 my $img;
29 18 100 66     276 if ( $link =~ /^data:/ ) {
    100 33        
    50          
30             # In-line image asset.
31 8         34 my $info = $self->data_inline($link);
32 8 50       22 if ( $info->{error} ) {
33 0         0 warn( "SVG: ", $info->{error}, "\n" );
34 0         0 $self->css_pop, return;
35             }
36              
37 8         14 my $mimetype = $info->{mimetype};
38 8         13 my $subtype = $info->{subtype};
39              
40 8 50       19 unless ( $mimetype eq "image" ) {
41 0         0 warn("SVG: Unhandled mime type \"mimetype/$subtype\" in inline image\n");
42 0         0 $self->css_pop, return;
43             }
44 8         54 my $data = $info->{data};
45              
46             # Get info.
47 8         687 require Image::Info;
48 8         2068 $info = Image::Info::image_info(\$data);
49 8 50       24685 if ( $info->{error} ) {
50 0         0 warn($info->{error});
51 0         0 $self->css_pop, return;
52             }
53              
54 8         12 my $format = $info->{file_ext};
55 8 100       22 $format = "jpeg" if $format eq "jpg";
56 8 100       27 $format = "pnm" if $format =~ /^p[bgp]m$/;
57 8 50       18 $format = "pnm" if $format =~ /^x[bp]m$/; # bonus
58 8 100       20 $format = "tiff" if $format eq "tif";
59              
60             # Make the image. Silence missing library warnings.
61 8         9 my $fh;
62             # Also, do not use the fast IPL module, it cannot read from scalar.
63 8 100       18 if ( $format eq "tiff" ) {
64             # TIFF can't read from scalar file handle.
65 2     2   2881 use File::Temp;
  2         25671  
  2         1592  
66 1         7 ( my $fd, $fh ) = File::Temp::tempfile( UNLINK => 1 );
67 1         763 binmode $fd => ':raw';
68 1         111 print $fd $data;
69 1         24 close($fd);
70             # Yes, trickery... $fh is now a file name, not a handle.
71             }
72             else {
73 7         67 open( $fh, '<:raw', \$data );
74             }
75 8         33 $img = $self->root->pdf->image( $fh, format => $format,
76             silent => 1, nouseIPL => 1 );
77             }
78             elsif ( $link =~ m!^.+\.(png|jpe?g|gif)$!i && -s $link ) {
79             # Autodetected. Make the image.
80 5         14 $img = $self->root->pdf->image( $link, silent => 1 );
81             }
82             elsif ( $link =~ m!^.+\.(tiff?|p[bgp]m|x[bp]m)$!i && -s $link ) {
83             # Not autodetected, need format.
84             # Note that xbm and xpm are bonus.
85 5 100       23 my $format = $1 =~ /tif/i ? "tiff" : "pnm";
86             # Make the image.
87 5         18 $img = $self->root->pdf->image( $link, format => $format, silent => 1 );
88             }
89             else {
90 0   0     0 warn("SVG: Unhandled or missing image link: ",
91             "\"$link\""//"", "\n");
92 0         0 return;
93             }
94              
95 18         185508 $self->_dbg( "xo save" );
96 18         153 $xo->save;
97              
98             # Place the image.
99 18 50       940 $self->set_transform($tf) if $tf;
100 18         99 $xo->transform( translate => [ $x, $y+$h ] );
101 18         6105 $xo->image( $img, 0, 0, $w, -$h );
102              
103 18         3660 $self->_dbg( "xo restore" );
104 18         64 $xo->restore;
105 18         601 $self->css_pop;
106             }
107              
108              
109             1;