File Coverage

lib/ChordPro/lib/SVGPDF/Image.pm
Criterion Covered Total %
statement 14 72 19.4
branch 0 30 0.0
condition 0 19 0.0
subroutine 5 6 83.3
pod 0 1 0.0
total 19 128 14.8


line stmt bran cond sub pod time code
1             #! perl
2              
3 10     10   132 use v5.26;
  10         49  
4 10     10   58 use Object::Pad;
  10         28  
  10         73  
5 10     10   1453 use utf8;
  10         25  
  10         71  
6 10     10   483 use Carp;
  10         25  
  10         2794  
7              
8             class SVGPDF::Image :isa(SVGPDF::Element);
9              
10 0     0 0   method process () {
  0            
  0            
11 0           my $atts = $self->atts;
12 0           my $xo = $self->xo;
13 0 0         return if $atts->{omit}; # for testing/debugging.
14              
15 0           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 0   0       $x ||= 0; $y ||= 0;
  0   0        
19 0   0       $w ||= 0; $h ||= 0;
  0   0        
20              
21 0 0 0       unless ( $w && $h ) {
22 0           $self->_dbg( $self->name, " x=$x y=$y w=$w h=$h **skipped**" );
23 0           return;
24             }
25              
26 0           $self->_dbg( $self->name, " x=$x y=$y w=$w h=$h" );
27              
28 0           my $img;
29 0 0 0       if ( $link =~ /^data:/ ) {
    0 0        
    0          
30             # In-line image asset.
31 0           my $info = $self->data_inline($link);
32 0 0         if ( $info->{error} ) {
33 0           warn( "SVG: ", $info->{error}, "\n" );
34 0           $self->css_pop, return;
35             }
36              
37 0           my $mimetype = $info->{mimetype};
38 0           my $subtype = $info->{subtype};
39              
40 0 0         unless ( $mimetype eq "image" ) {
41 0           warn("SVG: Unhandled mime type \"mimetype/$subtype\" in inline image\n");
42 0           $self->css_pop, return;
43             }
44 0           my $data = $info->{data};
45              
46             # Get info.
47 0           require Image::Info;
48 0           $info = Image::Info::image_info(\$data);
49 0 0         if ( $info->{error} ) {
50 0           warn($info->{error});
51 0           $self->css_pop, return;
52             }
53              
54 0           my $format = $info->{file_ext};
55 0 0         $format = "jpeg" if $format eq "jpg";
56 0 0         $format = "pnm" if $format =~ /^p[bgp]m$/;
57 0 0         $format = "pnm" if $format =~ /^x[bp]m$/; # bonus
58 0 0         $format = "tiff" if $format eq "tif";
59              
60             # Make the image. Silence missing library warnings.
61 0           my $fh;
62             # Also, do not use the fast IPL module, it cannot read from scalar.
63 0 0         if ( $format eq "tiff" ) {
64             # TIFF can't read from scalar file handle.
65 10     10   14037 use File::Temp;
  10         27  
  10         11496  
66 0           ( my $fd, $fh ) = File::Temp::tempfile( UNLINK => 1 );
67 0           binmode $fd => ':raw';
68 0           print $fd $data;
69 0           close($fd);
70             # Yes, trickery... $fh is now a file name, not a handle.
71             }
72             else {
73 0           open( $fh, '<:raw', \$data );
74             }
75 0           $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 0           $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 0 0         my $format = $1 =~ /tif/i ? "tiff" : "pnm";
86             # Make the image.
87 0           $img = $self->root->pdf->image( $link, format => $format, silent => 1 );
88             }
89             else {
90 0   0       warn("SVG: Unhandled or missing image link: ",
91             "\"$link\""//"", "\n");
92 0           return;
93             }
94              
95 0           $self->_dbg( "xo save" );
96 0           $xo->save;
97              
98             # Place the image.
99 0 0         $self->set_transform($tf) if $tf;
100 0           $xo->transform( translate => [ $x, $y+$h ] );
101 0           $xo->image( $img, 0, 0, $w, -$h );
102              
103 0           $self->_dbg( "xo restore" );
104 0           $xo->restore;
105 0           $self->css_pop;
106             }
107              
108              
109             1;