line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2
|
|
|
|
|
|
|
# File: WriteRIFF.pl |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Description: Write RIFF-format files |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# Revisions: 2020-09-26 - P. Harvey Created |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# Notes: Currently writes only WEBP files |
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
# References: https://developers.google.com/speed/webp/docs/riff_container |
11
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
package Image::ExifTool::RIFF; |
14
|
|
|
|
|
|
|
|
15
|
1
|
|
|
1
|
|
8
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
2042
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# map of where information is stored in WebP image |
18
|
|
|
|
|
|
|
my %webpMap = ( |
19
|
|
|
|
|
|
|
'XMP ' => 'RIFF', # (the RIFF chunk name is 'XMP ') |
20
|
|
|
|
|
|
|
EXIF => 'RIFF', |
21
|
|
|
|
|
|
|
ICCP => 'RIFF', |
22
|
|
|
|
|
|
|
XMP => 'XMP ', |
23
|
|
|
|
|
|
|
IFD0 => 'EXIF', |
24
|
|
|
|
|
|
|
IFD1 => 'IFD0', |
25
|
|
|
|
|
|
|
ICC_Profile => 'ICCP', |
26
|
|
|
|
|
|
|
ExifIFD => 'IFD0', |
27
|
|
|
|
|
|
|
GPS => 'IFD0', |
28
|
|
|
|
|
|
|
SubIFD => 'IFD0', |
29
|
|
|
|
|
|
|
GlobParamIFD => 'IFD0', |
30
|
|
|
|
|
|
|
PrintIM => 'IFD0', |
31
|
|
|
|
|
|
|
InteropIFD => 'ExifIFD', |
32
|
|
|
|
|
|
|
MakerNotes => 'ExifIFD', |
33
|
|
|
|
|
|
|
); |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
36
|
|
|
|
|
|
|
# Write RIFF file (currently WebP-type only) |
37
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) dirInfo ref |
38
|
|
|
|
|
|
|
# Returns: 1 on success, 0 if this wasn't a valid RIFF file, or -1 if |
39
|
|
|
|
|
|
|
# an output file was specified and a write error occurred |
40
|
|
|
|
|
|
|
sub WriteRIFF($$) |
41
|
|
|
|
|
|
|
{ |
42
|
3
|
|
|
3
|
0
|
11
|
my ($et, $dirInfo) = @_; |
43
|
3
|
50
|
|
|
|
13
|
$et or return 1; # allow dummy access to autoload this package |
44
|
3
|
|
|
|
|
9
|
my $outfile = $$dirInfo{OutFile}; |
45
|
3
|
|
|
|
|
5
|
my $outsize = 0; |
46
|
3
|
|
|
|
|
7
|
my $raf = $$dirInfo{RAF}; |
47
|
3
|
|
|
|
|
10
|
my ($buff, $err, $pass, %has, %dirDat, $imageWidth, $imageHeight); |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# do this in 2 passes so we can set the size of the containing RIFF chunk |
50
|
|
|
|
|
|
|
# without having to buffer the output (also to set the WebP_Flags) |
51
|
3
|
|
|
|
|
8
|
for ($pass=0; ; ++$pass) { |
52
|
6
|
|
|
|
|
10
|
my %doneDir; |
53
|
|
|
|
|
|
|
# verify this is a valid RIFF file |
54
|
6
|
50
|
|
|
|
25
|
return 0 unless $raf->Read($buff, 12) == 12; |
55
|
6
|
50
|
|
|
|
53
|
return 0 unless $buff =~ /^(RIFF|RF64)....(.{4})/s; |
56
|
|
|
|
|
|
|
|
57
|
6
|
50
|
33
|
|
|
53
|
unless ($1 eq 'RIFF' and $2 eq 'WEBP') { |
58
|
0
|
|
|
|
|
0
|
my $type = $2; |
59
|
0
|
|
|
|
|
0
|
$type =~ tr/-_a-zA-Z//dc; |
60
|
0
|
|
|
|
|
0
|
$et->Error("Can't currently write $1 $type files"); |
61
|
0
|
|
|
|
|
0
|
return 1; |
62
|
|
|
|
|
|
|
} |
63
|
6
|
|
|
|
|
27
|
SetByteOrder('II'); |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# determine which directories we must write for this file type |
66
|
6
|
|
|
|
|
30
|
$et->InitWriteDirs(\%webpMap); |
67
|
6
|
|
|
|
|
15
|
my $addDirs = $$et{ADD_DIRS}; |
68
|
6
|
|
|
|
|
16
|
my $editDirs = $$et{EDIT_DIRS}; |
69
|
6
|
|
|
|
|
13
|
my ($createVP8X, $deleteVP8X); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# write header |
72
|
6
|
100
|
|
|
|
29
|
if ($pass) { |
73
|
|
|
|
|
|
|
my $needsVP8X = ($has{ANIM} or $has{'XMP '} or $has{EXIF} or |
74
|
3
|
|
33
|
|
|
32
|
$has{ALPH} or $has{ICCP}); |
75
|
3
|
50
|
33
|
|
|
35
|
if ($has{VP8X} and not $needsVP8X and $$et{CHANGED}) { |
|
|
50
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
76
|
0
|
|
|
|
|
0
|
$deleteVP8X = 1; # delete the VP8X chunk |
77
|
0
|
|
|
|
|
0
|
$outsize -= 18; # account for missing VP8X |
78
|
|
|
|
|
|
|
} elsif ($needsVP8X and not $has{VP8X}) { |
79
|
0
|
0
|
|
|
|
0
|
if (defined $imageWidth) { |
80
|
0
|
|
|
|
|
0
|
++$$et{CHANGED}; |
81
|
0
|
|
|
|
|
0
|
$createVP8X = 1; # add VP8X chunk |
82
|
0
|
|
|
|
|
0
|
$outsize += 18; # account for VP8X size |
83
|
|
|
|
|
|
|
} else { |
84
|
0
|
|
|
|
|
0
|
$et->Warn('Error getting image size for required VP8X chunk'); |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
# finally we can set the overall RIFF chunk size: |
88
|
3
|
|
|
|
|
18
|
Set32u($outsize - 8, \$buff, 4); |
89
|
3
|
50
|
|
|
|
16
|
Write($outfile, $buff) or $err = 1; |
90
|
|
|
|
|
|
|
# create VP8X chunk if necessary |
91
|
3
|
50
|
|
|
|
13
|
if ($createVP8X) { |
92
|
0
|
|
|
|
|
0
|
$et->VPrint(0," Adding required VP8X chunk (Extended WEBP)\n"); |
93
|
0
|
|
|
|
|
0
|
my $flags = 0; |
94
|
0
|
0
|
|
|
|
0
|
$flags |= 0x02 if $has{ANIM}; |
95
|
0
|
0
|
|
|
|
0
|
$flags |= 0x04 if $has{'XMP '}; |
96
|
0
|
0
|
|
|
|
0
|
$flags |= 0x08 if $has{EXIF}; |
97
|
0
|
0
|
|
|
|
0
|
$flags |= 0x10 if $has{ALPH}; |
98
|
0
|
0
|
|
|
|
0
|
$flags |= 0x20 if $has{ICCP}; |
99
|
0
|
|
|
|
|
0
|
Write($outfile, 'VP8X', pack('V3v', 10, $flags, |
100
|
|
|
|
|
|
|
($imageWidth-1) | ((($imageHeight-1) & 0xff) << 24), |
101
|
|
|
|
|
|
|
($imageHeight-1) >> 8)); |
102
|
|
|
|
|
|
|
# write ICCP after VP8X |
103
|
0
|
0
|
0
|
|
|
0
|
Write($outfile, $dirDat{ICCP}) or $err = 1 if $dirDat{ICCP}; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
} else { |
106
|
3
|
|
|
|
|
7
|
$outsize += length $buff; |
107
|
|
|
|
|
|
|
} |
108
|
6
|
|
|
|
|
15
|
my $pos = 12; |
109
|
|
|
|
|
|
|
# |
110
|
|
|
|
|
|
|
# Read chunks in RIFF image |
111
|
|
|
|
|
|
|
# |
112
|
6
|
|
|
|
|
8
|
for (;;) { |
113
|
34
|
|
|
|
|
57
|
my ($tag, $len); |
114
|
34
|
|
|
|
|
96
|
my $num = $raf->Read($buff, 8); |
115
|
34
|
100
|
|
|
|
75
|
if ($num < 8) { |
116
|
8
|
50
|
|
|
|
23
|
$num and $et->Error('RIFF format error'), return 1; |
117
|
|
|
|
|
|
|
# all done if we hit end of file unless we need to add EXIF or XMP |
118
|
8
|
50
|
66
|
|
|
54
|
last unless $$addDirs{EXIF} or $$addDirs{'XMP '} or $$addDirs{ICCP}; |
|
|
|
33
|
|
|
|
|
119
|
|
|
|
|
|
|
# continue to add required EXIF or XMP chunks |
120
|
2
|
|
|
|
|
6
|
$num = $len = 0; |
121
|
2
|
|
|
|
|
5
|
$buff = $tag = ''; |
122
|
|
|
|
|
|
|
} else { |
123
|
26
|
|
|
|
|
40
|
$pos += 8; |
124
|
26
|
|
|
|
|
88
|
($tag, $len) = unpack('a4V', $buff); |
125
|
26
|
50
|
|
|
|
66
|
if ($len <= 0) { |
126
|
0
|
0
|
|
|
|
0
|
if ($len < 0) { |
|
|
0
|
|
|
|
|
|
127
|
0
|
|
|
|
|
0
|
$et->Error('Invalid chunk length'); |
128
|
0
|
|
|
|
|
0
|
return 1; |
129
|
|
|
|
|
|
|
} elsif ($tag eq "\0\0\0\0") { |
130
|
|
|
|
|
|
|
# avoid reading through corrupted files filled with nulls because it takes forever |
131
|
0
|
|
|
|
|
0
|
$et->Error('Encountered empty null chunk. Processing aborted'); |
132
|
0
|
|
|
|
|
0
|
return 1; |
133
|
|
|
|
|
|
|
} else { # (just in case a tag may have no data) |
134
|
0
|
0
|
|
|
|
0
|
if ($pass) { |
135
|
0
|
0
|
|
|
|
0
|
Write($outfile, $buff) or $err = 1; |
136
|
|
|
|
|
|
|
} else { |
137
|
0
|
|
|
|
|
0
|
$outsize += length $buff; |
138
|
|
|
|
|
|
|
} |
139
|
0
|
|
|
|
|
0
|
next; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
# RIFF chunks are padded to an even number of bytes |
144
|
28
|
|
|
|
|
44
|
my $len2 = $len + ($len & 0x01); |
145
|
|
|
|
|
|
|
# edit/add/delete necessary metadata chunks (EXIF must come before XMP) |
146
|
28
|
50
|
100
|
|
|
132
|
if ($$editDirs{$tag} or $tag eq '' or ($tag eq 'XMP ' and $$addDirs{EXIF})) { |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
147
|
10
|
|
|
|
|
21
|
my $handledTag; |
148
|
10
|
100
|
|
|
|
27
|
if ($len2) { |
149
|
8
|
50
|
33
|
|
|
27
|
$et->Warn("Duplicate '${tag}' chunk") if $doneDir{$tag} and not $pass; |
150
|
8
|
|
|
|
|
16
|
$doneDir{$tag} = 1; |
151
|
8
|
50
|
|
|
|
25
|
$raf->Read($buff, $len2) == $len2 or $et->Error("Truncated '${tag}' chunk"), last; |
152
|
8
|
|
|
|
|
13
|
$pos += $len2; # update current position |
153
|
|
|
|
|
|
|
} else { |
154
|
2
|
|
|
|
|
4
|
$buff = ''; |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
# |
157
|
|
|
|
|
|
|
# add/edit/delete EXIF/XMP/ICCP (note: EXIF must come before XMP, and ICCP is written elsewhere) |
158
|
|
|
|
|
|
|
# |
159
|
10
|
|
|
|
|
42
|
my %dirName = ( EXIF => 'IFD0', 'XMP ' => 'XMP', ICCP => 'ICC_Profile' ); |
160
|
10
|
|
|
|
|
51
|
my %tblName = ( EXIF => 'Exif', 'XMP ' => 'XMP', ICCP => 'ICC_Profile' ); |
161
|
10
|
|
|
|
|
19
|
my $dir; |
162
|
10
|
|
|
|
|
20
|
foreach $dir ('EXIF', 'XMP ', 'ICCP' ) { |
163
|
30
|
50
|
66
|
|
|
129
|
next unless $tag eq $dir or ($$addDirs{$dir} and |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
164
|
|
|
|
|
|
|
($tag eq '' or ($tag eq 'XMP ' and $dir eq 'EXIF'))); |
165
|
12
|
|
|
|
|
29
|
delete $$addDirs{$dir}; # (don't try to add again) |
166
|
12
|
|
|
|
|
21
|
my $start; |
167
|
12
|
100
|
|
|
|
31
|
unless ($pass) { |
168
|
|
|
|
|
|
|
# write the EXIF and save the result for the next pass |
169
|
6
|
|
|
|
|
23
|
my $dataPt = \$buff; |
170
|
6
|
100
|
|
|
|
27
|
if ($tag eq 'EXIF') { |
|
|
100
|
|
|
|
|
|
171
|
|
|
|
|
|
|
# (only need to set directory $start for EXIF) |
172
|
2
|
50
|
|
|
|
9
|
if ($buff =~ /^Exif\0\0/) { |
173
|
0
|
0
|
|
|
|
0
|
$et->Warn('Improper EXIF header') unless $pass; |
174
|
0
|
|
|
|
|
0
|
$start = 6; |
175
|
|
|
|
|
|
|
} else { |
176
|
2
|
|
|
|
|
4
|
$start = 0; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
} elsif ($dir ne $tag) { |
179
|
|
|
|
|
|
|
# create from scratch |
180
|
2
|
|
|
|
|
5
|
my $buf2 = ''; |
181
|
2
|
|
|
|
|
5
|
$dataPt = \$buf2; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
# write the new directory to memory |
184
|
|
|
|
|
|
|
my %dirInfo = ( |
185
|
|
|
|
|
|
|
DataPt => $dataPt, |
186
|
|
|
|
|
|
|
DataPos => 0, # (relative to Base) |
187
|
|
|
|
|
|
|
DirStart => $start, |
188
|
|
|
|
|
|
|
Base => $pos - $len2, |
189
|
|
|
|
|
|
|
Parent => $dir, |
190
|
6
|
|
|
|
|
53
|
DirName => $dirName{$dir}, |
191
|
|
|
|
|
|
|
); |
192
|
6
|
|
|
|
|
44
|
my $tagTablePtr = GetTagTable("Image::ExifTool::$tblName{$dir}::Main"); |
193
|
|
|
|
|
|
|
# (override writeProc for EXIF because it has the TIFF header) |
194
|
6
|
100
|
|
|
|
24
|
my $writeProc = $dir eq 'EXIF' ? \&Image::ExifTool::WriteTIFF : undef; |
195
|
6
|
|
|
|
|
32
|
$dirDat{$dir} = $et->WriteDirectory(\%dirInfo, $tagTablePtr, $writeProc); |
196
|
|
|
|
|
|
|
} |
197
|
12
|
50
|
|
|
|
49
|
if (defined $dirDat{$dir}) { |
198
|
12
|
100
|
|
|
|
33
|
if ($dir eq $tag) { |
199
|
8
|
|
|
|
|
18
|
$handledTag = 1; # set flag indicating we edited this tag |
200
|
|
|
|
|
|
|
# increment CHANGED count if we are deleting the directory |
201
|
8
|
100
|
|
|
|
24
|
++$$et{CHANGED} unless length $dirDat{$dir}; |
202
|
|
|
|
|
|
|
} |
203
|
12
|
100
|
|
|
|
29
|
if (length $dirDat{$dir}) { |
204
|
8
|
100
|
|
|
|
19
|
if ($pass) { |
205
|
|
|
|
|
|
|
# write metadata chunk now (but not ICCP because it was added earlier) |
206
|
4
|
50
|
50
|
|
|
16
|
Write($outfile, $dirDat{$dir}) or $err = 1 unless $dir eq 'ICCP'; |
207
|
|
|
|
|
|
|
} else { |
208
|
|
|
|
|
|
|
# preserve (incorrect EXIF) header if it existed |
209
|
4
|
50
|
|
|
|
13
|
my $hdr = $start ? substr($buff,0,$start) : ''; |
210
|
|
|
|
|
|
|
# (don't overwrite $len here because it may be XMP length) |
211
|
4
|
|
|
|
|
14
|
my $dirLen = length($dirDat{$dir}) + length($hdr); |
212
|
|
|
|
|
|
|
# add chunk header and padding |
213
|
4
|
50
|
|
|
|
13
|
my $pad = $dirLen & 0x01 ? "\0" : ''; |
214
|
4
|
|
|
|
|
28
|
$dirDat{$dir} = $dir . Set32u($dirLen) . $hdr . $dirDat{$dir} . $pad; |
215
|
4
|
|
|
|
|
12
|
$outsize += length($dirDat{$dir}); |
216
|
4
|
|
|
|
|
20
|
$has{$dir} = 1; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
# |
222
|
|
|
|
|
|
|
# just copy XMP, EXIF or ICC if nothing changed |
223
|
|
|
|
|
|
|
# |
224
|
10
|
50
|
66
|
|
|
36
|
if (not $handledTag and length $buff) { |
225
|
|
|
|
|
|
|
# write the chunk without changes |
226
|
0
|
0
|
|
|
|
0
|
if ($pass) { |
227
|
0
|
0
|
|
|
|
0
|
Write($outfile, $tag, Set32u($len), $buff) or $err = 1; |
228
|
|
|
|
|
|
|
} else { |
229
|
0
|
|
|
|
|
0
|
$outsize += 8 + length($buff); |
230
|
0
|
|
|
|
|
0
|
$has{$tag} = 1; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
} |
233
|
10
|
|
|
|
|
38
|
next; |
234
|
|
|
|
|
|
|
} |
235
|
18
|
|
|
|
|
28
|
$pos += $len2; # set read position at end of chunk data |
236
|
|
|
|
|
|
|
# |
237
|
|
|
|
|
|
|
# update necessary flags in VP8X chunk |
238
|
|
|
|
|
|
|
# |
239
|
18
|
100
|
|
|
|
43
|
if ($tag eq 'VP8X') { |
240
|
6
|
|
|
|
|
10
|
my $buf2; |
241
|
6
|
50
|
33
|
|
|
29
|
if ($len2 < 10 or $raf->Read($buf2, $len2) != $len2) { |
242
|
0
|
|
|
|
|
0
|
$et->Error('Truncated VP8X chunk'); |
243
|
0
|
|
|
|
|
0
|
return 1; |
244
|
|
|
|
|
|
|
} |
245
|
6
|
100
|
|
|
|
20
|
if ($pass) { |
246
|
3
|
50
|
|
|
|
10
|
if ($deleteVP8X) { |
247
|
0
|
|
|
|
|
0
|
$et->VPrint(0," Deleting unnecessary VP8X chunk (Standard WEBP)\n"); |
248
|
0
|
|
|
|
|
0
|
next; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
# ...but first set the VP8X flags |
251
|
3
|
|
|
|
|
13
|
my $flags = Get32u(\$buf2, 0); |
252
|
3
|
|
|
|
|
8
|
$flags &= ~0x2c; # (reset flags for everything we can write) |
253
|
3
|
100
|
|
|
|
15
|
$flags |= 0x04 if $has{'XMP '}; |
254
|
3
|
100
|
|
|
|
10
|
$flags |= 0x08 if $has{EXIF}; |
255
|
3
|
50
|
|
|
|
11
|
$flags |= 0x20 if $has{ICCP}; |
256
|
3
|
|
|
|
|
13
|
Set32u($flags, \$buf2, 0); |
257
|
3
|
50
|
|
|
|
11
|
Write($outfile, $buff, $buf2) or $err = 1; |
258
|
|
|
|
|
|
|
} else { |
259
|
|
|
|
|
|
|
# get the image size |
260
|
3
|
|
|
|
|
13
|
$imageWidth = (Get32u(\$buf2, 4) & 0xffffff) + 1; |
261
|
3
|
|
|
|
|
10
|
$imageHeight = (Get32u(\$buf2, 6) >> 8) + 1; |
262
|
3
|
|
|
|
|
7
|
$outsize += 8 + $len2; |
263
|
3
|
|
|
|
|
10
|
$has{$tag} = 1; |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
# write ICCP after VP8X |
266
|
6
|
50
|
0
|
|
|
22
|
Write($outfile, $dirDat{ICCP}) or $err = 1 if $dirDat{ICCP}; |
267
|
6
|
|
|
|
|
12
|
next; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
# |
270
|
|
|
|
|
|
|
# just copy all other chunks |
271
|
|
|
|
|
|
|
# |
272
|
12
|
100
|
|
|
|
31
|
if ($pass) { |
273
|
|
|
|
|
|
|
# write chunk header (still in $buff) |
274
|
6
|
50
|
|
|
|
17
|
Write($outfile, $buff) or $err = 1; |
275
|
|
|
|
|
|
|
} else { |
276
|
6
|
|
|
|
|
12
|
$outsize += length $buff; |
277
|
6
|
|
|
|
|
15
|
$has{$tag} = 1; |
278
|
|
|
|
|
|
|
} |
279
|
12
|
50
|
66
|
|
|
45
|
unless ($pass or defined $imageWidth) { |
280
|
|
|
|
|
|
|
# get WebP image size from VP8 or VP8L header |
281
|
0
|
0
|
0
|
|
|
0
|
if ($tag eq 'VP8 ' and $len2 >= 16) { |
|
|
0
|
0
|
|
|
|
|
282
|
0
|
0
|
|
|
|
0
|
$raf->Read($buff, 16) == 16 or $et->Error('Truncated VP8 chunk'), return 1; |
283
|
0
|
|
|
|
|
0
|
$outsize += 16; |
284
|
0
|
0
|
|
|
|
0
|
if ($buff =~ /^...\x9d\x01\x2a/s) { |
285
|
0
|
|
|
|
|
0
|
$imageWidth = Get16u(\$buff, 6) & 0x3fff; |
286
|
0
|
|
|
|
|
0
|
$imageHeight = Get16u(\$buff, 8) & 0x3fff; |
287
|
|
|
|
|
|
|
} |
288
|
0
|
|
|
|
|
0
|
$len2 -= 16; |
289
|
|
|
|
|
|
|
} elsif ($tag eq 'VP8L' and $len2 >= 6) { |
290
|
0
|
0
|
|
|
|
0
|
$raf->Read($buff, 6) == 6 or $et->Error('Truncated VP8L chunk'), return 1; |
291
|
0
|
|
|
|
|
0
|
$outsize += 6; |
292
|
0
|
0
|
|
|
|
0
|
if ($buff =~ /^\x2f/s) { |
293
|
0
|
|
|
|
|
0
|
$imageWidth = (Get16u(\$buff, 1) & 0x3fff) + 1; |
294
|
0
|
|
|
|
|
0
|
$imageHeight = ((Get32u(\$buff, 2) >> 6) & 0x3fff) + 1; |
295
|
|
|
|
|
|
|
} |
296
|
0
|
|
|
|
|
0
|
$len2 -= 6; |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
} |
299
|
12
|
100
|
|
|
|
41
|
if ($pass) { |
300
|
|
|
|
|
|
|
# copy the chunk data in 64k blocks |
301
|
6
|
|
|
|
|
15
|
while ($len2) { |
302
|
6
|
|
|
|
|
12
|
my $num = $len2; |
303
|
6
|
50
|
|
|
|
15
|
$num = 65536 if $num > 65536; |
304
|
6
|
50
|
|
|
|
18
|
$raf->Read($buff, $num) == $num or $et->Error('Truncated RIFF chunk'), last; |
305
|
6
|
50
|
|
|
|
14
|
Write($outfile, $buff) or $err = 1, last; |
306
|
6
|
|
|
|
|
17
|
$len2 -= $num; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
} else { |
309
|
6
|
50
|
|
|
|
19
|
$raf->Seek($len2, 1) or $et->Error('Seek error'), last; |
310
|
6
|
|
|
|
|
16
|
$outsize += $len2; |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
} |
313
|
6
|
100
|
|
|
|
19
|
last if $pass; |
314
|
3
|
50
|
|
|
|
16
|
$raf->Seek(0,0) or $et->Error('Seek error'), last; |
315
|
|
|
|
|
|
|
} |
316
|
3
|
50
|
|
|
|
33
|
return $err ? -1 : 1; |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
1; # end |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
__END__ |