File Coverage

lib/Image/Info/XBM.pm
Criterion Covered Total %
statement 22 25 88.0
branch 1 2 50.0
condition n/a
subroutine 3 4 75.0
pod 1 1 100.0
total 27 32 84.3


line stmt bran cond sub pod time code
1             package Image::Info::XBM;
2             $VERSION = '1.08';
3 2     2   12 use strict;
  2         4  
  2         98  
4 2     2   13 use Image::Xbm 1.07;
  2         39  
  2         607  
5              
6             sub process_file {
7 5     5 1 11 my($info, $source, $opts) = @_;
8              
9             local $SIG{__WARN__} = sub {
10 0     0   0 $info->push_info(0, "Warn", shift);
11 5         36 };
12              
13 5         28 my $i = Image::Xbm->new(-width => 0, -height => 0);
14             # loading the file as a separate step avoids a "-r" test, this would
15             # file with in-memory strings (aka fake files)
16 5         518 $i->load($source);
17              
18 5         2061 $info->push_info(0, "color_type" => "Grey");
19 5         15 $info->push_info(0, "file_ext" => "xbm");
20 5         14 $info->push_info(0, "file_media_type" => "image/x-xbitmap");
21 5         16 $info->push_info(0, "height", $i->get(-height));
22 5         21 $info->push_info(0, "resolution", "1/1");
23 5         10 $info->push_info(0, "width", $i->get(-width));
24 5         18 $info->push_info(0, "BitsPerSample" => 1);
25 5         15 $info->push_info(0, "SamplesPerPixel", 1);
26              
27 5         15 $info->push_info(0, "ColorTableSize" => 2 );
28 5 50       18 if( $opts->{L1D_Histogram} ){
29             #Do Histogram
30 0         0 my $imgdata = $i->as_binstring();
31 0         0 $info->push_info(0, "L1D_Histogram", [$imgdata =~ tr/0//d,
32             $imgdata =~ tr/1//d ]);
33             }
34 5         14 $info->push_info(0, "HotSpotX" => $i->get(-hotx) );
35 5         16 $info->push_info(0, "HotSpotY" => $i->get(-hoty) );
36             }
37             1;
38             __END__