File Coverage

blib/lib/Image/ExifTool/GIF.pm
Criterion Covered Total %
statement 177 241 73.4
branch 111 240 46.2
condition 26 87 29.8
subroutine 4 4 100.0
pod 0 1 0.0
total 318 573 55.5


line stmt bran cond sub pod time code
1             #------------------------------------------------------------------------------
2             # File: GIF.pm
3             #
4             # Description: Read and write GIF meta information
5             #
6             # Revisions: 10/18/2005 - P. Harvey Separated from ExifTool.pm
7             # 05/23/2008 - P. Harvey Added ability to read/write XMP
8             # 10/28/2011 - P. Harvey Added ability to read/write ICC_Profile
9             #
10             # References: 1) http://www.w3.org/Graphics/GIF/spec-gif89a.txt
11             # 2) http://www.adobe.com/devnet/xmp/
12             # 3) http://graphcomp.com/info/specs/ani_gif.html
13             # 4) http://www.color.org/icc_specs2.html
14             # 5) http://www.midiox.com/mmgif.htm
15             #------------------------------------------------------------------------------
16              
17             package Image::ExifTool::GIF;
18              
19 1     1   4405 use strict;
  1         2  
  1         34  
20 1     1   5 use vars qw($VERSION);
  1         2  
  1         41  
21 1     1   5 use Image::ExifTool qw(:DataAccess :Utils);
  1         2  
  1         3116  
