File Coverage

lib/Image/Info/ICO.pm
Criterion Covered Total %
statement 18 22 81.8
branch 3 6 50.0
condition n/a
subroutine 2 2 100.0
pod 0 1 0.0
total 23 31 74.1


line stmt bran cond sub pod time code
1             package Image::Info::ICO;
2             $VERSION = '0.02';
3              
4             # Copyright (C) 2009 Slaven Rezic. All rights reserved.
5             # This package is free software; you can redistribute it and/or
6             # modify it under the same terms as Perl itself.
7              
8 2     2   13 use strict;
  2         5  
  2         551  
9              
10             sub process_file {
11 3     3 0 8 my($info, $fh) = @_;
12              
13 3         5 my $buf;
14 3 50       34 if (read($fh, $buf, 6) != 6) {
15 0         0 $info->push_info(0, 'error' => 'Short read (expected at least 6 bytes)');
16 0         0 return;
17             }
18              
19 3         14 $info->push_info(0, 'file_media_type' => 'image/x-icon'); # XXX or is there already an official vnd format?
20 3         8 $info->push_info(0, 'file_ext' => 'ico');
21              
22 3         13 my($no_icons) = unpack('v', substr($buf, 4, 2));
23              
24 3         13 for my $img_no (0 .. $no_icons-1) {
25 6 50       19 if (read($fh, $buf, 16) != 16) {
26 0         0 $info->push_info(0, 'error' => "Short read while getting information for image at index $img_no");
27 0         0 return;
28             }
29 6         17 my($width,
30             $height,
31             $colors,
32             undef, # reserved
33             undef, # $planes
34             undef, # $bitcount
35             undef, # $size_in_bytes
36             undef, # $file_offset
37             ) = unpack('CCCCvvVV', $buf);
38 6 50       17 if ($colors == 0) { $colors = 256 }
  6         7  
39              
40 6         16 $info->push_info($img_no, 'width', $width);
41 6         13 $info->push_info($img_no, 'height', $height);
42 6         13 $info->push_info($img_no, 'color_type', 'Indexed-RGB');
43 6         12 $info->push_info($img_no, 'colors', $colors);
44             }
45             }
46              
47             1;
48              
49             __END__