File Coverage

blib/lib/App/PDF/Link/Icons.pm
Criterion Covered Total %
statement 47 58 81.0
branch 15 30 50.0
condition n/a
subroutine 9 9 100.0
pod 0 1 0.0
total 71 98 72.4


line stmt bran cond sub pod time code
1             #! perl
2              
3 2     2   298043 use strict;
  2         12  
  2         58  
4 2     2   11 use warnings;
  2         3  
  2         52  
5 2     2   9 use utf8;
  2         4  
  2         10  
6              
7             package App::PDF::Link::Icons;
8              
9 2     2   62 use Carp;
  2         3  
  2         142  
10 2     2   469 use parent qw(Exporter);
  2         331  
  2         20  
11              
12             our @EXPORT = qw( load_icon_images get_icon );
13              
14             my %icons;
15              
16             sub _load_icon_images {
17              
18 2     2   2980 my ( $env, $pdf ) = @_;
19              
20 2         13 my %idef =
21             ( mscz => 'builtin:MuseScore',
22             html => 'builtin:iRealPro',
23             sib => 'builtin:Sibelius',
24             xml => 'builtin:XML',
25             abc => 'builtin:ABC',
26             );
27              
28 2 100       8 if ( $env->{all} ) {
29 1         4 $idef{biab} = 'builtin:BandInABox';
30 1         3 $idef{jpg} = 'builtin:JPG';
31 1         4 $idef{png} = 'builtin:PNG';
32 1         2 $idef{pdf} = 'builtin:PDF';
33             }
34 2         4 foreach ( keys %{ $env->{icons} } ) {
  2         11  
35 0 0       0 if ( $env->{icons}->{$_} ) {
36 0         0 $idef{$_} = $env->{icons}->{$_};
37             }
38             else {
39 0         0 delete( $idef{$_} );
40             }
41             }
42 2 100       8 $idef{' fallback'} = 'builtin:Document' if $env->{all};
43              
44 2         11 while ( my ( $type, $file ) = each %idef ) {
45 15 50       170 if ( $file =~ /^builtin:(.*)/ ) {
46 15         1987 my $data
47             = eval( "require " . __PACKAGE__ . "::" . $1 . ";" .
48             "\\" . __PACKAGE__ . "::" . $1 . "::" . "icon();" );
49 15 50       94 croak("No icon data for $file") unless $data;
50 15     1   272 open( my $fd, '<:raw', $data );
  1         6  
  1         16  
  1         6  
51 15         802 my $p = $pdf->image_png($fd);
52 15         27319048 close($fd);
53 15         72 $icons{$type} = $p;
54 15 100       502 if ( $type eq 'jpg' ) {
    50          
    100          
55 1         17 $icons{jpeg} = $p;
56             }
57             elsif ( $type eq 'jpeg' ) {
58 0         0 $icons{jpg} = $p;
59             }
60             elsif ( $type eq 'biab' ) {
61 1         5 for my $t ( qw( s m ) ) {
62 2         4 for my $i ( 0 .. 9, 'u' ) {
63 22         70 $icons{sprintf("%sg%s", $t, $i)} = $p;
64             }
65             }
66             }
67             }
68             else {
69 0 0       0 croak("$file: $!") unless -r $file;
70 0 0       0 if ( $file =~ /\.png$/i ) {
    0          
    0          
71 0         0 $icons{$type} = $pdf->image_png($file);
72             }
73             elsif ( $file =~ /\.jpe?g$/i ) {
74 0         0 $icons{$type} = $pdf->image_jpeg($file);
75             }
76             elsif ( $file =~ /\.gif$/i ) {
77 0         0 $icons{$type} = $pdf->image_gif($file);
78             }
79             else {
80 0         0 croak("$file: Unsupported file type");
81             }
82             }
83             }
84              
85 2         13 return;
86             }
87              
88             sub get_icon {
89 2     2 0 711 my ( $env, $pdf, $ext ) = ( $_[0], $_[1], lc($_[2]) );
90              
91 2 50       6 _load_icon_images( $env, $pdf ) unless %icons;
92              
93 2 100       10 return $icons{$ext} if $icons{$ext};
94 1 50       5 return $icons{' fallback'} if defined $icons{' fallback'};
95 0         0 return;
96             }
97              
98             # For testing.
99 2     2   17 sub __icons { \%icons };
100              
101             1;