];
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,
# or -1 on error loading data and ERROR is set to offending data name
sub Print($$;$$$$$)
{
local $_;
my ($self, $raf, $dataPt, $dataPos, $outfile, $level, $title) = @_;
my ($i, $buff, $rtnVal, $limit, $err);
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) {
$limit = 1024;
} elsif ($level <= 2) {
$limit = 16384;
} else {
$limit = 256 * 1024 * 1024; # never dump bigger than 256 MB
}
$$self{Limit} = $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, $wasUnused);
for ($i=0; $i<@starts; ++$i) {
my $start = $starts[$i];
my $parmList = $$block{$start};
my $len = $start - $pos;
if ($len > 0 and not $wasUnused) {
# we have an unused bytes before this data block
--$i; # dump the data block next time around
$start = $pos; # dump the unused bytes now
my $str = ($len > 1) ? "unused $len bytes" : 'pad byte';
$parmList = [ [ $len, "[$str]", undef, 0x108 ] ];
$wasUnused = 1; # avoid re-dumping unused bytes if we get a read error
} else {
undef $wasUnused;
}
my $parms;
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;
$name = $names[$tipNum] if defined $tipNum;
my $idx = $index;
if ($name) {
# get index from existing ID
$idx = substr($name, 1);
} else {
$name = "t$index";
$names[$tipNum] = $name if defined $tipNum;
++$index;
}
if ($flag == 4) {
$bkgStart = $start - $dataPos;
$bkgEnd = $bkgStart + $len;
$bkgSpan = "";
push @{$self->{MSpanList}}, $name;
next;
}
# loop until we read the value properly
my ($end, $try);
for ($try=0; $try<2; ++$try) {
$end = $start + $len;
# only load as much of the block as we are going to dump
my $size = ($len > $limit) ? $limit / 2 : $len;
if ($start >= $dataPos and $end <= $dataEnd) {
$buff = substr($$dataPt, $start-$dataPos, $size);
if ($len != $size) {
$buff .= substr($$dataPt, $start-$dataPos+$len-$size, $size);
}
} else {
$buff = '';
if ($raf->Seek($start, 0) and $raf->Read($buff, $size) == $size) {
# read end of block
if ($len != $size) {
my $buf2 = '';
unless ($raf->Seek($start+$len-$size, 0) and
$raf->Read($buf2, $size) == $size)
{
$err = $msg;
# reset $len to the actual length of available data
$raf->Seek(0, 2);
$len = $raf->Tell() - $start;
$tip .= "\\nError: Only $len bytes available!" if $tip;
next;
}
$buff .= $buf2;
undef $buf2;
}
} else {
$err = $msg;
}
}
last;
}
$tip and $self->{TipList}->[$idx] = $tip;
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, $len, $pos-$dataPos);
undef $buff;
$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, " |