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 3     3   4303 use strict;
  3         4  
  3         119  
4 3     3   832 use Image::Xbm 1.07;
  3         4733  
  3         666  
5              
6             sub process_file {
7 5     5 1 10 my($info, $source, $opts) = @_;
8              
9             local $SIG{__WARN__} = sub {
10 0     0   0 $info->push_info(0, "Warn", shift);
11 5         40 };
12              
13 5         34 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         548 $i->load($source);
17              
18 5         1993 $info->push_info(0, "color_type" => "Grey");
19 5         11 $info->push_info(0, "file_ext" => "xbm");
20 5         10 $info->push_info(0, "file_media_type" => "image/x-xbitmap");
21 5         14 $info->push_info(0, "height", $i->get(-height));
22 5         15 $info->push_info(0, "resolution", "1/1");
23 5         12 $info->push_info(0, "width", $i->get(-width));
24 5         14 $info->push_info(0, "BitsPerSample" => 1);
25 5         11 $info->push_info(0, "SamplesPerPixel", 1);
26              
27 5         10 $info->push_info(0, "ColorTableSize" => 2 );
28 5 50       14 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         15 $info->push_info(0, "HotSpotX" => $i->get(-hotx) );
35 5         19 $info->push_info(0, "HotSpotY" => $i->get(-hoty) );
36             }
37             1;
38             __END__
39              
40             =head1 NAME
41              
42             Image::Info::XBM - XBM support for Image::Info
43              
44             =head1 SYNOPSIS
45              
46             use Image::Info qw(image_info dim);
47              
48             my $info = image_info("image.xbm");
49             if (my $error = $info->{error}) {
50             die "Can't parse image info: $error\n";
51             }
52             my $color = $info->{color_type};
53              
54             my($w, $h) = dim($info);
55              
56             =head1 DESCRIPTION
57              
58             This modules supplies the standard key names
59             except for Compression, Gamma, Interlace, LastModificationTime, as well as:
60              
61             =over
62              
63             =item HotSpotX
64              
65             The x-coord of the image's hotspot.
66             Set to -1 if there is no hotspot.
67              
68             =item HotSpotY
69              
70             The y-coord of the image's hotspot.
71             Set to -1 if there is no hotspot.
72              
73             =item L1D_Histogram
74              
75             Reference to an array representing a one dimensional luminance
76             histogram. This key is only present if C<image_info> is invoked
77             as C<image_info($file, L1D_Histogram=E<gt>1)>. The range is from 0 to 1.
78              
79             =back
80              
81             =head1 METHODS
82              
83             =head2 process_file()
84            
85             $info->process_file($source, $options);
86              
87             Processes one file and sets the found info fields in the C<$info> object.
88              
89             =head1 AUTHOR
90              
91             =head1 FILES
92              
93             This module requires L<Image::Xbm>
94              
95             =head1 SEE ALSO
96              
97             L<Image::Info>, L<Image::Xbm>
98              
99             =head1 NOTES
100              
101             For more information about XBM see
102             L<http://www.martinreddy.net/gfx/2d/XBM.txt>.
103              
104             =head1 AUTHOR
105              
106             Jerrad Pierce <belg4mit@mit.edu>/<webmaster@pthbb.org>
107              
108             Tels - (c) 2006
109              
110             Current maintainer: Slaven Rezic <srezic@cpan.org>
111              
112             This library is free software; you can redistribute it and/or
113             modify it under the same terms as Perl itself.
114              
115             =cut
116              
117             =begin register
118              
119             MAGIC: /^(?:\/\*.*\*\/\n)?#define\s/
120              
121             See L<Image::Info::XBM> for details.
122              
123             =end register
124              
125             =cut