view release on metacpan or  search on metacpan

lib/Image/ExifTool/FlashPix.pm  view on Meta::CPAN

        }
    }
}

#------------------------------------------------------------------------------
# Extract names of comment authors (ref 6)
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success
sub ProcessCommentBy($$$)
{
    my ($et, $dirInfo, $tagTablePtr) = @_;
    my $dataPt = $$dirInfo{DataPt};
    my $pos = $$dirInfo{DirStart};
    my $end = $$dirInfo{DirLen} + $pos;
    $et->VerboseDir($$dirInfo{DirName});
    while ($pos + 2 < $end) {
        my $len = Get16u($dataPt, $pos);
        $pos += 2;
        last if $pos + $len * 2 > $end;
        my $author = $et->Decode(substr($$dataPt, $pos, $len*2), 'UTF16');
        $pos += $len * 2;
        $et->HandleTag($tagTablePtr, CommentBy => $author);
    }
    return 1;
}

#------------------------------------------------------------------------------
# Extract last-saved-by names (ref 5)
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success
sub ProcessLastSavedBy($$$)
{
    my ($et, $dirInfo, $tagTablePtr) = @_;
    my $dataPt = $$dirInfo{DataPt};
    my $pos = $$dirInfo{DirStart};
    my $end = $$dirInfo{DirLen} + $pos;
    return 0 if $pos + 6 > $end;
    $et->VerboseDir($$dirInfo{DirName});
    my $num = Get16u($dataPt, $pos+2);
    $pos += 6;
    while ($num >= 2) {
        last if $pos + 2 > $end;
        my $len = Get16u($dataPt, $pos);
        $pos += 2;
        last if $pos + $len * 2 > $end;
        my $author = $et->Decode(substr($$dataPt, $pos, $len*2), 'UTF16');
        $pos += $len * 2;
        last if $pos + 2 > $end;
        $len = Get16u($dataPt, $pos);
        $pos += 2;
        last if $pos + $len * 2 > $end;
        my $path = $et->Decode(substr($$dataPt, $pos, $len*2), 'UTF16');
        $pos += $len * 2;
        $et->HandleTag($tagTablePtr, LastSavedBy => "$author ($path)");
        $num -= 2;
    }
    return 1;
}

#------------------------------------------------------------------------------
# Check FPX byte order mark (BOM) and set byte order appropriately
# Inputs: 0) data ref, 1) offset to BOM
# Returns: true on success
sub CheckBOM($$)
{
    my ($dataPt, $pos) = @_;
    my $bom = Get16u($dataPt, $pos);
    return 1 if $bom == 0xfffe;
    return 0 unless $bom == 0xfeff;
    ToggleByteOrder();
    return 1;
}

#------------------------------------------------------------------------------
# Process FlashPix properties
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success
sub ProcessProperties($$$)
{
    my ($et, $dirInfo, $tagTablePtr) = @_;
    my $dataPt = $$dirInfo{DataPt};
    my $pos = $$dirInfo{DirStart} || 0;
    my $dirLen = $$dirInfo{DirLen} || length($$dataPt) - $pos;
    my $dirEnd = $pos + $dirLen;
    my $verbose = $et->Options('Verbose');
    my $n;

    if ($dirLen < 48) {
        $et->Warn('Truncated FPX properties');
        return 0;
    }
    # check and set our byte order if necessary
    unless (CheckBOM($dataPt, $pos)) {
        $et->Warn('Bad FPX property byte order mark');
        return 0;
    }
    # get position of start of section
    $pos = Get32u($dataPt, $pos + 44);
    if ($pos < 48) {
        $et->Warn('Bad FPX property section offset');
        return 0;
    }
    for ($n=0; $n<2; ++$n) {
        my %dictionary;     # dictionary to translate user-defined properties
        my $codePage;
        last if $pos + 8 > $dirEnd;
        # read property section header
        my $size = Get32u($dataPt, $pos);
        last unless $size;
        my $numEntries = Get32u($dataPt, $pos + 4);
        $verbose and $et->VerboseDir('Property Info', $numEntries, $size);
        if ($pos + 8 + 8 * $numEntries > $dirEnd) {
            $et->Warn('Truncated property list');
            last;
        }
        my $index;
        for ($index=0; $index<$numEntries; ++$index) {
            my $entry = $pos + 8 + 8 * $index;
            my $tag = Get32u($dataPt, $entry);
            my $offset = Get32u($dataPt, $entry + 4);
            my $valStart = $pos + 4 + $offset;
            last if $valStart >= $dirEnd;
            my $valPos = $valStart;
            my $type = Get32u($dataPt, $pos + $offset);
            if ($tag == 0) {
                # read dictionary to get tag name lookup for this property set
                my $i;
                for ($i=0; $i<$type; ++$i) {
                    last if $valPos + 8 > $dirEnd;
                    $tag = Get32u($dataPt, $valPos);
                    my $len = Get32u($dataPt, $valPos + 4);
                    $valPos += 8 + $len;
                    last if $valPos > $dirEnd;
                    my $name = substr($$dataPt, $valPos - $len, $len);
                    $name =~ s/\0.*//s;
                    next unless length $name;
                    $dictionary{$tag} = $name;
                    next if $$tagTablePtr{$name};
                    $tag = $name;
                    $name =~ s/(^| )([a-z])/\U$2/g; # start with uppercase
                    $name =~ tr/-_a-zA-Z0-9//dc;    # remove illegal characters
                    next unless length $name;
                    $et->VPrint(0, "$$et{INDENT}\[adding $name]\n") if $verbose;
                    AddTagToTable($tagTablePtr, $tag, { Name => $name });
                }
                next;
            }
            # use tag name from dictionary if available
            my ($custom, $val);
            if (defined $dictionary{$tag}) {
                $tag = $dictionary{$tag};
                $custom = 1;
            }