line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Image::Info::BMP; |
2
|
|
|
|
|
|
|
$VERSION = '1.04'; |
3
|
2
|
|
|
2
|
|
14
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
89
|
|
4
|
|
|
|
|
|
|
|
5
|
2
|
|
|
2
|
|
13
|
use constant _CAN_LITTLE_ENDIAN_PACK => $] >= 5.009002; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
1342
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
sub process_file { |
8
|
4
|
|
|
4
|
1
|
9
|
my($info, $source, $opts) = @_; |
9
|
4
|
|
|
|
|
7
|
my(@comments, @warnings, @header, %info, $buf, $total); |
10
|
|
|
|
|
|
|
|
11
|
4
|
50
|
|
|
|
43
|
read($source, $buf, 54) == 54 or die "Can't reread BMP header: $!"; |
12
|
4
|
|
|
|
|
29
|
@header = unpack((_CAN_LITTLE_ENDIAN_PACK |
13
|
|
|
|
|
|
|
? "vVv2V2Vl
|
14
|
|
|
|
|
|
|
: "vVv2V2V2v2V2V2V2" |
15
|
|
|
|
|
|
|
), $buf); |
16
|
4
|
|
|
|
|
8
|
$total += length($buf); |
17
|
|
|
|
|
|
|
|
18
|
4
|
100
|
66
|
|
|
20
|
if( $header[9] && $header[9] < 24 ){ |
19
|
3
|
|
|
|
|
13
|
$info->push_info(0, "color_type" => "Indexed-RGB"); |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
else{ |
22
|
1
|
|
|
|
|
4
|
$info->push_info(0, "color_type" => "RGB"); |
23
|
|
|
|
|
|
|
} |
24
|
4
|
|
|
|
|
12
|
$info->push_info(0, "file_media_type" => "image/bmp"); |
25
|
4
|
100
|
66
|
|
|
14
|
if( $header[10] == 1 || $header[10] == 2){ |
26
|
3
|
|
|
|
|
7
|
$info->push_info(0, "file_ext" => "rle"); |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
else{ |
29
|
1
|
|
|
|
|
3
|
$info->push_info(0, "file_ext" => "bmp"); # || dib |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
4
|
|
|
|
|
21
|
$info->push_info(0, "height", (_CAN_LITTLE_ENDIAN_PACK |
33
|
|
|
|
|
|
|
? abs($header[7]) |
34
|
|
|
|
|
|
|
: ($header[7] >= 2**31 ? 2**32 - $header[7] : $header[7]) |
35
|
|
|
|
|
|
|
)); |
36
|
4
|
|
|
|
|
16
|
$info->push_info(0, "resolution", "$header[12]/$header[13]"); |
37
|
4
|
|
|
|
|
14
|
$info->push_info(0, "width", $header[6]); |
38
|
4
|
|
|
|
|
11
|
$info->push_info(0, "BitsPerSample" => $header[9]); |
39
|
4
|
|
|
|
|
12
|
$info->push_info(0, "SamplesPerPixel", $header[8]); |
40
|
|
|
|
|
|
|
|
41
|
4
|
|
|
|
|
9
|
$info->push_info(0, "BMP_ColorsImportant", $header[15]); |
42
|
4
|
100
|
|
|
|
17
|
$info->push_info(0, "BMP_Origin", |
43
|
|
|
|
|
|
|
$header[7]>1 ? 1 : 0 ); |
44
|
4
|
|
|
|
|
10
|
$info->push_info(0, "ColorTableSize", $header[14]); |
45
|
4
|
|
|
|
|
13
|
$info->push_info(0, "Compression", [ |
46
|
|
|
|
|
|
|
'none', |
47
|
|
|
|
|
|
|
'RLE8', |
48
|
|
|
|
|
|
|
'RLE4', |
49
|
|
|
|
|
|
|
'BITFIELDS', #V4 |
50
|
|
|
|
|
|
|
'JPEG', #V5 |
51
|
|
|
|
|
|
|
'PNG', #V5 |
52
|
|
|
|
|
|
|
]->[$header[10]]); |
53
|
|
|
|
|
|
|
#Version 5 Header amendments |
54
|
|
|
|
|
|
|
# XXX Discard for now, need a test image |
55
|
4
|
50
|
|
|
|
11
|
if( $header[5] > 40 ){ |
56
|
0
|
|
|
|
|
0
|
read($source, $buf, $header[5]-40); # XXX test |
57
|
0
|
|
|
|
|
0
|
$total += length($buf); |
58
|
0
|
|
|
|
|
0
|
my @v5 = unpack("V38", $buf); |
59
|
0
|
|
|
|
|
0
|
splice(@v5, 5, 27); |
60
|
0
|
|
|
|
|
0
|
$info->push_info(0, "BMP_MaskRed", $v5[0]); |
61
|
0
|
|
|
|
|
0
|
$info->push_info(0, "BMP_MaskGreen", $v5[1]); |
62
|
0
|
|
|
|
|
0
|
$info->push_info(0, "BMP_MaskBlue", $v5[2]); |
63
|
0
|
|
|
|
|
0
|
$info->push_info(0, "BMP_MaskAlpha", $v5[3]); |
64
|
|
|
|
|
|
|
# $info->push_info(0, "BMP_color_type", $v5[4]); |
65
|
0
|
|
|
|
|
0
|
$info->push_info(0, "BMP_GammaRed", $v5[5]); |
66
|
0
|
|
|
|
|
0
|
$info->push_info(0, "BMP_GammaGreen", $v5[6]); |
67
|
0
|
|
|
|
|
0
|
$info->push_info(0, "BMP_GammaBlue", $v5[7]); |
68
|
|
|
|
|
|
|
} |
69
|
4
|
50
|
66
|
|
|
22
|
if( $header[9] < 24 && $opts->{ColorPalette} ){ |
70
|
0
|
|
|
|
|
0
|
my(@color, @palette); |
71
|
0
|
|
|
|
|
0
|
for(my $i=0; $i<$header[14]; $i++){ |
72
|
0
|
0
|
|
|
|
0
|
read($source, $buf, 4) == 4 or die "Can't read: $!"; |
73
|
0
|
|
|
|
|
0
|
$total += length($buf); |
74
|
0
|
|
|
|
|
0
|
@color = unpack("C3", $buf); |
75
|
|
|
|
|
|
|
# Damn M$, BGR instead of RGB |
76
|
0
|
|
|
|
|
0
|
push @palette, sprintf("#%02x%02x%02x", |
77
|
|
|
|
|
|
|
$color[2], $color[1], $color[0]); |
78
|
|
|
|
|
|
|
} |
79
|
0
|
|
|
|
|
0
|
$info->push_info(0, "ColorPalette", @palette); |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
#Verify size # XXX Cheat and do -s if it's an actual file? |
83
|
4
|
|
|
|
|
27
|
while( read($source, $buf, 1024) ){ |
84
|
16
|
|
|
|
|
51
|
$total += length($buf); |
85
|
|
|
|
|
|
|
} |
86
|
4
|
50
|
|
|
|
10
|
if( $header[1] != $total ){ |
87
|
0
|
|
|
|
|
0
|
push @warnings, "Size mismatch." |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
4
|
|
|
|
|
9
|
for (@comments) { |
91
|
0
|
|
|
|
|
0
|
$info->push_info(0, "Comment", $_); |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
4
|
|
|
|
|
16
|
for (@warnings) { |
95
|
0
|
|
|
|
|
|
$info->push_info(0, "Warn", $_); |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
1; |
99
|
|
|
|
|
|
|
__END__ |