source: gsdl/trunk/perllib/cpan/Image/ExifTool/HtmlDump.pm@ 16842

Last change on this file since 16842 was 16842, checked in by davidb, 16 years ago

ExifTool added to cpan area to support metadata extraction from files such as JPEG. Primarily targetted as Image files (hence the Image folder name decided upon by the ExifTool author) it also can handle video such as flash and audio such as Wav
File size: 23.2 KB
Line 
1#------------------------------------------------------------------------------
2# File: HtmlDump.pm
3#
4# Description: Dump information in hex to HTML page
5#
6# Revisions: 12/05/2005 - P. Harvey Created
7#------------------------------------------------------------------------------
8
9package Image::ExifTool::HtmlDump;
10
11use strict;
12use vars qw($VERSION);
13use Image::ExifTool; # only for FinishTiffDump()
14
15$VERSION = '1.17';
16
17sub DumpTable($$$;$$$$);
18sub Open($$$;@);
19sub Write($@);
20
21my ($bkgStart, $bkgEnd, $bkgSpan);
22
23my $htmlHeader1 = <<_END_PART_1_;
24<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
25 "http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
26<html>
27<head>
28<title>
29_END_PART_1_
30
31# Note: Don't change font-weight style because it can affect line height
32my $htmlHeader2 = <<_END_PART_2_;
33</title>
34<style type="text/css">
35<!--
36/* character style ID's */
37.D { color: #000000 } /* default color */
38.V { color: #ff0000 } /* duplicate block 1 */
39.W { color: #004400 } /* normal block 1 */
40.X { color: #ff4488 } /* duplicate block 2 */
41.Y { color: #448844 } /* normal block 2 */
42.U { color: #cc8844 } /* unused data block */
43.H { color: #0000ff } /* highlighted tag name */
44.F { color: #aa00dd } /* actual offset differs */
45.M { text-decoration: underline } /* maker notes data */
46/* table styles */
47table.dump {
48 border-top: 1px solid gray;
49 border-bottom: 1px solid gray;
50}
51table.dump td { padding: .2em .3em }
52td.c2 {
53 border-left: 1px solid gray;
54 border-right: 1px solid gray;
55}
56pre { margin: 0 }
57table { font-size: .9em }
58body { color: black; background: white }
59-->
60</style>
61<script language="JavaScript" type="text/JavaScript">
62<!-- Begin
63var t = new Array;
64var mspan = new Array;
65function GetElementsByClass(classname, tagname) {
66 var found = new Array();
67 var list = document.getElementsByTagName(tagname);
68 var len = list.length;
69 for (var i=0, j=0; i<len; ++i) {
70 var classes = list[i].className.split(' ');
71 for (var k=0; k<classes.length; ++k) {
72 if (classes[k] == classname) {
73 found[j++] = list[i];
74 break;
75 }
76 }
77 }
78 delete list;
79 return found;
80}
81function high(e,on) {
82 var targ;
83 if (e.target) targ = e.target;
84 else if (e.srcElement) targ = e.srcElement;
85 if (targ.nodeType == 3) targ = targ.parentNode; // defeat Safari bug
86 if (!targ.name) targ = targ.parentNode; // go up another level if necessary
87 if (targ.name && document.getElementsByName) {
88 var col;
89 var tip;
90 if (on) {
91 col = "#ffcc99";
92 if (targ.name.substring(0,1) == 't') {
93 var index = parseInt(targ.name.substring(1));
94 tip = t[index];
95 if (tip) delete t[index];
96 }
97 } else {
98 col = "transparent";
99 }
100 // highlight anchor elements with the same name and add tool tip
101 var list = document.getElementsByName(targ.name);
102 for (var i=0; i<list.length; ++i) {
103 list[i].style.background = col;
104 if (tip) list[i].title += tip;
105 }
106 // use class name to highlight span elements if necessary
107 for (var i=0; i<mspan.length; ++i) {
108 if (mspan[i] != targ.name) continue;
109 list = GetElementsByClass(targ.name, 'span');
110 for (var j=0; j<list.length; ++j) {
111 list[j].style.background = col;
112 }
113 break;
114 }
115 }
116}
117_END_PART_2_
118
119my $htmlHeader3 = q[
120// End --->
121</script></head>
122<body><noscript><b class=V>--&gt;
123Enable JavaScript for active highlighting and information tool tips!
124</b></noscript><table class=dump cellspacing=0 cellpadding=2>
125<tr><td valign='top'><pre>];
126
127my $preMouse = q(<pre onmouseover="high(event,1)" onmouseout="high(event,0)">);
128
129#------------------------------------------------------------------------------
130# New - create new HtmlDump object
131# Inputs: 0) reference to HtmlDump object or HtmlDump class name
132sub new
133{
134 local $_;
135 my $that = shift;
136 my $class = ref($that) || $that || 'Image::ExifTool::HtmlDump';
137 return bless { Block => {}, TipNum => 0 }, $class;
138}
139
140#------------------------------------------------------------------------------
141# Add information to dump
142# Inputs: 0) HTML dump hash ref, 1) absolute offset in file, 2) data size,
143# 3) comment string, 4) tool tip (or SAME to use previous tip),
144# 5) bit flags (see below), 6) true to use same tooltip as last call
145# Bits: 0x01 - print at start of line
146# 0x02 - print red address
147# 0x04 - maker notes data ('M'-class span)
148# 0x08 - limit block length
149# Notes: Block will be shown in 'unused' color if comment string begins with '['
150sub Add($$$$;$$)
151{
152 my ($self, $start, $size, $msg, $tip, $flag, $sameTip) = @_;
153 my $block = $$self{Block};
154 $$block{$start} or $$block{$start} = [ ];
155 if ($tip and $tip eq 'SAME') {
156 $tip = '';
157 } else {
158 $tip = defined $tip ? '\n' . $tip : '';
159 my $m = $msg;
160 $m =~ s/<.*?>//g; # remove html format codes
161 $tip = "$m$tip"; # add msg as first line in tooltip
162 # add size if not already done
163 $tip .= "\\n($size bytes)" unless $tip =~ /\\nSize:/;
164 ++$self->{TipNum};
165 }
166 push @{$$block{$start}}, [ $size, $msg, $tip, $flag, $self->{TipNum} ];
167}
168
169#------------------------------------------------------------------------------
170# Print dump information to HTML page
171# Inputs: 0) Dump information hash reference, 1) source file RAF reference,
172# 2) data pointer, 3) data position, 4) output file or scalar reference,
173# 5) limit level (1-3), 6) title
174# Returns: non-zero if useful output was generated
175sub Print($$;$$$$$)
176{
177 local $_;
178 my ($self, $raf, $dataPt, $dataPos, $outfile, $level, $title) = @_;
179 my ($i, $buff, $rtnVal);
180 my $block = $$self{Block};
181 $dataPos = 0 unless $dataPos;
182 $outfile = \*STDOUT unless ref $outfile;
183 $title = 'HtmlDump' unless $title;
184 $level or $level = 0;
185 my $tell = $raf->Tell();
186 my @starts = sort { $a <=> $b } keys %$block;
187 my $pos = 0;
188 my $dataEnd = $dataPos + ($dataPt ? length($$dataPt) : 0);
189 # initialize member variables
190 $$self{Open} = [];
191 $$self{Closed} = [];
192 $$self{TipList} = [];
193 $$self{MSpanList} = [];
194 $$self{Cols} = [ '', '', '', '' ]; # text columns
195 # set dump size limits (limits are 4x smaller if bit 0x08 set in flags)
196 if ($level <= 1) {
197 $$self{Limit} = 1024;
198 } elsif ($level <= 2) {
199 $$self{Limit} = 16384;
200 } else {
201 delete $$self{Limit}; # no limit
202 }
203 # pre-initialize open/closed hashes for all columns
204 for ($i=0; $i<4; ++$i) {
205 $self->{Open}->[$i] = { ID => [ ], Element => { } };
206 $self->{Closed}->[$i] = { ID => [ ], Element => { } };
207 }
208 $bkgStart = $bkgEnd = 0;
209 $bkgSpan = '';
210 my $index = 0; # initialize tooltip index
211 my @names;
212 for ($i=0; $i<@starts; ++$i) {
213 my $start = $starts[$i];
214 my $bytes = $start - $pos;
215 if ($bytes > 0) {
216 if ($pos >= $dataPos and $pos + $bytes <= $dataEnd) {
217 $buff = substr($$dataPt, $pos-$dataPos, $bytes);
218 } else {
219 $buff = '';
220 $raf->Seek($pos, 0) and $raf->Read($buff, $bytes);
221 }
222 if (length $buff) {
223 my $str = ($bytes > 1) ? "unused $bytes bytes" : 'pad byte';
224 $self->DumpTable($pos-$dataPos, \$buff, "[$str]", "t$index", 0x108);
225 ++$index;
226 }
227 $pos = $start; # dumped unused data up to the start of this block
228 }
229 my $parms;
230 my $parmList = $$block{$start};
231 foreach $parms (@$parmList) {
232 my ($len, $msg, $tip, $flag, $tipNum) = @$parms;
233 next unless $len > 0;
234 $flag = 0 unless defined $flag;
235 # generate same name for all blocks indexed by this tooltip
236 my $name = $names[$tipNum];
237 my $idx = $index;
238 if ($name) {
239 # get index from existing ID
240 $idx = substr($name, 1);
241 } else {
242 $name = $names[$tipNum] = "t$index";
243 ++$index;
244 }
245 if ($flag == 4) {
246 $bkgStart = $start - $dataPos;
247 $bkgEnd = $bkgStart + $len;
248 $bkgSpan = "<span class='$name M'>";
249 push @{$self->{MSpanList}}, $name;
250 next;
251 }
252 $tip and $self->{TipList}->[$idx] = $tip;
253 my $end = $start + $len;
254 if ($start >= $dataPos and $end <= $dataEnd) {
255 $buff = substr($$dataPt, $start-$dataPos, $len);
256 } else {
257 $buff = '';
258 $raf->Seek($start, 0) and $raf->Read($buff, $len);
259 }
260 next unless length $buff;
261 # set flag to continue this line if next block is contiguous
262 if ($i+1 < @starts and $parms eq $$parmList[-1] and
263 ($end == $starts[$i+1] or ($end < $starts[$i+1] and $end >= $pos)))
264 {
265 my $nextFlag = $block->{$starts[$i+1]}->[0]->[3] || 0;
266 $flag |= 0x100 unless $flag & 0x01 or $nextFlag & 0x01;
267 }
268 $self->DumpTable($start-$dataPos, \$buff, $msg, $name,
269 $flag, $pos-$dataPos);
270 $pos = $end if $pos < $end;
271 }
272 }
273 $self->Open('',''); # close all open elements
274 $raf->Seek($tell,0);
275
276 # write output HTML file
277 Write($outfile, $htmlHeader1, $title);
278 if ($self->{Cols}->[0]) {
279 Write($outfile, $htmlHeader2);
280 my $mspan = \@{$$self{MSpanList}};
281 for ($i=0; $i<@$mspan; ++$i) {
282 Write($outfile, qq(mspan[$i] = "$$mspan[$i]";\n));
283 }
284 my $tips = \@{$$self{TipList}};
285 for ($i=0; $i<@$tips; ++$i) {
286 Write($outfile, qq(t[$i] = "$$tips[$i]";\n)) if defined $$tips[$i];
287 }
288 delete $$self{TipList};
289 Write($outfile, $htmlHeader3, $self->{Cols}->[0]);
290 Write($outfile, '</pre></td><td valign="top">',
291 $preMouse, $self->{Cols}->[1]);
292 Write($outfile, '</pre></td><td class=c2 valign="top">',
293 $preMouse, $self->{Cols}->[2]);
294 Write($outfile, '</pre></td><td valign="top">',
295 $preMouse, $self->{Cols}->[3]);
296 Write($outfile, "</pre></td></tr></table>\n");
297 $rtnVal = 1;
298 } else {
299 Write($outfile, "$title</title></head><body>\n",
300 "No EXIF or TIFF information found in image\n");
301 }
302 Write($outfile, "</body></html>\n");
303 for ($i=0; $i<4; ++$i) {
304 $self->{Cols}->[$i] = ''; # free memory
305 }
306 return $rtnVal;
307}
308
309#------------------------------------------------------------------------------
310# Open or close a specified html element
311# Inputs: 0) HtmlDump object ref, 1) element id, 2) element string,
312# 3-N) list of column numbers (empty for all columns)
313# - element id may be '' to close all elements
314# - element string may be '' to close element by ID (or 0 to close without reopening)
315# - element id and string may both be 1 to reopen temporarily closed elements
316sub Open($$$;@)
317{
318 my ($self, $id, $element, @colNums) = @_;
319
320 # loop through specified columns
321 @colNums or @colNums = (0 .. $#{$self->{Open}});
322 my $col;
323 foreach $col (@colNums) {
324 # get information about open elements in this column
325 my $opHash = $self->{Open}->[$col];
326 my $opElem = $$opHash{Element};
327 if ($element) {
328 # next if already open
329 next if $$opElem{$id} and $$opElem{$id} eq $element;
330 } elsif ($id and not $$opElem{$id}) {
331 # next if already closed and nothing to reopen
332 next unless $element eq '' and @{$self->{Closed}->[$col]->{ID}};
333 }
334 my $opID = $$opHash{ID};
335 my $clHash = $self->{Closed}->[$col];
336 my $clID = $$clHash{ID};
337 my $clElem = $$clHash{Element};
338 # get reference to output column list (use temp list if available)
339 my $cols = $$self{TmpCols} || $$self{Cols};
340 # close everything down to this element if necessary
341 if ($$opElem{$id} or not $id) {
342 while (@$opID) {
343 my $tid = pop @$opID;
344 my $e = $$opElem{$tid};
345 $e =~ s/^<(\S+).*/<\/$1>/s;
346 $$cols[$col] .= $e;
347 if ($id eq $tid or not $id) {
348 delete $$opElem{$tid};
349 last if $id;
350 next;
351 }
352 # add this to the temporarily closed list
353 # (because we really didn't want to close it)
354 push @$clID, $tid;
355 $$clElem{$tid} = $$opElem{$tid};
356 delete $$opElem{$tid};
357 }
358 unless ($id) {
359 # forget all temporarily closed elements
360 $clID = $$clHash{ID} = [ ];
361 $clElem = $$clHash{Element} = { };
362 }
363 } elsif ($$clElem{$id}) {
364 # delete from the list of temporarily closed elements
365 delete $$clElem{$id};
366 @$clID = grep !/^$id$/, @$clID;
367 }
368 next if $element eq '0'; # 0 = don't reopen temporarily closed elements
369
370 # re-open temporarily closed elements
371 while (@$clID) {
372 my $tid = pop @$clID;
373 $$cols[$col] .= $$clElem{$tid};
374 push @$opID, $tid;
375 $$opElem{$tid} = $$clElem{$tid};
376 delete $$clElem{$tid};
377 }
378 # open specified element
379 if ($element and $element ne '1') {
380 $$cols[$col] .= $element;
381 push @$opID, $id;
382 $$opElem{$id} = $element;
383 }
384 }
385}
386
387#------------------------------------------------------------------------------
388# Dump a block of data in HTML table form
389# Inputs: 0) HtmlDump object ref, 1) data position, 2) block pointer,
390# 3) message, 4) object name, 5) flag, 6) data end position
391sub DumpTable($$$;$$$$)
392{
393 my ($self, $pos, $blockPt, $msg, $name, $flag, $endPos) = @_;
394 my $len = length $$blockPt;
395 $endPos = 0 unless $endPos;
396 my ($f0, $dblRef, $id);
397 if (($endPos and $pos < $endPos) or $flag & 0x02) {
398 # display double-reference addresses in red
399 $f0 = "<span class=V>";
400 $dblRef = 1 if $endPos and $pos < $endPos;
401 } else {
402 $f0 = '';
403 }
404 my @c = ('','','','');
405 $$self{TmpCols} = \@c;
406 if ($name) {
407 if ($msg and $msg =~ /^\[/) {
408 $id = 'U';
409 } else {
410 if ($$self{A}) {
411 $id = 'X';
412 $$self{A} = 0;
413 } else {
414 $id = 'V';
415 $$self{A} = 1;
416 }
417 ++$id unless $dblRef;
418 }
419 $name = qq{<a name=$name class=$id>};
420 $msg and $msg = "$name$msg</a>";
421 } else {
422 $name = '';
423 }
424 # use base-relative offsets from now on
425 my $cols = 0;
426 my $p = $pos;
427 if ($$self{Cont}) {
428 $cols = $pos & 0x0f;
429 $c[1] .= ($cols == 8) ? ' ' : ' ';
430 } else {
431 my $addr = $pos < 0 ? sprintf("-%.4x",-$pos) : sprintf("%5.4x",$pos);
432 $self->Open('fgd', $f0, 0);
433 $self->Open('fgd', '', 3);
434 $c[0] .= "$addr";
435 $p -= $pos & 0x0f unless $flag & 0x01;
436 if ($p < $pos) {
437 $self->Open('bkg', '', 1, 2); # don't underline white space
438 $cols = $pos - $p;
439 my $n = 3 * $cols;
440 ++$n if $cols > 7;
441 $c[1] .= ' ' x $n;
442 $c[2] .= ' ' x $cols;
443 $p = $pos;
444 }
445 }
446 # loop through each column of hex numbers
447 for (;;) {
448 $self->Open('bkg', ($p>=$bkgStart and $p<$bkgEnd) ? $bkgSpan : '', 1, 2);
449 $self->Open('a', $name, 1, 2);
450 my $ch = substr($$blockPt,$p-$pos,1);
451 $c[1] .= sprintf("%.2x", ord($ch));
452 # make the character HTML-friendly
453 $ch =~ tr/\x00-\x1f\x7f-\xff/./;
454 $ch =~ s/&/&amp;/g;
455 $ch =~ s/>/&gt;/g;
456 $ch =~ s/</&lt;/g;
457 $c[2] .= $ch;
458 ++$p;
459 ++$cols;
460 # close necessary elements
461 if ($p >= $bkgEnd) {
462 # close without reopening if closing anchor later
463 my $arg = ($p - $pos >= $len) ? 0 : '';
464 $self->Open('bkg', $arg, 1, 2);
465 }
466 if ($dblRef and $p >= $endPos) {
467 $dblRef = 0;
468 ++$id;
469 $name =~ s/class=\w\b/class=$id/;
470 $f0 = '';
471 $self->Open('fgd', $f0, 0);
472 }
473 if ($p - $pos >= $len) {
474 $self->Open('a', '', 1, 2); # close our anchor
475 last;
476 }
477 if ($cols < 16) {
478 $c[1] .= ($cols == 8 ? ' ' : ' ');
479 next;
480 } elsif ($flag & 0x01 and $cols < $len) {
481 $c[1] .= ' ';
482 next; # put it all on one line
483 }
484 unless ($$self{Msg}) {
485 $c[3] .= $msg;
486 $msg = '';
487 }
488 $_ .= "\n" foreach @c; # add CR to all lines
489 $$self{Msg} = 0;
490 # limit data length if specified
491 if ($$self{Limit}) {
492 my $div = ($flag & 0x08) ? 4 : 1;
493 my $lim = $$self{Limit} / (2 * $div) - 16;
494 if ($p - $pos > $lim and $len - $p + $pos > $lim) {
495 my $n = ($len - $p + $pos - $lim) & ~0x0f;
496 if ($n > 16) { # (no use just cutting out one line)
497 $self->Open('bkg', '', 1, 2); # no underline
498 my $note = "[snip $n bytes]";
499 $note = (' ' x (24-length($note)/2)) . $note;
500 $c[0] .= " ...\n";
501 $c[1] .= $note . (' ' x (48-length($note))) . "\n";
502 $c[2] .= " [snip] \n";
503 $c[3] .= "\n";
504 $p += $n;
505 }
506 }
507 }
508 $c[0] .= ($p < 0 ? sprintf("-%.4x",-$p) : sprintf("%5.4x",$p));
509 $cols = 0;
510 }
511 if ($msg) {
512 $msg = " $msg" if $$self{Msg};
513 $c[3] .= $msg;
514 }
515 if ($flag & 0x100 and $cols < 16) { # continue on same line?
516 $$self{Cont} = 1;
517 $$self{Msg} = 1 if $msg;
518 } else {
519 $_ .= "\n" foreach @c;
520 $$self{Msg} = 0;
521 $$self{Cont} = 0;
522 }
523 # add temporary column data to our real columns
524 my $i;
525 for ($i=0; $i<4; ++$i) {
526 $self->{Cols}->[$i] .= $c[$i];
527 }
528 delete $$self{TmpCols};
529}
530
531#------------------------------------------------------------------------------
532# Finish dumping of TIFF image data
533# Inputs: 0) HtmlDump object ref, 1) ExifTool object ref, 2) length of file
534# (this really belongs in Image::ExifTool::Exif, but is placed here so it
535# is only compiled when needed)
536sub FinishTiffDump($$$)
537{
538 my ($self, $exifTool, $size) = @_;
539 my ($tag, $key, $start, $blockInfo, $i);
540
541 # list of all indirectly referenced TIFF data tags
542 my %offsetPair = (
543 StripOffsets => 'StripByteCounts',
544 TileOffsets => 'TileByteCounts',
545 FreeOffsets => 'FreeByteCounts',
546 ThumbnailOffset => 'ThumbnailLength',
547 PreviewImageStart => 'PreviewImageLength',
548 JpgFromRawStart => 'JpgFromRawLength',
549 OtherImageStart => 'OtherImageLength',
550 ImageOffset => 'ImageByteCount',
551 AlphaOffset => 'AlphaByteCount',
552 );
553
554 # add TIFF data to html dump
555 foreach $tag (keys %offsetPair) {
556 my $info = $exifTool->GetInfo($tag);
557 next unless %$info;
558 foreach $key (%$info) {
559 my $name = Image::ExifTool::GetTagName($key);
560 my $grp1 = $exifTool->GetGroup($key, 1);
561 my $info2 = $exifTool->GetInfo($offsetPair{$tag}, { Group1 => $grp1 });
562 next unless %$info2;
563 my ($key2) = keys %$info2;
564 my $offsets = $$info{$key};
565 my $byteCounts = $$info2{$key2};
566 # (long lists may be SCALAR references)
567 my @offsets = split ' ', (ref $offsets ? $$offsets : $offsets);
568 my @byteCounts = split ' ', (ref $byteCounts ? $$byteCounts : $byteCounts);
569 my $num = scalar @offsets;
570 my $li = 0;
571 my $padBytes = 0;
572 for ($i=0; @offsets and @byteCounts; ++$i) {
573 my $offset = shift @offsets;
574 my $byteCount = shift @byteCounts;
575 my $end = $offset + $byteCount;
576 if (@offsets and @byteCounts) {
577 # show data as contiguous if only normal pad bytes between blocks
578 if ($end & 0x01 and $end + 1 == $offsets[0]) {
579 $end += 1;
580 ++$padBytes; # count them
581 }
582 if ($end == $offsets[0]) {
583 # combine these two blocks
584 $byteCounts[0] += $offsets[0] - $offset;
585 $offsets[0] = $offset;
586 next;
587 }
588 }
589 my $msg = $exifTool->GetGroup($key, 1) . ':' . $tag;
590 $msg =~ s/(Offsets?|Start)$/ /;
591 if ($num > 1) {
592 $msg .= "$li-" if $li != $i;
593 $msg .= "$i ";
594 $li = $i + 1;
595 }
596 $msg .= "data";
597 my $tip = "Size: $byteCount bytes";
598 $tip .= ", incl. $padBytes pad bytes" if $padBytes;
599 $self->Add($offset, $byteCount, "($msg)", $tip, 0x08);
600 }
601 }
602 }
603 # find offset of last dumped information, and dump any unknown trailer
604 my $last = 0;
605 my $block = $$self{Block};
606 foreach $start (keys %$block) {
607 foreach $blockInfo (@{$$block{$start}}) {
608 my $end = $start + $$blockInfo[0];
609 $last = $end if $last < $end;
610 }
611 }
612 my $diff = $size - $last;
613 if ($diff > 0 and ($last or $exifTool->Options('Unknown'))) {
614 if ($diff > 1 or $size & 0x01) {
615 $self->Add($last, $diff, "[unknown data]", "Size: $diff bytes", 0x08);
616 } else {
617 $self->Add($last, $diff, "[trailing pad byte]", undef, 0x08);
618 }
619 }
620}
621
622#------------------------------------------------------------------------------
623# utility routine to write to file or memory
624# Inputs: 0) file or scalar reference, 1-N) list of stuff to write
625# Returns: true on success
626sub Write($@)
627{
628 my $outfile = shift;
629 if (UNIVERSAL::isa($outfile,'GLOB')) {
630 return print $outfile @_;
631 } elsif (ref $outfile eq 'SCALAR') {
632 $$outfile .= join('', @_);
633 return 1;
634 }
635 return 0;
636}
637
6381; # end
639
640__END__
641
642=head1 NAME
643
644Image::ExifTool::HtmlDump - Dump information in hex to HTML page
645
646=head1 SYNOPSIS
647
648 use Image::ExifTool::HtmlDump;
649 my $dump = new Image::ExifTool::HtmlDump;
650 $dump->Add($start, $size, $comment);
651 $dump->Print($dumpInfo, $raf, $dataPt, $dataPos, $outfile);
652
653=head1 DESCRIPTION
654
655This module contains code used to generate an HTML-based hex dump of
656information for debugging purposes. This is code is called when the
657ExifTool 'HtmlDump' option is used.
658
659Currently, only EXIF and TIFF information is dumped.
660
661=head1 BUGS
662
663Due to a memory allocation bug in ActivePerl 5.8.x for Windows, this code
664may run extremely slowly when processing large files with this version of
665Perl.
666
667An HTML 4 compliant browser is needed to properly display the generated HTML
668page, but note that some of these browsers (like Mozilla) may not properly
669display linefeeds in the tool tips.
670
671=head1 AUTHOR
672
673Copyright 2003-2007, Phil Harvey (phil at owl.phy.queensu.ca)
674
675This library is free software; you can redistribute it and/or modify it
676under the same terms as Perl itself.
677
678=head1 SEE ALSO
679
680L<Image::ExifTool(3pm)|Image::ExifTool>
681
682=cut
683
Note: See TracBrowser for help on using the repository browser.