];
my $preMouse = q();
#------------------------------------------------------------------------------
# New - create new HtmlDump object
# Inputs: 0) reference to HtmlDump object or HtmlDump class name
sub new
{
local $_;
my $that = shift;
my $class = ref($that) || $that || 'Image::ExifTool::HtmlDump';
return bless { Block => {}, TipNum => 0 }, $class;
}
#------------------------------------------------------------------------------
# Add information to dump
# Inputs: 0) HTML dump hash ref, 1) absolute offset in file, 2) data size,
# 3) comment string, 4) tool tip (or SAME to use previous tip),
# 5) bit flags (see below), 6) true to use same tooltip as last call
# Bits: 0x01 - print at start of line
# 0x02 - print red address
# 0x04 - maker notes data ('M'-class span)
# 0x08 - limit block length
# Notes: Block will be shown in 'unused' color if comment string begins with '['
sub Add($$$$;$$)
{
my ($self, $start, $size, $msg, $tip, $flag, $sameTip) = @_;
my $block = $$self{Block};
$$block{$start} or $$block{$start} = [ ];
if ($tip and $tip eq 'SAME') {
$tip = '';
} else {
$tip = defined $tip ? '\n' . $tip : '';
my $m = $msg;
$m =~ s/<.*?>//g; # remove html format codes
$tip = "$m$tip"; # add msg as first line in tooltip
# add size if not already done
$tip .= "\\n($size bytes)" unless $tip =~ /\\nSize:/;
++$self->{TipNum};
}
push @{$$block{$start}}, [ $size, $msg, $tip, $flag, $self->{TipNum} ];
}
#------------------------------------------------------------------------------
# Print dump information to HTML page
# Inputs: 0) Dump information hash reference, 1) source file RAF reference,
# 2) data pointer, 3) data position, 4) output file or scalar reference,
# 5) limit level (1-3), 6) title
# Returns: non-zero if useful output was generated
sub Print($$;$$$$$)
{
local $_;
my ($self, $raf, $dataPt, $dataPos, $outfile, $level, $title) = @_;
my ($i, $buff, $rtnVal);
my $block = $$self{Block};
$dataPos = 0 unless $dataPos;
$outfile = \*STDOUT unless ref $outfile;
$title = 'HtmlDump' unless $title;
$level or $level = 0;
my $tell = $raf->Tell();
my @starts = sort { $a <=> $b } keys %$block;
my $pos = 0;
my $dataEnd = $dataPos + ($dataPt ? length($$dataPt) : 0);
# initialize member variables
$$self{Open} = [];
$$self{Closed} = [];
$$self{TipList} = [];
$$self{MSpanList} = [];
$$self{Cols} = [ '', '', '', '' ]; # text columns
# set dump size limits (limits are 4x smaller if bit 0x08 set in flags)
if ($level <= 1) {
$$self{Limit} = 1024;
} elsif ($level <= 2) {
$$self{Limit} = 16384;
} else {
delete $$self{Limit}; # no limit
}
# pre-initialize open/closed hashes for all columns
for ($i=0; $i<4; ++$i) {
$self->{Open}->[$i] = { ID => [ ], Element => { } };
$self->{Closed}->[$i] = { ID => [ ], Element => { } };
}
$bkgStart = $bkgEnd = 0;
$bkgSpan = '';
my $index = 0; # initialize tooltip index
my @names;
for ($i=0; $i<@starts; ++$i) {
my $start = $starts[$i];
my $bytes = $start - $pos;
if ($bytes > 0) {
if ($pos >= $dataPos and $pos + $bytes <= $dataEnd) {
$buff = substr($$dataPt, $pos-$dataPos, $bytes);
} else {
$buff = '';
$raf->Seek($pos, 0) and $raf->Read($buff, $bytes);
}
if (length $buff) {
my $str = ($bytes > 1) ? "unused $bytes bytes" : 'pad byte';
$self->DumpTable($pos-$dataPos, \$buff, "[$str]", "t$index", 0x108);
++$index;
}
$pos = $start; # dumped unused data up to the start of this block
}
my $parms;
my $parmList = $$block{$start};
foreach $parms (@$parmList) {
my ($len, $msg, $tip, $flag, $tipNum) = @$parms;
next unless $len > 0;
$flag = 0 unless defined $flag;
# generate same name for all blocks indexed by this tooltip
my $name = $names[$tipNum];
my $idx = $index;
if ($name) {
# get index from existing ID
$idx = substr($name, 1);
} else {
$name = $names[$tipNum] = "t$index";
++$index;
}
if ($flag == 4) {
$bkgStart = $start - $dataPos;
$bkgEnd = $bkgStart + $len;
$bkgSpan = "";
push @{$self->{MSpanList}}, $name;
next;
}
$tip and $self->{TipList}->[$idx] = $tip;
my $end = $start + $len;
if ($start >= $dataPos and $end <= $dataEnd) {
$buff = substr($$dataPt, $start-$dataPos, $len);
} else {
$buff = '';
$raf->Seek($start, 0) and $raf->Read($buff, $len);
}
next unless length $buff;
# set flag to continue this line if next block is contiguous
if ($i+1 < @starts and $parms eq $$parmList[-1] and
($end == $starts[$i+1] or ($end < $starts[$i+1] and $end >= $pos)))
{
my $nextFlag = $block->{$starts[$i+1]}->[0]->[3] || 0;
$flag |= 0x100 unless $flag & 0x01 or $nextFlag & 0x01;
}
$self->DumpTable($start-$dataPos, \$buff, $msg, $name,
$flag, $pos-$dataPos);
$pos = $end if $pos < $end;
}
}
$self->Open('',''); # close all open elements
$raf->Seek($tell,0);
# write output HTML file
Write($outfile, $htmlHeader1, $title);
if ($self->{Cols}->[0]) {
Write($outfile, $htmlHeader2);
my $mspan = \@{$$self{MSpanList}};
for ($i=0; $i<@$mspan; ++$i) {
Write($outfile, qq(mspan[$i] = "$$mspan[$i]";\n));
}
my $tips = \@{$$self{TipList}};
for ($i=0; $i<@$tips; ++$i) {
Write($outfile, qq(t[$i] = "$$tips[$i]";\n)) if defined $$tips[$i];
}
delete $$self{TipList};
Write($outfile, $htmlHeader3, $self->{Cols}->[0]);
Write($outfile, ' | ',
$preMouse, $self->{Cols}->[1]);
Write($outfile, ' | ',
$preMouse, $self->{Cols}->[2]);
Write($outfile, ' | ',
$preMouse, $self->{Cols}->[3]);
Write($outfile, " |