22              
23             $VERSION = '1.19';
24              
25             # road map of directory locations in GIF images
26             my %gifMap = (
27             XMP => 'GIF',
28             ICC_Profile => 'GIF',
29             );
30              
31             %Image::ExifTool::GIF::Main = (
32             GROUPS => { 2 => 'Image' },
33             VARS => { NO_ID => 1 },
34             NOTES => q{
35             This table lists information extracted from GIF images. See
36             L for the official GIF89a
37             specification.
38             },
39             GIFVersion => { },
40             FrameCount => { Notes => 'number of animated images' },
41             Text => { Notes => 'text displayed in image' },
42             Comment => {
43             # for documentation only -- flag as writable for the docs, but
44             # it won't appear in the TagLookup because there is no WRITE_PROC
45             Writable => 2,
46             },
47             Duration => {
48             Notes => 'duration of a single animation iteration',
49             PrintConv => 'sprintf("%.2f s",$val)',
50             },
51             ScreenDescriptor => {
52             SubDirectory => { TagTable => 'Image::ExifTool::GIF::Screen' },
53             },
54             Extensions => { # (for documentation only)
55             SubDirectory => { TagTable => 'Image::ExifTool::GIF::Extensions' },
56             },
57             TransparentColor => { },
58             );
59              
60             # GIF89a application extensions:
61             %Image::ExifTool::GIF::Extensions = (
62             GROUPS => { 2 => 'Image' },
63             NOTES => 'Tags extracted from GIF89a application extensions.',
64             'NETSCAPE/2.0' => { #3
65             Name => 'Animation',
66             SubDirectory => { TagTable => 'Image::ExifTool::GIF::Animation' },
67             },
68             'XMP Data/XMP' => { #2
69             Name => 'XMP',
70             IncludeLengthBytes => 1, # length bytes are included in the data
71             Writable => 2,
72             SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
73             },
74             'ICCRGBG1/012' => { #4
75             Name => 'ICC_Profile',
76             Writable => 2,
77             SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main' },
78             },
79             'MIDICTRL/Jon' => { #5
80             Name => 'MIDIControl',
81             SubDirectory => { TagTable => 'Image::ExifTool::GIF::MIDIControl' },
82             },
83             'MIDISONG/Dm7' => { #5
84             Name => 'MIDISong',
85             Groups => { 2 => 'Audio' },
86             Binary => 1,
87             },
88             );
89              
90             # GIF locical screen descriptor
91             %Image::ExifTool::GIF::Screen = (
92             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
93             GROUPS => { 2 => 'Image' },
94             NOTES => 'Information extracted from the GIF logical screen descriptor.',
95             0 => {
96             Name => 'ImageWidth',
97             Format => 'int16u',
98             },
99             2 => {
100             Name => 'ImageHeight',
101             Format => 'int16u',
102             },
103             4.1 => {
104             Name => 'HasColorMap',
105             Mask => 0x80,
106             PrintConv => { 0 => 'No', 1 => 'Yes' },
107             },
108             4.2 => {
109             Name => 'ColorResolutionDepth',
110             Mask => 0x70,
111             ValueConv => '$val + 1',
112             },
113             4.3 => {
114             Name => 'BitsPerPixel',
115             Mask => 0x07,
116             ValueConv => '$val + 1',
117             },
118             5 => 'BackgroundColor',
119             6 => {
120             Name => 'PixelAspectRatio',
121             RawConv => '$val ? $val : undef',
122             ValueConv => '($val + 15) / 64',
123             },
124             );
125              
126             # GIF Netscape 2.0 animation extension (ref 3)
127             %Image::ExifTool::GIF::Animation = (
128             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
129             GROUPS => { 2 => 'Image' },
130             NOTES => 'Information extracted from the "NETSCAPE2.0" animation extension.',
131             1 => {
132             Name => 'AnimationIterations',
133             Format => 'int16u',
134             PrintConv => '$val ? $val : "Infinite"',
135             },
136             );
137              
138             # GIF MIDICTRL extension (ref 5)
139             %Image::ExifTool::GIF::MIDIControl = (
140             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
141             GROUPS => { 2 => 'Audio' },
142             NOTES => 'Information extracted from the MIDI control block extension.',
143             0 => 'MIDIControlVersion',
144             1 => 'SequenceNumber',
145             2 => 'MelodicPolyphony',
146             3 => 'PercussivePolyphony',
147             4 => {
148             Name => 'ChannelUsage',
149             Format => 'int16u',
150             PrintConv => 'sprintf("0x%.4x", $val)',
151             },
152             6 => {
153             Name => 'DelayTime',
154             Format => 'int16u',
155             ValueConv => '$val / 100',
156             PrintConv => '$val . " s"',
157             },
158             );
159              
160             #------------------------------------------------------------------------------
161             # Process meta information in GIF image
162             # Inputs: 0) ExifTool object reference, 1) Directory information ref
163             # Returns: 1 on success, 0 if this wasn't a valid GIF file, or -1 if
164             # an output file was specified and a write error occurred
165             sub ProcessGIF($$)
166             {
167 7     7 0 22 my ($et, $dirInfo) = @_;
168 7         18 my $outfile = $$dirInfo{OutFile};
169 7         19 my $raf = $$dirInfo{RAF};
170 7         29 my $verbose = $et->Options('Verbose');
171 7         20 my $out = $et->Options('TextOut');
172 7         40 my ($a, $s, $ch, $length, $buff);
173 7         0 my ($err, $newComment, $setComment, $nvComment);
174 7         0 my ($addDirs, %doneDir);
175 7         20 my ($frameCount, $delayTime) = (0, 0);
176              
177             # verify this is a valid GIF file
178 7 50 33     27 return 0 unless $raf->Read($buff, 6) == 6
      33        
179             and $buff =~ /^GIF(8[79]a)$/
180             and $raf->Read($s, 7) == 7;
181              
182 7         23 my $ver = $1;
183 7         17 my $rtnVal = 0;
184 7         26 my $tagTablePtr = GetTagTable('Image::ExifTool::GIF::Main');
185 7         34 SetByteOrder('II');
186              
187 7 100       20 if ($outfile) {
188 3         25 $et->InitWriteDirs(\%gifMap, 'XMP'); # make XMP the preferred group for GIF
189 3         10 $addDirs = $$et{ADD_DIRS};
190             # determine if we are editing the File:Comment tag
191 3         11 my $delGroup = $$et{DEL_GROUP};
192 3         13 $newComment = $et->GetNewValue('Comment', \$nvComment);
193 3 50 33     14 $setComment = 1 if $nvComment or $$delGroup{File};
194             # change to GIF 89a if adding comment, XMP or ICC_Profile
195 3 0 33     26 $buff = 'GIF89a' if $$addDirs{XMP} or $$addDirs{ICC_Profile} or defined $newComment;
      0        
196 3 50       16 Write($outfile, $buff, $s) or $err = 1;
197             } else {
198 4         25 $et->SetFileType(); # set file type
199 4         20 $et->HandleTag($tagTablePtr, 'GIFVersion', $ver);
200 4         17 $et->HandleTag($tagTablePtr, 'ScreenDescriptor', $s);
201             }
202 7         33 my $flags = Get8u(\$s, 4);
203 7 50       27 if ($flags & 0x80) { # does this image contain a color table?
204             # calculate color table size
205 7         50 $length = 3 * (2 << ($flags & 0x07));
206 7 50       28 $raf->Read($buff, $length) == $length or return 0; # skip color table
207 7 100 50     32 Write($outfile, $buff) or $err = 1 if $outfile;
208             }
209             #
210             # loop through GIF blocks
211             #
212             Block:
213 7         18 for (;;) {
214 33 50       100 last unless $raf->Read($ch, 1);
215             # write out any new metadata now if this isn't an extension block
216 33 100 100     122 if ($outfile and ord($ch) != 0x21) {
217             # write the comment first if necessary
218 6 0 33     15 if (defined $newComment and $$nvComment{IsCreating}) {
219             # write comment marker
220 0 0       0 Write($outfile, "\x21\xfe") or $err = 1;
221 0 0       0 $verbose and print $out " + Comment = $newComment\n";
222 0         0 my $len = length($newComment);
223             # write out the comment in 255-byte chunks, each
224             # chunk beginning with a length byte
225 0         0 my $n;
226 0         0 for ($n=0; $n<$len; $n+=255) {
227 0         0 my $size = $len - $n;
228 0 0       0 $size > 255 and $size = 255;
229 0         0 my $str = substr($newComment,$n,$size);
230 0 0       0 Write($outfile, pack('C',$size), $str) or $err = 1;
231             }
232 0 0       0 Write($outfile, "\0") or $err = 1; # empty chunk as terminator
233 0         0 undef $newComment;
234 0         0 undef $nvComment; # delete any other extraneous comments
235 0         0 ++$$et{CHANGED}; # increment file changed flag
236             }
237             # add application extension containing XMP block if necessary
238             # (this will place XMP before the first non-extension block)
239 6 50 33     31 if (exists $$addDirs{XMP} and not defined $doneDir{XMP}) {
240 0         0 $doneDir{XMP} = 1;
241             # write new XMP data
242 0         0 my $xmpTable = GetTagTable('Image::ExifTool::XMP::Main');
243 0         0 my %dirInfo = ( Parent => 'GIF' );
244 0 0       0 $verbose and print $out "Creating XMP application extension block:\n";
245 0         0 $buff = $et->WriteDirectory(\%dirInfo, $xmpTable);
246 0 0 0     0 if (defined $buff and length $buff) {
247 0         0 my $lz = pack('C*',1,reverse(0..255),0);
248 0 0       0 Write($outfile, "\x21\xff\x0bXMP DataXMP", $buff, $lz) or $err = 1;
249 0         0 ++$doneDir{XMP}; # set to 2 to indicate we added XMP
250             } else {
251 0 0       0 $verbose and print $out " -> no XMP to add\n";
252             }
253             }
254             # add application extension containing ICC_Profile if necessary
255 6 100 100     23 if (exists $$addDirs{ICC_Profile} and not defined $doneDir{ICC_Profile}) {
256 1         3 $doneDir{ICC_Profile} = 1;
257             # write new ICC_Profile
258 1         6 my $iccTable = GetTagTable('Image::ExifTool::ICC_Profile::Main');
259 1         4 my %dirInfo = ( Parent => 'GIF' );
260 1 50       4 $verbose and print $out "Creating ICC_Profile application extension block:\n";
261 1         6 $buff = $et->WriteDirectory(\%dirInfo, $iccTable);
262 1 50 33     10 if (defined $buff and length $buff) {
263 1         4 my $pos = 0;
264 1 50       7 Write($outfile, "\x21\xff\x0bICCRGBG1012") or $err = 1;
265 1         4 my $len = length $buff;
266 1         5 while ($pos < $len) {
267 2         6 my $n = $len - $pos;
268 2 100       7 $n = 255 if $n > 255;
269 2 50       11 Write($outfile, chr($n), substr($buff, $pos, $n)) or $err = 1;
270 2         7 $pos += $n;
271             }
272 1 50       5 Write($outfile, "\0") or $err = 1; # write null terminator
273 1         7 ++$doneDir{ICC_Profile}; # set to 2 to indicate we added a new profile
274             } else {
275 0 0       0 $verbose and print $out " -> no ICC_Profile to add\n";
276             }
277             }
278             }
279 33 100       84 if (ord($ch) == 0x2c) {
280 7         15 ++$frameCount;
281 7 100 50     24 Write($outfile, $ch) or $err = 1 if $outfile;
282             # image descriptor
283 7 50 33     27 last unless $raf->Read($buff, 8) == 8 and $raf->Read($ch, 1);
284 7 100 50     27 Write($outfile, $buff, $ch) or $err = 1 if $outfile;
285 7 50       22 if ($verbose) {
286 0         0 my ($left, $top, $w, $h) = unpack('v*', $buff);
287 0         0 print $out "Image: left=$left top=$top width=$w height=$h\n";
288             }
289 7 50       21 if (ord($ch) & 0x80) { # does color table exist?
290 0         0 $length = 3 * (2 << (ord($ch) & 0x07));
291             # skip the color table
292 0 0       0 last unless $raf->Read($buff, $length) == $length;
293 0 0 0     0 Write($outfile, $buff) or $err = 1 if $outfile;
294             }
295             # skip "LZW Minimum Code Size" byte
296 7 50       22 last unless $raf->Read($buff, 1);
297 7 100 50     28 Write($outfile,$buff) or $err = 1 if $outfile;
298             # skip image blocks
299 7         13 for (;;) {
300 14 50       34 last unless $raf->Read($ch, 1);
301 14 100 50     48 Write($outfile, $ch) or $err = 1 if $outfile;
302 14 100       41 last unless ord($ch);
303 7 50       36 last unless $raf->Read($buff, ord($ch));
304 7 100 50     29 Write($outfile,$buff) or $err = 1 if $outfile;
305             }
306 7         13 next; # continue with next field
307             }
308             # last if ord($ch) == 0x3b; # normal end of GIF marker
309 26 100       63 unless (ord($ch) == 0x21) {
310 7 100       29 if ($outfile) {
311 3 50       11 Write($outfile, $ch) or $err = 1;
312             # copy the rest of the file
313 3         12 while ($raf->Read($buff, 65536)) {
314 0 0       0 Write($outfile, $buff) or $err = 1;
315             }
316             }
317 7         12 $rtnVal = 1;
318 7         13 last;
319             }
320             # get extension block type/size
321 19 50       51 last unless $raf->Read($s, 2) == 2;
322             # get marker and block size
323 19         61 ($a,$length) = unpack("C"x2, $s);
324              
325 19 100 33     91 if ($a == 0xfe) { # comment extension
    50 0        
    0 0        
    0          
326              
327 7         13 my $comment = '';
328 7         18 while ($length) {
329 10 50       27 last unless $raf->Read($buff, $length) == $length;
330 10 100       44 $et->VerboseDump(\$buff) unless $outfile;
331             # add buffer to comment string
332 10         29 $comment .= $buff;
333 10 50       26 last unless $raf->Read($ch, 1); # read next block header
334 10         23 $length = ord($ch); # get next block size
335             }
336 7 50       20 last if $length; # was a read error if length isn't zero
337 7 100       18 if ($outfile) {
338 3         7 my $isOverwriting;
339 3 50       10 if ($setComment) {
340 3 50       9 if ($nvComment) {
341 3         17 $isOverwriting = $et->IsOverwriting($nvComment,$comment);
342             # get new comment again (may have been shifted)
343 3 50       28 $newComment = $et->GetNewValue($nvComment) if defined $newComment;
344             } else {
345             # group delete, or deleting additional comments after writing one
346 0         0 $isOverwriting = 1;
347             }
348             }
349 3 50       11 if ($isOverwriting) {
350 3         9 ++$$et{CHANGED}; # increment file changed flag
351 3         18 $et->VerboseValue('- Comment', $comment);
352 3         6 $comment = $newComment;
353 3 50       14 $et->VerboseValue('+ Comment', $comment) if defined $comment;
354 3         8 undef $nvComment; # just delete remaining comments
355             } else {
356 0         0 undef $setComment; # leave remaining comments alone
357             }
358 3 50       13 if (defined $comment) {
359             # write comment marker
360 3 50       10 Write($outfile, "\x21\xfe") or $err = 1;
361 3         18 my $len = length($comment);
362             # write out the comment in 255-byte chunks, each
363             # chunk beginning with a length byte
364 3         6 my $n;
365 3         19 for ($n=0; $n<$len; $n+=255) {
366 4         12 my $size = $len - $n;
367 4 100       11 $size > 255 and $size = 255;
368 4         13 my $str = substr($comment,$n,$size);
369 4 50       26 Write($outfile, pack('C',$size), $str) or $err = 1;
370             }
371 3 50       19 Write($outfile, "\0") or $err = 1; # empty chunk as terminator
372             }
373 3         8 undef $newComment; # don't write the new comment again
374             } else {
375 4         9 $rtnVal = 1;
376 4 50       20 $et->FoundTag('Comment', $comment) if $comment;
377 4         7 undef $comment;
378             # assume no more than one comment in FastScan mode
379 4 50       14 last if $et->Options('FastScan');
380             }
381 7         15 next;
382              
383             } elsif ($a == 0xff and $length == 0x0b) { # application extension
384              
385 12 50       32 last unless $raf->Read($buff, $length) == $length;
386 12         33 my $hdr = "$ch$s$buff";
387             # add "/" for readability
388 12         36 my $tag = substr($buff, 0, 8) . '/' . substr($buff, 8);
389 12         30 $tag =~ tr/\0-\x1f//d; # remove nulls and control characters
390 12 50       29 $verbose and print $out "Application Extension: $tag\n";
391              
392 12         37 my $extTable = GetTagTable('Image::ExifTool::GIF::Extensions');
393 12         30 my $extInfo = $$extTable{$tag};
394 12         28 my ($subdir, $inclLen, $justCopy);
395 12 50       28 if ($extInfo) {
396 12         24 $subdir = $$extInfo{SubDirectory};
397 12         24 $inclLen = $$extInfo{IncludeLengthBytes};
398             # rewrite as-is unless this is a writable subdirectory
399 12 50 33     55 $justCopy = 1 if $outfile and (not $subdir or not $$extInfo{Writable});
      66        
400             } else {
401 0 0       0 $justCopy = 1 if $outfile;
402             }
403 12 50 0     26 Write($outfile, $hdr) or $err = 1 if $justCopy;
404              
405             # read the extension data
406 12         25 my $dat = '';
407 12         18 for (;;) {
408 378 50       708 $raf->Read($ch, 1) or last Block; # read next block header
409 378 100       636 $length = ord($ch) or last; # get next block size
410 366 50       699 $raf->Read($buff, $length) == $length or last Block;
411 366 50 0     616 Write($outfile, $ch, $buff) or $err = 1 if $justCopy;
412 366 100       689 $dat .= $inclLen ? $ch . $buff : $buff;
413             }
414 12 50       31 Write($outfile, "\0") if $justCopy;
415              
416 12 50       25 if ($subdir) {
    0          
417 12         23 my $dirLen = length $dat;
418 12         27 my $name = $$extInfo{Name};
419 12 100       33 if ($name eq 'XMP') {
420             # get length of XMP without landing zone data
421             # (note that LZ data may not be exactly the same as what we use)
422 7 50       61 $dirLen = pos($dat) if $dat =~ /<\?xpacket end=['"][wr]['"]\?>/g;
423             }
424 12         78 my %dirInfo = (
425             DataPt => \$dat,
426             DataLen => length $dat,
427             DirLen => $dirLen,
428             DirName => $name,
429             Parent => 'GIF',
430             );
431 12         46 my $subTable = GetTagTable($$subdir{TagTable});
432 12 100       43 if (not $outfile) {
    50          
433 7         26 $et->ProcessDirectory(\%dirInfo, $subTable);
434             } elsif ($$extInfo{Writable}) {
435 5 50 33     22 if ($doneDir{$name} and $doneDir{$name} > 1) {
436 0         0 $et->Warn("Duplicate $name block created");
437             }
438 5         22 $buff = $et->WriteDirectory(\%dirInfo, $subTable);
439 5 100       17 if (defined $buff) {
440 4 100       15 next unless length $buff; # delete this extension if length is zero
441             # check for null just to be safe
442 3 50       15 $et->Error("$name contained NULL character") if $buff =~ /\0/;
443 3         8 $dat = $buff;
444             # add landing zone (without terminator, which will be added later)
445 3 50       75 $dat .= pack('C*',1,reverse(0..255)) if $$extInfo{IncludeLengthBytes};
446             } # (else rewrite original data)
447              
448 4         17 $doneDir{$name} = 1;
449              
450 4 100       16 if ($$extInfo{IncludeLengthBytes}) {
451             # write data and landing zone
452 3 50       13 Write($outfile, $hdr, $dat) or $err = 1;
453             } else {
454             # write as sub-blocks
455 1 50       4 Write($outfile, $hdr) or $err = 1;
456 1         4 my $pos = 0;
457 1         4 my $len = length $dat;
458 1         5 while ($pos < $len) {
459 2         13 my $n = $len - $pos;
460 2 100       8 $n = 255 if $n > 255;
461 2 50       11 Write($outfile, chr($n), substr($dat, $pos, $n)) or $err = 1;
462 2         8 $pos += $n;
463             }
464             }
465 4 50       13 Write($outfile, "\0") or $err = 1; # write null terminator
466             }
467             } elsif (not $outfile) {
468 0         0 $et->HandleTag($extTable, $tag, $dat);
469             }
470 11         38 next;
471              
472             } elsif ($a == 0xf9 and $length == 4) { # graphic control extension
473              
474 0 0       0 last unless $raf->Read($buff, $length) == $length;
475             # sum the individual delay times
476 0         0 my $delay = Get16u(\$buff, 1);
477 0         0 $delayTime += $delay;
478 0 0       0 $verbose and printf $out "Graphic Control: delay=%.2f\n", $delay / 100;
479             # get transparent colour
480 0         0 my $bits = Get8u(\$buff, 0);
481 0 0       0 $et->HandleTag($tagTablePtr, 'TransparentColor', Get8u(\$buff,3)) if $bits & 0x01;
482 0 0       0 $raf->Seek(-$length, 1) or last;
483              
484             } elsif ($a == 0x01 and $length == 12) { # plain text extension
485              
486 0 0       0 last unless $raf->Read($buff, $length) == $length;
487 0 0 0     0 Write($outfile, $ch, $s, $buff) or $err = 1 if $outfile;
488 0 0       0 if ($verbose) {
489 0         0 my ($left, $top, $w, $h) = unpack('v4', $buff);
490 0         0 print $out "Text: left=$left top=$top width=$w height=$h\n";
491             }
492 0         0 my $text = '';
493 0         0 for (;;) {
494 0 0       0 last unless $raf->Read($ch, 1);
495 0 0       0 $length = ord($ch) or last;
496 0 0       0 last unless $raf->Read($buff, $length) == $length;
497 0 0 0     0 Write($outfile, $ch, $buff) or $err = 1 if $outfile; # write block
498 0         0 $text .= $buff;
499             }
500 0 0 0     0 Write($outfile, "\0") or $err = 1 if $outfile; # write terminator block
501 0         0 $et->HandleTag($tagTablePtr, 'Text', $text);
502 0         0 next;
503             }
504 0 0 0     0 Write($outfile, $ch, $s) or $err = 1 if $outfile;
505             # skip the block
506 0         0 while ($length) {
507 0 0       0 last unless $raf->Read($buff, $length) == $length;
508 0 0 0     0 Write($outfile, $buff) or $err = 1 if $outfile;
509 0 0       0 last unless $raf->Read($ch, 1); # read next block header
510 0 0 0     0 Write($outfile, $ch) or $err = 1 if $outfile;
511 0         0 $length = ord($ch); # get next block size
512             }
513             }
514 7 100       28 unless ($outfile) {
515 4 50       12 $et->HandleTag($tagTablePtr, 'FrameCount', $frameCount) if $frameCount > 1;
516 4 50       11 $et->HandleTag($tagTablePtr, 'Duration', $delayTime/100) if $delayTime;
517             }
518              
519             # set return value to -1 if we only had a write error
520 7 50 33     35 $rtnVal = -1 if $rtnVal and $err;
521 7         35 return $rtnVal;
522             }
523              
524              
525             1; #end
526              
527             __END__