Tester utilities
This commit is contained in:
6697
utils/IconTester.app/Contents/Resources/bin/exiftool
Executable file
6697
utils/IconTester.app/Contents/Resources/bin/exiftool
Executable file
File diff suppressed because it is too large
Load Diff
BIN
utils/IconTester.app/Contents/Resources/bin/ffmpeg
Executable file
BIN
utils/IconTester.app/Contents/Resources/bin/ffmpeg
Executable file
Binary file not shown.
@@ -0,0 +1,378 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: RandomAccess.pm
|
||||
#
|
||||
# Description: Buffer to support random access reading of sequential file
|
||||
#
|
||||
# Revisions: 02/11/2004 - P. Harvey Created
|
||||
# 02/20/2004 - P. Harvey Added flag to disable SeekTest in new()
|
||||
# 11/18/2004 - P. Harvey Fixed bug with seek relative to end of file
|
||||
# 01/02/2005 - P. Harvey Added DEBUG code
|
||||
# 01/09/2006 - P. Harvey Fixed bug in ReadLine() when using
|
||||
# multi-character EOL sequences
|
||||
# 02/20/2006 - P. Harvey Fixed bug where seek past end of file could
|
||||
# generate "substr outside string" warning
|
||||
# 06/10/2006 - P. Harvey Decreased $CHUNK_SIZE from 64k to 8k
|
||||
# 11/23/2006 - P. Harvey Limit reads to < 0x80000000 bytes
|
||||
# 11/26/2008 - P. Harvey Fixed bug in ReadLine when reading from a
|
||||
# scalar with a multi-character newline
|
||||
# 01/24/2009 - PH Protect against reading too much at once
|
||||
#
|
||||
# Notes: Calls the normal file i/o routines unless SeekTest() fails, in
|
||||
# which case the file is buffered in memory to allow random access.
|
||||
# SeekTest() is called automatically when the object is created
|
||||
# unless specified.
|
||||
#
|
||||
# May also be used for string i/o (just pass a scalar reference)
|
||||
#
|
||||
# Legal: Copyright (c) 2003-2018 Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
# This library is free software; you can redistribute it and/or
|
||||
# modify it under the same terms as Perl itself.
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package File::RandomAccess;
|
||||
|
||||
use strict;
|
||||
require 5.002;
|
||||
require Exporter;
|
||||
|
||||
use vars qw($VERSION @ISA @EXPORT_OK);
|
||||
$VERSION = '1.10';
|
||||
@ISA = qw(Exporter);
|
||||
|
||||
sub Read($$$);
|
||||
|
||||
# constants
|
||||
my $CHUNK_SIZE = 8192; # size of chunks to read from file (must be power of 2)
|
||||
my $SLURP_CHUNKS = 16; # read this many chunks at a time when slurping
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Create new RandomAccess object
|
||||
# Inputs: 0) reference to RandomAccess object or RandomAccess class name
|
||||
# 1) file reference or scalar reference
|
||||
# 2) flag set if file is already random access (disables automatic SeekTest)
|
||||
sub new($$;$)
|
||||
{
|
||||
my ($that, $filePt, $isRandom) = @_;
|
||||
my $class = ref($that) || $that;
|
||||
my $self;
|
||||
|
||||
if (ref $filePt eq 'SCALAR') {
|
||||
# string i/o
|
||||
$self = {
|
||||
BUFF_PT => $filePt,
|
||||
POS => 0,
|
||||
LEN => length($$filePt),
|
||||
TESTED => -1,
|
||||
};
|
||||
bless $self, $class;
|
||||
} else {
|
||||
# file i/o
|
||||
my $buff = '';
|
||||
$self = {
|
||||
FILE_PT => $filePt, # file pointer
|
||||
BUFF_PT => \$buff, # reference to file data
|
||||
POS => 0, # current position in file
|
||||
LEN => 0, # data length
|
||||
TESTED => 0, # 0=untested, 1=passed, -1=failed (requires buffering)
|
||||
};
|
||||
bless $self, $class;
|
||||
$self->SeekTest() unless $isRandom;
|
||||
}
|
||||
return $self;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Enable DEBUG code
|
||||
# Inputs: 0) reference to RandomAccess object
|
||||
sub Debug($)
|
||||
{
|
||||
my $self = shift;
|
||||
$self->{DEBUG} = { };
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Perform seek test and turn on buffering if necessary
|
||||
# Inputs: 0) reference to RandomAccess object
|
||||
# Returns: 1 if seek test passed (ie. no buffering required)
|
||||
# Notes: Must be done before any other i/o
|
||||
sub SeekTest($)
|
||||
{
|
||||
my $self = shift;
|
||||
unless ($self->{TESTED}) {
|
||||
my $fp = $self->{FILE_PT};
|
||||
if (seek($fp, 1, 1) and seek($fp, -1, 1)) {
|
||||
$self->{TESTED} = 1; # test passed
|
||||
} else {
|
||||
$self->{TESTED} = -1; # test failed (requires buffering)
|
||||
}
|
||||
}
|
||||
return $self->{TESTED} == 1 ? 1 : 0;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Get current position in file
|
||||
# Inputs: 0) reference to RandomAccess object
|
||||
# Returns: current position in file
|
||||
sub Tell($)
|
||||
{
|
||||
my $self = shift;
|
||||
my $rtnVal;
|
||||
if ($self->{TESTED} < 0) {
|
||||
$rtnVal = $self->{POS};
|
||||
} else {
|
||||
$rtnVal = tell($self->{FILE_PT});
|
||||
}
|
||||
return $rtnVal;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Seek to position in file
|
||||
# Inputs: 0) reference to RandomAccess object
|
||||
# 1) position, 2) whence (0 or undef=from start, 1=from cur pos, 2=from end)
|
||||
# Returns: 1 on success
|
||||
# Notes: When buffered, this doesn't quite behave like seek() since it will return
|
||||
# success even if you seek outside the limits of the file. However if you
|
||||
# do this, you will get an error on your next Read().
|
||||
sub Seek($$;$)
|
||||
{
|
||||
my ($self, $num, $whence) = @_;
|
||||
$whence = 0 unless defined $whence;
|
||||
my $rtnVal;
|
||||
if ($self->{TESTED} < 0) {
|
||||
my $newPos;
|
||||
if ($whence == 0) {
|
||||
$newPos = $num; # from start of file
|
||||
} elsif ($whence == 1) {
|
||||
$newPos = $num + $self->{POS}; # relative to current position
|
||||
} else {
|
||||
$self->Slurp(); # read whole file into buffer
|
||||
$newPos = $num + $self->{LEN}; # relative to end of file
|
||||
}
|
||||
if ($newPos >= 0) {
|
||||
$self->{POS} = $newPos;
|
||||
$rtnVal = 1;
|
||||
}
|
||||
} else {
|
||||
$rtnVal = seek($self->{FILE_PT}, $num, $whence);
|
||||
}
|
||||
return $rtnVal;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read from the file
|
||||
# Inputs: 0) reference to RandomAccess object, 1) buffer, 2) bytes to read
|
||||
# Returns: Number of bytes read
|
||||
sub Read($$$)
|
||||
{
|
||||
my $self = shift;
|
||||
my $len = $_[1];
|
||||
my $rtnVal;
|
||||
|
||||
# protect against reading too much at once
|
||||
# (also from dying with a "Negative length" error)
|
||||
if ($len & 0xf8000000) {
|
||||
return 0 if $len < 0;
|
||||
# read in smaller blocks because Windows attempts to pre-allocate
|
||||
# memory for the full size, which can lead to an out-of-memory error
|
||||
my $maxLen = 0x4000000; # (MUST be less than bitmask in "if" above)
|
||||
my $num = Read($self, $_[0], $maxLen);
|
||||
return $num if $num < $maxLen;
|
||||
for (;;) {
|
||||
$len -= $maxLen;
|
||||
last if $len <= 0;
|
||||
my $l = $len < $maxLen ? $len : $maxLen;
|
||||
my $buff;
|
||||
my $n = Read($self, $buff, $l);
|
||||
last unless $n;
|
||||
$_[0] .= $buff;
|
||||
$num += $n;
|
||||
last if $n < $l;
|
||||
}
|
||||
return $num;
|
||||
}
|
||||
# read through our buffer if necessary
|
||||
if ($self->{TESTED} < 0) {
|
||||
my $buff;
|
||||
my $newPos = $self->{POS} + $len;
|
||||
# number of bytes to read from file
|
||||
my $num = $newPos - $self->{LEN};
|
||||
if ($num > 0 and $self->{FILE_PT}) {
|
||||
# read data from file in multiples of $CHUNK_SIZE
|
||||
$num = (($num - 1) | ($CHUNK_SIZE - 1)) + 1;
|
||||
$num = read($self->{FILE_PT}, $buff, $num);
|
||||
if ($num) {
|
||||
${$self->{BUFF_PT}} .= $buff;
|
||||
$self->{LEN} += $num;
|
||||
}
|
||||
}
|
||||
# number of bytes left in data buffer
|
||||
$num = $self->{LEN} - $self->{POS};
|
||||
if ($len <= $num) {
|
||||
$rtnVal = $len;
|
||||
} elsif ($num <= 0) {
|
||||
$_[0] = '';
|
||||
return 0;
|
||||
} else {
|
||||
$rtnVal = $num;
|
||||
}
|
||||
# return data from our buffer
|
||||
$_[0] = substr(${$self->{BUFF_PT}}, $self->{POS}, $rtnVal);
|
||||
$self->{POS} += $rtnVal;
|
||||
} else {
|
||||
# read directly from file
|
||||
$_[0] = '' unless defined $_[0];
|
||||
$rtnVal = read($self->{FILE_PT}, $_[0], $len) || 0;
|
||||
}
|
||||
if ($self->{DEBUG}) {
|
||||
my $pos = $self->Tell() - $rtnVal;
|
||||
unless ($self->{DEBUG}->{$pos} and $self->{DEBUG}->{$pos} > $rtnVal) {
|
||||
$self->{DEBUG}->{$pos} = $rtnVal;
|
||||
}
|
||||
}
|
||||
return $rtnVal;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read a line from file (end of line is $/)
|
||||
# Inputs: 0) reference to RandomAccess object, 1) buffer
|
||||
# Returns: Number of bytes read
|
||||
sub ReadLine($$)
|
||||
{
|
||||
my $self = shift;
|
||||
my $rtnVal;
|
||||
my $fp = $self->{FILE_PT};
|
||||
|
||||
if ($self->{TESTED} < 0) {
|
||||
my ($num, $buff);
|
||||
my $pos = $self->{POS};
|
||||
if ($fp) {
|
||||
# make sure we have some data after the current position
|
||||
while ($self->{LEN} <= $pos) {
|
||||
$num = read($fp, $buff, $CHUNK_SIZE);
|
||||
return 0 unless $num;
|
||||
${$self->{BUFF_PT}} .= $buff;
|
||||
$self->{LEN} += $num;
|
||||
}
|
||||
# scan and read until we find the EOL (or hit EOF)
|
||||
for (;;) {
|
||||
$pos = index(${$self->{BUFF_PT}}, $/, $pos);
|
||||
if ($pos >= 0) {
|
||||
$pos += length($/);
|
||||
last;
|
||||
}
|
||||
$pos = $self->{LEN}; # have scanned to end of buffer
|
||||
$num = read($fp, $buff, $CHUNK_SIZE) or last;
|
||||
${$self->{BUFF_PT}} .= $buff;
|
||||
$self->{LEN} += $num;
|
||||
}
|
||||
} else {
|
||||
# string i/o
|
||||
$pos = index(${$self->{BUFF_PT}}, $/, $pos);
|
||||
if ($pos < 0) {
|
||||
$pos = $self->{LEN};
|
||||
$self->{POS} = $pos if $self->{POS} > $pos;
|
||||
} else {
|
||||
$pos += length($/);
|
||||
}
|
||||
}
|
||||
# read the line from our buffer
|
||||
$rtnVal = $pos - $self->{POS};
|
||||
$_[0] = substr(${$self->{BUFF_PT}}, $self->{POS}, $rtnVal);
|
||||
$self->{POS} = $pos;
|
||||
} else {
|
||||
$_[0] = <$fp>;
|
||||
if (defined $_[0]) {
|
||||
$rtnVal = length($_[0]);
|
||||
} else {
|
||||
$rtnVal = 0;
|
||||
}
|
||||
}
|
||||
if ($self->{DEBUG}) {
|
||||
my $pos = $self->Tell() - $rtnVal;
|
||||
unless ($self->{DEBUG}->{$pos} and $self->{DEBUG}->{$pos} > $rtnVal) {
|
||||
$self->{DEBUG}->{$pos} = $rtnVal;
|
||||
}
|
||||
}
|
||||
return $rtnVal;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read whole file into buffer (without changing read pointer)
|
||||
# Inputs: 0) reference to RandomAccess object
|
||||
sub Slurp($)
|
||||
{
|
||||
my $self = shift;
|
||||
my $fp = $self->{FILE_PT} || return;
|
||||
# read whole file into buffer (in large chunks)
|
||||
my ($buff, $num);
|
||||
while (($num = read($fp, $buff, $CHUNK_SIZE * $SLURP_CHUNKS)) != 0) {
|
||||
${$self->{BUFF_PT}} .= $buff;
|
||||
$self->{LEN} += $num;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# set binary mode
|
||||
# Inputs: 0) reference to RandomAccess object
|
||||
sub BinMode($)
|
||||
{
|
||||
my $self = shift;
|
||||
binmode($self->{FILE_PT}) if $self->{FILE_PT};
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# close the file and free the buffer
|
||||
# Inputs: 0) reference to RandomAccess object
|
||||
sub Close($)
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
if ($self->{DEBUG}) {
|
||||
local $_;
|
||||
if ($self->Seek(0,2)) {
|
||||
$self->{DEBUG}->{$self->Tell()} = 0; # set EOF marker
|
||||
my $last;
|
||||
my $tot = 0;
|
||||
my $bad = 0;
|
||||
foreach (sort { $a <=> $b } keys %{$self->{DEBUG}}) {
|
||||
my $pos = $_;
|
||||
my $len = $self->{DEBUG}->{$_};
|
||||
if (defined $last and $last < $pos) {
|
||||
my $bytes = $pos - $last;
|
||||
$tot += $bytes;
|
||||
$self->Seek($last);
|
||||
my $buff;
|
||||
$self->Read($buff, $bytes);
|
||||
my $warn = '';
|
||||
if ($buff =~ /[^\0]/) {
|
||||
$bad += ($pos - $last);
|
||||
$warn = ' - NON-ZERO!';
|
||||
}
|
||||
printf "0x%.8x - 0x%.8x (%d bytes)$warn\n", $last, $pos, $bytes;
|
||||
}
|
||||
my $cur = $pos + $len;
|
||||
$last = $cur unless defined $last and $last > $cur;
|
||||
}
|
||||
print "$tot bytes missed";
|
||||
$bad and print ", $bad non-zero!";
|
||||
print "\n";
|
||||
} else {
|
||||
warn "File::RandomAccess DEBUG not working (file already closed?)\n";
|
||||
}
|
||||
delete $self->{DEBUG};
|
||||
}
|
||||
# close the file
|
||||
if ($self->{FILE_PT}) {
|
||||
close($self->{FILE_PT});
|
||||
delete $self->{FILE_PT};
|
||||
}
|
||||
# reset the buffer
|
||||
my $emptyBuff = '';
|
||||
$self->{BUFF_PT} = \$emptyBuff;
|
||||
$self->{LEN} = 0;
|
||||
$self->{POS} = 0;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
1; # end
|
||||
@@ -0,0 +1,231 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: RandomAccess.pod -- Documentation for File::RandomAccess
|
||||
#
|
||||
# Description: Buffer to support random access reading of sequential file
|
||||
#
|
||||
# Legal: Copyright (c) 2003-2018 Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
# This library is free software; you can redistribute it and/or
|
||||
# modify it under the same terms as Perl itself.
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
=head1 NAME
|
||||
|
||||
File::RandomAccess - Random access reads of sequential file or scalar
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use File::RandomAccess;
|
||||
|
||||
$raf = new File::RandomAccess(\*FILE, $disableSeekTest);
|
||||
|
||||
$raf = new File::RandomAccess(\$data);
|
||||
|
||||
$err = $raf->Seek($pos);
|
||||
$num = $raf->Read($buff, $bytes);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Allows random access to sequential file by buffering the file if necessary.
|
||||
Also allows access to data in memory to be accessed as if it were a file.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item B<new>
|
||||
|
||||
Creates a new RandomAccess object given a file reference or
|
||||
reference to data in memory.
|
||||
|
||||
# Read from open file or pipe
|
||||
$raf = new File::RandomAccess(\*FILE);
|
||||
|
||||
# Read from data in memory
|
||||
$raf = new File::RandomAccess(\$data);
|
||||
|
||||
=over 4
|
||||
|
||||
=item Inputs:
|
||||
|
||||
0) Reference to RandomAccess object or RandomAccess class name.
|
||||
|
||||
1) File reference or scalar reference.
|
||||
|
||||
2) Flag set if file is already random access (disables automatic SeekTest).
|
||||
|
||||
=item Returns:
|
||||
|
||||
Reference to RandomAccess object.
|
||||
|
||||
=back
|
||||
|
||||
=item B<SeekTest>
|
||||
|
||||
Performs test seek() on file to determine if buffering is necessary. If
|
||||
the seek() fails, then the file is buffered to allow random access.
|
||||
B<SeekTest>() is automatically called from B<new> unless specified.
|
||||
|
||||
$result = $raf->SeekTest();
|
||||
|
||||
=over 4
|
||||
|
||||
=item Inputs:
|
||||
|
||||
0) Reference to RandomAccess object.
|
||||
|
||||
=item Returns:
|
||||
|
||||
1 if seek test passed (ie. no buffering required).
|
||||
|
||||
=item Notes:
|
||||
|
||||
Must be called before any other i/o.
|
||||
|
||||
=back
|
||||
|
||||
=item B<Tell>
|
||||
|
||||
Get current position in file
|
||||
|
||||
$pos = $raf->Tell();
|
||||
|
||||
=over 4
|
||||
|
||||
=item Inputs:
|
||||
|
||||
0) Reference to RandomAccess object.
|
||||
|
||||
=item Returns:
|
||||
|
||||
Current position in file
|
||||
|
||||
=back
|
||||
|
||||
=item B<Seek>
|
||||
|
||||
Seek to specified position in file. When buffered, this doesn't quite
|
||||
behave like seek() since it returns success even if you seek outside the
|
||||
limits of the file.
|
||||
|
||||
$success = $raf->Seek($pos, 0);
|
||||
|
||||
=over 4
|
||||
|
||||
=item Inputs:
|
||||
|
||||
0) Reference to RandomAccess object.
|
||||
|
||||
1) Position.
|
||||
|
||||
2) Whence (0=from start, 1=from cur pos, 2=from end).
|
||||
|
||||
=item Returns:
|
||||
|
||||
1 on success, 0 otherwise
|
||||
|
||||
=back
|
||||
|
||||
=item B<Read>
|
||||
|
||||
Read data from the file.
|
||||
|
||||
$num = $raf->Read($buff, 1024);
|
||||
|
||||
=over 4
|
||||
|
||||
=item Inputs:
|
||||
|
||||
0) Reference to RandomAccess object.
|
||||
|
||||
1) Buffer.
|
||||
|
||||
2) Number of bytes to read.
|
||||
|
||||
=item Returns:
|
||||
|
||||
Number of bytes actually read.
|
||||
|
||||
=back
|
||||
|
||||
=item B<ReadLine>
|
||||
|
||||
Read a line from file (end of line is $/).
|
||||
|
||||
=over 4
|
||||
|
||||
=item Inputs:
|
||||
|
||||
0) Reference to RandomAccess object.
|
||||
|
||||
1) Buffer.
|
||||
|
||||
=item Returns:
|
||||
|
||||
Number of bytes read.
|
||||
|
||||
=back
|
||||
|
||||
=item B<Slurp>
|
||||
|
||||
Read whole file into buffer, without changing read pointer.
|
||||
|
||||
=over 4
|
||||
|
||||
=item Inputs:
|
||||
|
||||
0) Reference to RandomAccess object.
|
||||
|
||||
=item Returns:
|
||||
|
||||
Nothing.
|
||||
|
||||
=back
|
||||
|
||||
=item B<BinMode>
|
||||
|
||||
Set binary mode for file.
|
||||
|
||||
=over 4
|
||||
|
||||
=item Inputs:
|
||||
|
||||
0) Reference to RandomAccess object.
|
||||
|
||||
=item Returns:
|
||||
|
||||
Nothing.
|
||||
|
||||
=back
|
||||
|
||||
=item B<Close>
|
||||
|
||||
Close the file and free the buffer.
|
||||
|
||||
=over 4
|
||||
|
||||
=item Inputs:
|
||||
|
||||
0) Reference to RandomAccess object.
|
||||
|
||||
=item Returns:
|
||||
|
||||
Nothing.
|
||||
|
||||
=back
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018 Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
# end
|
||||
8210
utils/IconTester.app/Contents/Resources/bin/lib/Image/ExifTool.pm
Normal file
8210
utils/IconTester.app/Contents/Resources/bin/lib/Image/ExifTool.pm
Normal file
File diff suppressed because it is too large
Load Diff
2624
utils/IconTester.app/Contents/Resources/bin/lib/Image/ExifTool.pod
Normal file
2624
utils/IconTester.app/Contents/Resources/bin/lib/Image/ExifTool.pod
Normal file
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,501 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: AES.pm
|
||||
#
|
||||
# Description: AES encryption with cipher-block chaining
|
||||
#
|
||||
# Revisions: 2010/10/14 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://www.hoozi.com/Articles/AESEncryption.htm
|
||||
# 2) http://www.csrc.nist.gov/publications/fips/fips197/fips-197.pdf
|
||||
# 3) http://www.faqs.org/rfcs/rfc3602.html
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::AES;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION @ISA @EXPORT_OK);
|
||||
require Exporter;
|
||||
|
||||
$VERSION = '1.01';
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT_OK = qw(Crypt);
|
||||
|
||||
my $seeded; # flag set if we already seeded random number generator
|
||||
my $nr; # number of rounds in AES cipher
|
||||
my @cbc; # cipher-block chaining bytes
|
||||
|
||||
# arrays (all unsigned character) to hold intermediate results during encryption
|
||||
my @state = ([],[],[],[]); # the 2-dimensional state array
|
||||
my @RoundKey; # round keys
|
||||
|
||||
my @sbox = (
|
||||
0x63, 0x7c, 0x77, 0x7b, 0xf2, 0x6b, 0x6f, 0xc5, 0x30, 0x01, 0x67, 0x2b, 0xfe, 0xd7, 0xab, 0x76,
|
||||
0xca, 0x82, 0xc9, 0x7d, 0xfa, 0x59, 0x47, 0xf0, 0xad, 0xd4, 0xa2, 0xaf, 0x9c, 0xa4, 0x72, 0xc0,
|
||||
0xb7, 0xfd, 0x93, 0x26, 0x36, 0x3f, 0xf7, 0xcc, 0x34, 0xa5, 0xe5, 0xf1, 0x71, 0xd8, 0x31, 0x15,
|
||||
0x04, 0xc7, 0x23, 0xc3, 0x18, 0x96, 0x05, 0x9a, 0x07, 0x12, 0x80, 0xe2, 0xeb, 0x27, 0xb2, 0x75,
|
||||
0x09, 0x83, 0x2c, 0x1a, 0x1b, 0x6e, 0x5a, 0xa0, 0x52, 0x3b, 0xd6, 0xb3, 0x29, 0xe3, 0x2f, 0x84,
|
||||
0x53, 0xd1, 0x00, 0xed, 0x20, 0xfc, 0xb1, 0x5b, 0x6a, 0xcb, 0xbe, 0x39, 0x4a, 0x4c, 0x58, 0xcf,
|
||||
0xd0, 0xef, 0xaa, 0xfb, 0x43, 0x4d, 0x33, 0x85, 0x45, 0xf9, 0x02, 0x7f, 0x50, 0x3c, 0x9f, 0xa8,
|
||||
0x51, 0xa3, 0x40, 0x8f, 0x92, 0x9d, 0x38, 0xf5, 0xbc, 0xb6, 0xda, 0x21, 0x10, 0xff, 0xf3, 0xd2,
|
||||
0xcd, 0x0c, 0x13, 0xec, 0x5f, 0x97, 0x44, 0x17, 0xc4, 0xa7, 0x7e, 0x3d, 0x64, 0x5d, 0x19, 0x73,
|
||||
0x60, 0x81, 0x4f, 0xdc, 0x22, 0x2a, 0x90, 0x88, 0x46, 0xee, 0xb8, 0x14, 0xde, 0x5e, 0x0b, 0xdb,
|
||||
0xe0, 0x32, 0x3a, 0x0a, 0x49, 0x06, 0x24, 0x5c, 0xc2, 0xd3, 0xac, 0x62, 0x91, 0x95, 0xe4, 0x79,
|
||||
0xe7, 0xc8, 0x37, 0x6d, 0x8d, 0xd5, 0x4e, 0xa9, 0x6c, 0x56, 0xf4, 0xea, 0x65, 0x7a, 0xae, 0x08,
|
||||
0xba, 0x78, 0x25, 0x2e, 0x1c, 0xa6, 0xb4, 0xc6, 0xe8, 0xdd, 0x74, 0x1f, 0x4b, 0xbd, 0x8b, 0x8a,
|
||||
0x70, 0x3e, 0xb5, 0x66, 0x48, 0x03, 0xf6, 0x0e, 0x61, 0x35, 0x57, 0xb9, 0x86, 0xc1, 0x1d, 0x9e,
|
||||
0xe1, 0xf8, 0x98, 0x11, 0x69, 0xd9, 0x8e, 0x94, 0x9b, 0x1e, 0x87, 0xe9, 0xce, 0x55, 0x28, 0xdf,
|
||||
0x8c, 0xa1, 0x89, 0x0d, 0xbf, 0xe6, 0x42, 0x68, 0x41, 0x99, 0x2d, 0x0f, 0xb0, 0x54, 0xbb, 0x16,
|
||||
);
|
||||
|
||||
# reverse sbox
|
||||
my @rsbox = (
|
||||
0x52, 0x09, 0x6a, 0xd5, 0x30, 0x36, 0xa5, 0x38, 0xbf, 0x40, 0xa3, 0x9e, 0x81, 0xf3, 0xd7, 0xfb,
|
||||
0x7c, 0xe3, 0x39, 0x82, 0x9b, 0x2f, 0xff, 0x87, 0x34, 0x8e, 0x43, 0x44, 0xc4, 0xde, 0xe9, 0xcb,
|
||||
0x54, 0x7b, 0x94, 0x32, 0xa6, 0xc2, 0x23, 0x3d, 0xee, 0x4c, 0x95, 0x0b, 0x42, 0xfa, 0xc3, 0x4e,
|
||||
0x08, 0x2e, 0xa1, 0x66, 0x28, 0xd9, 0x24, 0xb2, 0x76, 0x5b, 0xa2, 0x49, 0x6d, 0x8b, 0xd1, 0x25,
|
||||
0x72, 0xf8, 0xf6, 0x64, 0x86, 0x68, 0x98, 0x16, 0xd4, 0xa4, 0x5c, 0xcc, 0x5d, 0x65, 0xb6, 0x92,
|
||||
0x6c, 0x70, 0x48, 0x50, 0xfd, 0xed, 0xb9, 0xda, 0x5e, 0x15, 0x46, 0x57, 0xa7, 0x8d, 0x9d, 0x84,
|
||||
0x90, 0xd8, 0xab, 0x00, 0x8c, 0xbc, 0xd3, 0x0a, 0xf7, 0xe4, 0x58, 0x05, 0xb8, 0xb3, 0x45, 0x06,
|
||||
0xd0, 0x2c, 0x1e, 0x8f, 0xca, 0x3f, 0x0f, 0x02, 0xc1, 0xaf, 0xbd, 0x03, 0x01, 0x13, 0x8a, 0x6b,
|
||||
0x3a, 0x91, 0x11, 0x41, 0x4f, 0x67, 0xdc, 0xea, 0x97, 0xf2, 0xcf, 0xce, 0xf0, 0xb4, 0xe6, 0x73,
|
||||
0x96, 0xac, 0x74, 0x22, 0xe7, 0xad, 0x35, 0x85, 0xe2, 0xf9, 0x37, 0xe8, 0x1c, 0x75, 0xdf, 0x6e,
|
||||
0x47, 0xf1, 0x1a, 0x71, 0x1d, 0x29, 0xc5, 0x89, 0x6f, 0xb7, 0x62, 0x0e, 0xaa, 0x18, 0xbe, 0x1b,
|
||||
0xfc, 0x56, 0x3e, 0x4b, 0xc6, 0xd2, 0x79, 0x20, 0x9a, 0xdb, 0xc0, 0xfe, 0x78, 0xcd, 0x5a, 0xf4,
|
||||
0x1f, 0xdd, 0xa8, 0x33, 0x88, 0x07, 0xc7, 0x31, 0xb1, 0x12, 0x10, 0x59, 0x27, 0x80, 0xec, 0x5f,
|
||||
0x60, 0x51, 0x7f, 0xa9, 0x19, 0xb5, 0x4a, 0x0d, 0x2d, 0xe5, 0x7a, 0x9f, 0x93, 0xc9, 0x9c, 0xef,
|
||||
0xa0, 0xe0, 0x3b, 0x4d, 0xae, 0x2a, 0xf5, 0xb0, 0xc8, 0xeb, 0xbb, 0x3c, 0x83, 0x53, 0x99, 0x61,
|
||||
0x17, 0x2b, 0x04, 0x7e, 0xba, 0x77, 0xd6, 0x26, 0xe1, 0x69, 0x14, 0x63, 0x55, 0x21, 0x0c, 0x7d,
|
||||
);
|
||||
|
||||
# the round constant word array, $rcon[i], contains the values given by
|
||||
# x to the power (i-1) being powers of x (x is denoted as {02}) in the field GF(2^8)
|
||||
# Note that i starts at 1, not 0).
|
||||
my @rcon = (
|
||||
0x8d, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80, 0x1b, 0x36, 0x6c, 0xd8, 0xab, 0x4d, 0x9a,
|
||||
0x2f, 0x5e, 0xbc, 0x63, 0xc6, 0x97, 0x35, 0x6a, 0xd4, 0xb3, 0x7d, 0xfa, 0xef, 0xc5, 0x91, 0x39,
|
||||
0x72, 0xe4, 0xd3, 0xbd, 0x61, 0xc2, 0x9f, 0x25, 0x4a, 0x94, 0x33, 0x66, 0xcc, 0x83, 0x1d, 0x3a,
|
||||
0x74, 0xe8, 0xcb, 0x8d, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80, 0x1b, 0x36, 0x6c, 0xd8,
|
||||
0xab, 0x4d, 0x9a, 0x2f, 0x5e, 0xbc, 0x63, 0xc6, 0x97, 0x35, 0x6a, 0xd4, 0xb3, 0x7d, 0xfa, 0xef,
|
||||
0xc5, 0x91, 0x39, 0x72, 0xe4, 0xd3, 0xbd, 0x61, 0xc2, 0x9f, 0x25, 0x4a, 0x94, 0x33, 0x66, 0xcc,
|
||||
0x83, 0x1d, 0x3a, 0x74, 0xe8, 0xcb, 0x8d, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80, 0x1b,
|
||||
0x36, 0x6c, 0xd8, 0xab, 0x4d, 0x9a, 0x2f, 0x5e, 0xbc, 0x63, 0xc6, 0x97, 0x35, 0x6a, 0xd4, 0xb3,
|
||||
0x7d, 0xfa, 0xef, 0xc5, 0x91, 0x39, 0x72, 0xe4, 0xd3, 0xbd, 0x61, 0xc2, 0x9f, 0x25, 0x4a, 0x94,
|
||||
0x33, 0x66, 0xcc, 0x83, 0x1d, 0x3a, 0x74, 0xe8, 0xcb, 0x8d, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20,
|
||||
0x40, 0x80, 0x1b, 0x36, 0x6c, 0xd8, 0xab, 0x4d, 0x9a, 0x2f, 0x5e, 0xbc, 0x63, 0xc6, 0x97, 0x35,
|
||||
0x6a, 0xd4, 0xb3, 0x7d, 0xfa, 0xef, 0xc5, 0x91, 0x39, 0x72, 0xe4, 0xd3, 0xbd, 0x61, 0xc2, 0x9f,
|
||||
0x25, 0x4a, 0x94, 0x33, 0x66, 0xcc, 0x83, 0x1d, 0x3a, 0x74, 0xe8, 0xcb, 0x8d, 0x01, 0x02, 0x04,
|
||||
0x08, 0x10, 0x20, 0x40, 0x80, 0x1b, 0x36, 0x6c, 0xd8, 0xab, 0x4d, 0x9a, 0x2f, 0x5e, 0xbc, 0x63,
|
||||
0xc6, 0x97, 0x35, 0x6a, 0xd4, 0xb3, 0x7d, 0xfa, 0xef, 0xc5, 0x91, 0x39, 0x72, 0xe4, 0xd3, 0xbd,
|
||||
0x61, 0xc2, 0x9f, 0x25, 0x4a, 0x94, 0x33, 0x66, 0xcc, 0x83, 0x1d, 0x3a, 0x74, 0xe8, 0xcb,
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# This function produces 4*($nr+1) round keys.
|
||||
# The round keys are used in each round to encrypt the states.
|
||||
# Inputs: 0) key string (must be 16, 24 or 32 bytes long)
|
||||
sub KeyExpansion($)
|
||||
{
|
||||
my $key = shift;
|
||||
my @key = unpack 'C*', $key; # convert the key into a byte array
|
||||
my $nk = int(length($key) / 4); # number of 32-bit words in the key
|
||||
$nr = $nk + 6; # number of rounds
|
||||
|
||||
# temporary variables (all unsigned characters)
|
||||
my ($i,@temp);
|
||||
|
||||
# The first round key is the key itself.
|
||||
for ($i=0; $i<$nk; ++$i) {
|
||||
@RoundKey[$i*4..$i*4+3] = @key[$i*4..$i*4+3];
|
||||
}
|
||||
# All other round keys are found from the previous round keys.
|
||||
while ($i < (4 * ($nr+1))) {
|
||||
|
||||
@temp[0..3] = @RoundKey[($i-1)*4..($i-1)*4+3];
|
||||
|
||||
if ($i % $nk == 0) {
|
||||
# rotate the 4 bytes in a word to the left once
|
||||
# [a0,a1,a2,a3] becomes [a1,a2,a3,a0]
|
||||
@temp[0..3] = @temp[1,2,3,0];
|
||||
|
||||
# take a four-byte input word and apply the S-box
|
||||
# to each of the four bytes to produce an output word.
|
||||
@temp[0..3] = @sbox[@temp[0..3]];
|
||||
|
||||
$temp[0] = $temp[0] ^ $rcon[$i/$nk];
|
||||
|
||||
} elsif ($nk > 6 && $i % $nk == 4) {
|
||||
|
||||
@temp[0..3] = @sbox[@temp[0..3]];
|
||||
}
|
||||
$RoundKey[$i*4+0] = $RoundKey[($i-$nk)*4+0] ^ $temp[0];
|
||||
$RoundKey[$i*4+1] = $RoundKey[($i-$nk)*4+1] ^ $temp[1];
|
||||
$RoundKey[$i*4+2] = $RoundKey[($i-$nk)*4+2] ^ $temp[2];
|
||||
$RoundKey[$i*4+3] = $RoundKey[($i-$nk)*4+3] ^ $temp[3];
|
||||
++$i;
|
||||
}
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# This function adds the round key to state.
|
||||
# The round key is added to the state by an XOR function.
|
||||
sub AddRoundKey($)
|
||||
{
|
||||
my $round = shift;
|
||||
my ($i,$j);
|
||||
for ($i=0; $i<4; ++$i) {
|
||||
my $k = $round*16 + $i*4;
|
||||
for ($j=0; $j<4; ++$j) {
|
||||
$state[$j][$i] ^= $RoundKey[$k + $j];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Substitute the values in the state matrix with values in an S-box
|
||||
sub SubBytes()
|
||||
{
|
||||
my $i;
|
||||
for ($i=0; $i<4; ++$i) {
|
||||
@{$state[$i]}[0..3] = @sbox[@{$state[$i]}[0..3]];
|
||||
}
|
||||
}
|
||||
|
||||
sub InvSubBytes()
|
||||
{
|
||||
my $i;
|
||||
for ($i=0; $i<4; ++$i) {
|
||||
@{$state[$i]}[0..3] = @rsbox[@{$state[$i]}[0..3]];
|
||||
}
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Shift the rows in the state to the left.
|
||||
# Each row is shifted with different offset.
|
||||
# Offset = Row number. So the first row is not shifted.
|
||||
sub ShiftRows()
|
||||
{
|
||||
# rotate first row 1 columns to left
|
||||
@{$state[1]}[0,1,2,3] = @{$state[1]}[1,2,3,0];
|
||||
|
||||
# rotate second row 2 columns to left
|
||||
@{$state[2]}[0,1,2,3] = @{$state[2]}[2,3,0,1];
|
||||
|
||||
# rotate third row 3 columns to left
|
||||
@{$state[3]}[0,1,2,3] = @{$state[3]}[3,0,1,2];
|
||||
}
|
||||
|
||||
sub InvShiftRows()
|
||||
{
|
||||
# rotate first row 1 columns to right
|
||||
@{$state[1]}[0,1,2,3] = @{$state[1]}[3,0,1,2];
|
||||
|
||||
# rotate second row 2 columns to right
|
||||
@{$state[2]}[0,1,2,3] = @{$state[2]}[2,3,0,1];
|
||||
|
||||
# rotate third row 3 columns to right
|
||||
@{$state[3]}[0,1,2,3] = @{$state[3]}[1,2,3,0];
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Find the product of {02} and the argument to xtime modulo 0x1b
|
||||
# Note: returns an integer which may need to be trimmed to 8 bits
|
||||
sub xtime($)
|
||||
{
|
||||
return ($_[0]<<1) ^ ((($_[0]>>7) & 1) * 0x1b);
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Multiply numbers in the field GF(2^8)
|
||||
sub Mult($$)
|
||||
{
|
||||
my ($x, $y) = @_;
|
||||
return (($y & 1) * $x) ^
|
||||
(($y>>1 & 1) * xtime($x)) ^
|
||||
(($y>>2 & 1) * xtime(xtime($x))) ^
|
||||
(($y>>3 & 1) * xtime(xtime(xtime($x)))) ^
|
||||
(($y>>4 & 1) * xtime(xtime(xtime(xtime($x)))));
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Mix the columns of the state matrix
|
||||
sub MixColumns()
|
||||
{
|
||||
my ($i,$t0,$t1,$t2);
|
||||
for ($i=0; $i<4; ++$i) {
|
||||
$t0 = $state[0][$i];
|
||||
$t2 = $state[0][$i] ^ $state[1][$i] ^ $state[2][$i] ^ $state[3][$i];
|
||||
$t1 = $state[0][$i] ^ $state[1][$i] ; $t1 = xtime($t1) & 0xff; $state[0][$i] ^= $t1 ^ $t2 ;
|
||||
$t1 = $state[1][$i] ^ $state[2][$i] ; $t1 = xtime($t1) & 0xff; $state[1][$i] ^= $t1 ^ $t2 ;
|
||||
$t1 = $state[2][$i] ^ $state[3][$i] ; $t1 = xtime($t1) & 0xff; $state[2][$i] ^= $t1 ^ $t2 ;
|
||||
$t1 = $state[3][$i] ^ $t0 ; $t1 = xtime($t1) & 0xff; $state[3][$i] ^= $t1 ^ $t2 ;
|
||||
}
|
||||
}
|
||||
|
||||
sub InvMixColumns()
|
||||
{
|
||||
my $i;
|
||||
for ($i=0; $i<4; ++$i) {
|
||||
my $a = $state[0][$i];
|
||||
my $b = $state[1][$i];
|
||||
my $c = $state[2][$i];
|
||||
my $d = $state[3][$i];
|
||||
$state[0][$i] = (Mult($a,0x0e) ^ Mult($b,0x0b) ^ Mult($c,0x0d) ^ Mult($d,0x09)) & 0xff;
|
||||
$state[1][$i] = (Mult($a,0x09) ^ Mult($b,0x0e) ^ Mult($c,0x0b) ^ Mult($d,0x0d)) & 0xff;
|
||||
$state[2][$i] = (Mult($a,0x0d) ^ Mult($b,0x09) ^ Mult($c,0x0e) ^ Mult($d,0x0b)) & 0xff;
|
||||
$state[3][$i] = (Mult($a,0x0b) ^ Mult($b,0x0d) ^ Mult($c,0x09) ^ Mult($d,0x0e)) & 0xff;
|
||||
}
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Encrypt (Cipher) or decrypt (InvCipher) a block of data with CBC
|
||||
# Inputs: 0) string to cipher (must be 16 bytes long)
|
||||
# Returns: cipher'd string
|
||||
sub Cipher($)
|
||||
{
|
||||
my @in = unpack 'C*', $_[0]; # unpack input plaintext
|
||||
my ($i, $j, $round);
|
||||
|
||||
# copy the input PlainText to state array and apply the CBC
|
||||
for ($i=0; $i<4; ++$i) {
|
||||
for ($j=0; $j<4; ++$j) {
|
||||
my $k = $i*4 + $j;
|
||||
$state[$j][$i] = $in[$k] ^ $cbc[$k];
|
||||
}
|
||||
}
|
||||
|
||||
# add the First round key to the state before starting the rounds
|
||||
AddRoundKey(0);
|
||||
|
||||
# there will be $nr rounds; the first $nr-1 rounds are identical
|
||||
for ($round=1; ; ++$round) {
|
||||
SubBytes();
|
||||
ShiftRows();
|
||||
if ($round < $nr) {
|
||||
MixColumns();
|
||||
AddRoundKey($round);
|
||||
} else {
|
||||
# MixColumns() is not used in the last round
|
||||
AddRoundKey($nr);
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
# the encryption process is over
|
||||
# copy the state array to output array (and save for CBC)
|
||||
for ($i=0; $i<4; ++$i) {
|
||||
for ($j=0; $j<4; ++$j) {
|
||||
$cbc[$i*4+$j] = $state[$j][$i];
|
||||
}
|
||||
}
|
||||
return pack 'C*', @cbc; # return packed ciphertext
|
||||
}
|
||||
|
||||
sub InvCipher($)
|
||||
{
|
||||
my @in = unpack 'C*', $_[0]; # unpack input ciphertext
|
||||
my (@out, $i, $j, $round);
|
||||
|
||||
# copy the input CipherText to state array
|
||||
for ($i=0; $i<4; ++$i) {
|
||||
for ($j=0; $j<4; ++$j) {
|
||||
$state[$j][$i] = $in[$i*4 + $j];
|
||||
}
|
||||
}
|
||||
|
||||
# add the First round key to the state before starting the rounds
|
||||
AddRoundKey($nr);
|
||||
|
||||
# there will be $nr rounds; the first $nr-1 rounds are identical
|
||||
for ($round=$nr-1; ; --$round) {
|
||||
InvShiftRows();
|
||||
InvSubBytes();
|
||||
AddRoundKey($round);
|
||||
# InvMixColumns() is not used in the last round
|
||||
last if $round <= 0;
|
||||
InvMixColumns();
|
||||
}
|
||||
|
||||
# copy the state array to output array and reverse the CBC
|
||||
for ($i=0; $i<4; ++$i) {
|
||||
for ($j=0; $j<4; ++$j) {
|
||||
my $k = $i*4 + $j;
|
||||
$out[$k] = $state[$j][$i] ^ $cbc[$k];
|
||||
}
|
||||
}
|
||||
@cbc = @in; # update CBC for next block
|
||||
return pack 'C*', @out; # return packed plaintext
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Encrypt/Decrypt using AES-CBC algorithm (with fixed 16-byte blocks)
|
||||
# Inputs: 0) data reference (with leading 16-byte initialization vector when decrypting)
|
||||
# 1) encryption key (16, 24 or 32 bytes for AES-128, AES-192 or AES-256)
|
||||
# 2) encrypt flag (false for decryption, true with length 16 bytes to
|
||||
# encrypt using this as the CBC IV, or true with other length to
|
||||
# encrypt with a randomly-generated IV)
|
||||
# 3) flag to disable padding
|
||||
# Returns: error string, or undef on success
|
||||
# Notes: encrypts/decrypts data in place (encrypted data returned with leading IV)
|
||||
sub Crypt($$;$$)
|
||||
{
|
||||
my ($dataPt, $key, $encrypt, $noPad) = @_;
|
||||
|
||||
# validate key length
|
||||
my $keyLen = length $key;
|
||||
unless ($keyLen == 16 or $keyLen == 24 or $keyLen == 32) {
|
||||
return "Invalid AES key length ($keyLen)";
|
||||
}
|
||||
my $partLen = length($$dataPt) % 16;
|
||||
my ($pos, $i);
|
||||
if ($encrypt) {
|
||||
if (length($encrypt) == 16) {
|
||||
@cbc = unpack 'C*', $encrypt;
|
||||
} else {
|
||||
# generate a random 16-byte CBC initialization vector
|
||||
unless ($seeded) {
|
||||
srand(time() & ($$ + ($$<<15)));
|
||||
$seeded = 1;
|
||||
}
|
||||
for ($i=0; $i<16; ++$i) {
|
||||
$cbc[$i] = int(rand(256));
|
||||
}
|
||||
$encrypt = pack 'C*', @cbc;
|
||||
}
|
||||
$$dataPt = $encrypt . $$dataPt; # add IV to the start of the data
|
||||
# add required padding so we can recover the
|
||||
# original string length after decryption
|
||||
# (padding bytes have value set to padding length)
|
||||
my $padLen = 16 - $partLen;
|
||||
$$dataPt .= (chr($padLen)) x $padLen unless $padLen == 16 and $noPad;
|
||||
$pos = 16; # start encrypting at byte 16 (after the IV)
|
||||
} elsif ($partLen) {
|
||||
return 'Invalid AES ciphertext length';
|
||||
} elsif (length $$dataPt >= 32) {
|
||||
# take the CBC initialization vector from the start of the data
|
||||
@cbc = unpack 'C16', $$dataPt;
|
||||
$$dataPt = substr($$dataPt, 16);
|
||||
$pos = 0; # start decrypting from byte 0 (now that IV is removed)
|
||||
} else {
|
||||
$$dataPt = ''; # empty text
|
||||
return undef;
|
||||
}
|
||||
# the KeyExpansion routine must be called before encryption
|
||||
KeyExpansion($key);
|
||||
|
||||
# loop through the data and convert in blocks
|
||||
my $dataLen = length $$dataPt;
|
||||
my $last = $dataLen - 16;
|
||||
my $func = $encrypt ? \&Cipher : \&InvCipher;
|
||||
while ($pos <= $last) {
|
||||
# cipher this block
|
||||
substr($$dataPt, $pos, 16) = &$func(substr($$dataPt, $pos, 16));
|
||||
$pos += 16;
|
||||
}
|
||||
unless ($encrypt or $noPad) {
|
||||
# remove padding if necessary (padding byte value gives length of padding)
|
||||
my $padLen = ord(substr($$dataPt, -1, 1));
|
||||
return 'AES decryption error (invalid pad byte)' if $padLen > 16;
|
||||
$$dataPt = substr($$dataPt, 0, $dataLen - $padLen);
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::AES - AES encryption with cipher-block chaining
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Image::ExifTool::AES qw(Crypt);
|
||||
|
||||
$err = Crypt(\$plaintext, $key, 1); # encryption
|
||||
|
||||
$err = Crypt(\$ciphertext, $key); # decryption
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains an implementation of the AES encryption/decryption
|
||||
algorithms with cipher-block chaining (CBC) and RFC 2898 PKCS #5 padding.
|
||||
This is the AESV2 and AESV3 encryption mode used in PDF documents.
|
||||
|
||||
=head1 EXPORTS
|
||||
|
||||
Exports nothing by default, but L</Crypt> may be exported.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 Crypt
|
||||
|
||||
Implement AES encryption/decryption with cipher-block chaining.
|
||||
|
||||
=over 4
|
||||
|
||||
=item Inputs:
|
||||
|
||||
0) Scalar reference for data to encrypt/decrypt.
|
||||
|
||||
1) Encryption key string (must have length 16, 24 or 32).
|
||||
|
||||
2) [optional] Encrypt flag (false to decrypt).
|
||||
|
||||
3) [optional] Flag to avoid removing padding after decrypting, or to avoid
|
||||
adding 16 bytes of padding before encrypting when data length is already a
|
||||
multiple of 16 bytes.
|
||||
|
||||
=item Returns:
|
||||
|
||||
On success, the return value is undefined and the data is encrypted or
|
||||
decrypted as specified. Otherwise returns an error string and the data is
|
||||
left in an indeterminate state.
|
||||
|
||||
=item Notes:
|
||||
|
||||
The length of the encryption key dictates the AES mode, with lengths of 16,
|
||||
24 and 32 bytes resulting in AES-128, AES-192 and AES-256.
|
||||
|
||||
When encrypting, the input data may be any length and will be padded to an
|
||||
even 16-byte block size using the specified padding technique. If the
|
||||
encrypt flag has length 16, it is used as the initialization vector for
|
||||
the cipher-block chaining, otherwise a random IV is generated. Upon
|
||||
successful return the data will be encrypted, with the first 16 bytes of
|
||||
the data being the CBC IV.
|
||||
|
||||
When decrypting, the input data begins with the 16-byte CBC initialization
|
||||
vector.
|
||||
|
||||
=back
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
This code is blindingly slow. But in truth, slowing down processing is the
|
||||
main purpose of encryption, so this really can't be considered a bug.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://www.hoozi.com/Articles/AESEncryption.htm>
|
||||
|
||||
=item L<http://www.csrc.nist.gov/publications/fips/fips197/fips-197.pdf>
|
||||
|
||||
=item L<http://www.faqs.org/rfcs/rfc3602.html>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,281 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: AFCP.pm
|
||||
#
|
||||
# Description: Read/write AFCP trailer
|
||||
#
|
||||
# Revisions: 12/26/2005 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://web.archive.org/web/20080828211305/http://www.tocarte.com/media/axs_afcp_spec.pdf
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::AFCP;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.08';
|
||||
|
||||
sub ProcessAFCP($$);
|
||||
|
||||
%Image::ExifTool::AFCP::Main = (
|
||||
PROCESS_PROC => \&ProcessAFCP,
|
||||
NOTES => q{
|
||||
AFCP stands for AXS File Concatenation Protocol, and is a poorly designed
|
||||
protocol for appending information to the end of files. This can be used as
|
||||
an auxiliary technique to store IPTC information in images, but is
|
||||
incompatible with some file formats.
|
||||
|
||||
ExifTool will read and write (but not create) AFCP IPTC information in JPEG
|
||||
and TIFF images.
|
||||
|
||||
See
|
||||
L<http://web.archive.org/web/20080828211305/http://www.tocarte.com/media/axs_afcp_spec.pdf>
|
||||
for the AFCP specification.
|
||||
},
|
||||
IPTC => { SubDirectory => { TagTable => 'Image::ExifTool::IPTC::Main' } },
|
||||
TEXT => 'Text',
|
||||
Nail => {
|
||||
Name => 'ThumbnailImage',
|
||||
Groups => { 2 => 'Preview' },
|
||||
# (the specification allows for a variable amount of padding before
|
||||
# the image after a 10-byte header, so look for the JPEG SOI marker,
|
||||
# otherwise assume a fixed 8 bytes of padding)
|
||||
RawConv => q{
|
||||
pos($val) = 10;
|
||||
my $start = ($val =~ /\xff\xd8\xff/g) ? pos($val) - 3 : 18;
|
||||
my $img = substr($val, $start);
|
||||
return $self->ValidateImage(\$img, $tag);
|
||||
},
|
||||
},
|
||||
PrVw => {
|
||||
Name => 'PreviewImage',
|
||||
Groups => { 2 => 'Preview' },
|
||||
RawConv => q{
|
||||
pos($val) = 10;
|
||||
my $start = ($val =~ /\xff\xd8\xff/g) ? pos($val) - 3 : 18;
|
||||
my $img = substr($val, $start);
|
||||
return $self->ValidateImage(\$img, $tag);
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read/write AFCP information in a file
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
||||
# (Set 'ScanForAFCP' member in dirInfo to scan from current position for AFCP)
|
||||
# Returns: 1 on success, 0 if this file didn't contain AFCP information
|
||||
# -1 on write error or if the offsets were incorrect on reading
|
||||
# - updates DataPos to point to actual AFCP start if ScanForAFCP is set
|
||||
# - updates DirLen to trailer length
|
||||
# - returns Fixup reference in dirInfo hash when writing
|
||||
sub ProcessAFCP($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $curPos = $raf->Tell();
|
||||
my $offset = $$dirInfo{Offset} || 0; # offset from end of file
|
||||
my $rtnVal = 0;
|
||||
|
||||
NoAFCP: for (;;) {
|
||||
my ($buff, $fix, $dirBuff, $valBuff, $fixup, $vers);
|
||||
# look for AXS trailer
|
||||
last unless $raf->Seek(-12-$offset, 2) and
|
||||
$raf->Read($buff, 12) == 12 and
|
||||
$buff =~ /^(AXS(!|\*))/;
|
||||
my $endPos = $raf->Tell();
|
||||
my $hdr = $1;
|
||||
SetByteOrder($2 eq '!' ? 'MM' : 'II');
|
||||
my $startPos = Get32u(\$buff, 4);
|
||||
if ($raf->Seek($startPos, 0) and $raf->Read($buff, 12) == 12 and $buff =~ /^$hdr/) {
|
||||
$fix = 0;
|
||||
} else {
|
||||
$rtnVal = -1;
|
||||
# look for start of AXS trailer if 'ScanForAFCP'
|
||||
last unless $$dirInfo{ScanForAFCP} and $raf->Seek($curPos, 0);
|
||||
my $actualPos = $curPos;
|
||||
# first look for header right at current position
|
||||
for (;;) {
|
||||
last if $raf->Read($buff, 12) == 12 and $buff =~ /^$hdr/;
|
||||
last NoAFCP if $actualPos != $curPos;
|
||||
# scan for AXS header (could be after preview image)
|
||||
for (;;) {
|
||||
my $buf2;
|
||||
$raf->Read($buf2, 65536) or last NoAFCP;
|
||||
$buff .= $buf2;
|
||||
if ($buff =~ /$hdr/g) {
|
||||
$actualPos += pos($buff) - length($hdr);
|
||||
last; # ok, now go back and re-read header
|
||||
}
|
||||
$buf2 = substr($buf2, -3); # only need last 3 bytes for next test
|
||||
$actualPos += length($buff) - length($buf2);
|
||||
$buff = $buf2;
|
||||
}
|
||||
last unless $raf->Seek($actualPos, 0); # seek to start of AFCP
|
||||
}
|
||||
# calculate shift for fixing AFCP offsets
|
||||
$fix = $actualPos - $startPos;
|
||||
}
|
||||
# set variables returned in dirInfo hash
|
||||
$$dirInfo{DataPos} = $startPos + $fix; # actual start position
|
||||
$$dirInfo{DirLen} = $endPos - ($startPos + $fix);
|
||||
|
||||
$rtnVal = 1;
|
||||
my $verbose = $et->Options('Verbose');
|
||||
my $out = $et->Options('TextOut');
|
||||
my $outfile = $$dirInfo{OutFile};
|
||||
if ($outfile) {
|
||||
# allow all AFCP information to be deleted
|
||||
if ($$et{DEL_GROUP}{AFCP}) {
|
||||
$verbose and print $out " Deleting AFCP\n";
|
||||
++$$et{CHANGED};
|
||||
last;
|
||||
}
|
||||
$dirBuff = $valBuff = '';
|
||||
require Image::ExifTool::Fixup;
|
||||
$fixup = $$dirInfo{Fixup};
|
||||
$fixup or $fixup = $$dirInfo{Fixup} = new Image::ExifTool::Fixup;
|
||||
$vers = substr($buff, 4, 2); # get version number
|
||||
} else {
|
||||
$et->DumpTrailer($dirInfo) if $verbose or $$et{HTML_DUMP};
|
||||
}
|
||||
# read AFCP directory data
|
||||
my $numEntries = Get16u(\$buff, 6);
|
||||
my $dir;
|
||||
unless ($raf->Read($dir, 12 * $numEntries) == 12 * $numEntries) {
|
||||
$et->Error('Error reading AFCP directory', 1);
|
||||
last;
|
||||
}
|
||||
if ($verbose > 2 and not $outfile) {
|
||||
my $dat = $buff . $dir;
|
||||
print $out " AFCP Directory:\n";
|
||||
$et->VerboseDump(\$dat, Addr => $$dirInfo{DataPos}, Width => 12);
|
||||
}
|
||||
$fix and $et->Warn("Adjusted AFCP offsets by $fix", 1);
|
||||
#
|
||||
# process AFCP directory
|
||||
#
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::AFCP::Main');
|
||||
my ($index, $entry);
|
||||
for ($index=0; $index<$numEntries; ++$index) {
|
||||
my $entry = 12 * $index;
|
||||
my $tag = substr($dir, $entry, 4);
|
||||
my $size = Get32u(\$dir, $entry + 4);
|
||||
my $offset = Get32u(\$dir, $entry + 8);
|
||||
if ($size < 0x80000000 and
|
||||
$raf->Seek($offset+$fix, 0) and
|
||||
$raf->Read($buff, $size) == $size)
|
||||
{
|
||||
if ($outfile) {
|
||||
# rewrite this information
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
|
||||
if ($tagInfo and $$tagInfo{SubDirectory}) {
|
||||
my %subdirInfo = (
|
||||
DataPt => \$buff,
|
||||
DirStart => 0,
|
||||
DirLen => $size,
|
||||
DataPos => $offset + $fix,
|
||||
Parent => 'AFCP',
|
||||
);
|
||||
my $subTable = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
|
||||
my $newDir = $et->WriteDirectory(\%subdirInfo, $subTable);
|
||||
if (defined $newDir) {
|
||||
$size = length $newDir;
|
||||
$buff = $newDir;
|
||||
}
|
||||
}
|
||||
$fixup->AddFixup(length($dirBuff) + 8);
|
||||
$dirBuff .= $tag . Set32u($size) . Set32u(length $valBuff);
|
||||
$valBuff .= $buff;
|
||||
} else {
|
||||
# extract information
|
||||
$et->HandleTag($tagTablePtr, $tag, $buff,
|
||||
DataPt => \$buff,
|
||||
Size => $size,
|
||||
Index => $index,
|
||||
DataPos => $offset + $fix,
|
||||
);
|
||||
}
|
||||
} else {
|
||||
$et->Warn("Bad AFCP directory");
|
||||
$rtnVal = -1 if $outfile;
|
||||
last;
|
||||
}
|
||||
}
|
||||
if ($outfile and length($dirBuff)) {
|
||||
my $outPos = Tell($outfile); # get current outfile position
|
||||
# apply fixup to directory pointers
|
||||
my $valPos = $outPos + 12; # start of value data
|
||||
$fixup->{Shift} += $valPos + length($dirBuff);
|
||||
$fixup->ApplyFixup(\$dirBuff);
|
||||
# write the AFCP header, directory, value data and EOF record (with zero checksums)
|
||||
Write($outfile, $hdr, $vers, Set16u(length($dirBuff)/12), Set32u(0),
|
||||
$dirBuff, $valBuff, $hdr, Set32u($outPos), Set32u(0)) or $rtnVal = -1;
|
||||
# complete fixup so the calling routine can apply further shifts
|
||||
$fixup->AddFixup(length($dirBuff) + length($valBuff) + 4);
|
||||
$fixup->{Start} += $valPos;
|
||||
$fixup->{Shift} -= $valPos;
|
||||
}
|
||||
last;
|
||||
}
|
||||
return $rtnVal;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::AFCP - Read/write AFCP trailer
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to extract
|
||||
information from the AFCP trailer. Although the AFCP specification is
|
||||
compatible with various file formats, ExifTool currently only processes AFCP
|
||||
in JPEG images.
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
AFCP is a specification which allows meta information (including IPTC) to be
|
||||
appended to the end of a file.
|
||||
|
||||
It is a poorly designed protocol because (like TIFF) it uses absolute
|
||||
offsets to specify data locations. This is a huge blunder because it makes
|
||||
the AFCP information dependent on the file length, so it is easily
|
||||
invalidated by image editing software which doesn't recognize the AFCP
|
||||
trailer to fix up these offsets when the file length changes. ExifTool will
|
||||
attempt to fix these invalid offsets if possible.
|
||||
|
||||
Scanning for AFCP information may be time consuming, especially when reading
|
||||
from a sequential device, since the information is at the end of the file.
|
||||
In these instances, the ExifTool FastScan option may be used to disable
|
||||
scanning for AFCP information.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://www.tocarte.com/media/axs_afcp_spec.pdf>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/AFCP Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,289 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: AIFF.pm
|
||||
#
|
||||
# Description: Read AIFF meta information
|
||||
#
|
||||
# Revisions: 01/06/2006 - P. Harvey Created
|
||||
# 09/22/2008 - PH Added DjVu support
|
||||
#
|
||||
# References: 1) http://developer.apple.com/documentation/QuickTime/INMAC/SOUND/imsoundmgr.30.htm#pgfId=3190
|
||||
# 2) http://astronomy.swin.edu.au/~pbourke/dataformats/aiff/
|
||||
# 3) http://www.mactech.com/articles/mactech/Vol.06/06.01/SANENormalized/
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::AIFF;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
use Image::ExifTool::ID3;
|
||||
|
||||
$VERSION = '1.08';
|
||||
|
||||
# information for time/date-based tags (time zero is Jan 1, 1904)
|
||||
my %timeInfo = (
|
||||
Groups => { 2 => 'Time' },
|
||||
ValueConv => 'ConvertUnixTime($val - ((66 * 365 + 17) * 24 * 3600))',
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
);
|
||||
|
||||
# AIFF info
|
||||
%Image::ExifTool::AIFF::Main = (
|
||||
GROUPS => { 2 => 'Audio' },
|
||||
NOTES => q{
|
||||
Tags extracted from Audio Interchange File Format (AIFF) files. See
|
||||
L<http://www-mmsp.ece.mcgill.ca/Documents/AudioFormats/AIFF/AIFF.html> for
|
||||
the AIFF specification.
|
||||
},
|
||||
# FORM => 'Format',
|
||||
FVER => {
|
||||
Name => 'FormatVersion',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::AIFF::FormatVers' },
|
||||
},
|
||||
COMM => {
|
||||
Name => 'Common',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::AIFF::Common' },
|
||||
},
|
||||
COMT => {
|
||||
Name => 'Comment',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::AIFF::Comment' },
|
||||
},
|
||||
NAME => {
|
||||
Name => 'Name',
|
||||
ValueConv => '$self->Decode($val, "MacRoman")',
|
||||
},
|
||||
AUTH => {
|
||||
Name => 'Author',
|
||||
Groups => { 2 => 'Author' },
|
||||
ValueConv => '$self->Decode($val, "MacRoman")',
|
||||
},
|
||||
'(c) ' => {
|
||||
Name => 'Copyright',
|
||||
Groups => { 2 => 'Author' },
|
||||
ValueConv => '$self->Decode($val, "MacRoman")',
|
||||
},
|
||||
ANNO => {
|
||||
Name => 'Annotation',
|
||||
ValueConv => '$self->Decode($val, "MacRoman")',
|
||||
},
|
||||
'ID3 ' => {
|
||||
Name => 'ID3',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::ID3::Main',
|
||||
ProcessProc => \&Image::ExifTool::ID3::ProcessID3,
|
||||
},
|
||||
},
|
||||
# SSND => 'SoundData',
|
||||
# MARK => 'Marker',
|
||||
# INST => 'Instrument',
|
||||
# MIDI => 'MidiData',
|
||||
# AESD => 'AudioRecording',
|
||||
# APPL => 'ApplicationSpecific',
|
||||
);
|
||||
|
||||
%Image::ExifTool::AIFF::Common = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 2 => 'Audio' },
|
||||
FORMAT => 'int16u',
|
||||
0 => 'NumChannels',
|
||||
1 => { Name => 'NumSampleFrames', Format => 'int32u' },
|
||||
3 => 'SampleSize',
|
||||
4 => { Name => 'SampleRate', Format => 'extended' }, #3
|
||||
9 => {
|
||||
Name => 'CompressionType',
|
||||
Format => 'string[4]',
|
||||
PrintConv => {
|
||||
NONE => 'None',
|
||||
ACE2 => 'ACE 2-to-1',
|
||||
ACE8 => 'ACE 8-to-3',
|
||||
MAC3 => 'MAC 3-to-1',
|
||||
MAC6 => 'MAC 6-to-1',
|
||||
sowt => 'Little-endian, no compression',
|
||||
},
|
||||
},
|
||||
11 => { #PH
|
||||
Name => 'CompressorName',
|
||||
Format => 'pstring',
|
||||
ValueConv => '$self->Decode($val, "MacRoman")',
|
||||
},
|
||||
);
|
||||
|
||||
%Image::ExifTool::AIFF::FormatVers = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
FORMAT => 'int32u',
|
||||
0 => { Name => 'FormatVersionTime', %timeInfo },
|
||||
);
|
||||
|
||||
%Image::ExifTool::AIFF::Comment = (
|
||||
PROCESS_PROC => \&Image::ExifTool::AIFF::ProcessComment,
|
||||
GROUPS => { 2 => 'Audio' },
|
||||
0 => { Name => 'CommentTime', %timeInfo },
|
||||
1 => 'MarkerID',
|
||||
2 => {
|
||||
Name => 'Comment',
|
||||
ValueConv => '$self->Decode($val, "MacRoman")',
|
||||
},
|
||||
);
|
||||
|
||||
%Image::ExifTool::AIFF::Composite = (
|
||||
Duration => {
|
||||
Require => {
|
||||
0 => 'AIFF:SampleRate',
|
||||
1 => 'AIFF:NumSampleFrames',
|
||||
},
|
||||
RawConv => '($val[0] and $val[1]) ? $val[1] / $val[0] : undef',
|
||||
PrintConv => 'ConvertDuration($val)',
|
||||
},
|
||||
);
|
||||
|
||||
# add our composite tags
|
||||
Image::ExifTool::AddCompositeTags('Image::ExifTool::AIFF');
|
||||
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process AIFF Comment chunk
|
||||
# Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) tag table ref
|
||||
# Returns: 1 on success
|
||||
sub ProcessComment($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dirLen = $$dirInfo{DirLen};
|
||||
my $verbose = $et->Options('Verbose');
|
||||
return 0 unless $dirLen > 2;
|
||||
my $numComments = unpack('n',$$dataPt);
|
||||
my $pos = 2;
|
||||
my $i;
|
||||
$verbose and $et->VerboseDir('Comment', $numComments);
|
||||
for ($i=0; $i<$numComments; ++$i) {
|
||||
last if $pos + 8 > $dirLen;
|
||||
my ($time, $markerID, $size) = unpack("x${pos}Nnn", $$dataPt);
|
||||
$et->HandleTag($tagTablePtr, 0, $time);
|
||||
$et->HandleTag($tagTablePtr, 1, $markerID) if $markerID;
|
||||
$pos += 8;
|
||||
last if $pos + $size > $dirLen;
|
||||
my $val = substr($$dataPt, $pos, $size);
|
||||
$et->HandleTag($tagTablePtr, 2, $val);
|
||||
++$size if $size & 0x01; # account for padding byte if necessary
|
||||
$pos += $size;
|
||||
}
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Extract information from a AIFF file
|
||||
# Inputs: 0) ExifTool object reference, 1) DirInfo reference
|
||||
# Returns: 1 on success, 0 if this wasn't a valid AIFF file
|
||||
sub ProcessAIFF($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my ($buff, $err, $tagTablePtr, $page, $type);
|
||||
|
||||
# verify this is a valid AIFF file
|
||||
return 0 unless $raf->Read($buff, 12) == 12;
|
||||
my $fast3 = $$et{OPTIONS}{FastScan} && $$et{OPTIONS}{FastScan} == 3;
|
||||
my $pos = 12;
|
||||
# check for DjVu image
|
||||
if ($buff =~ /^AT&TFORM/) {
|
||||
# http://www.djvu.org/
|
||||
# http://djvu.sourceforge.net/specs/djvu3changes.txt
|
||||
my $buf2;
|
||||
return 0 unless $raf->Read($buf2, 4) == 4 and $buf2 =~ /^(DJVU|DJVM)/;
|
||||
$pos += 4;
|
||||
$buff = substr($buff, 4) . $buf2;
|
||||
$et->SetFileType('DJVU');
|
||||
return 1 if $fast3;
|
||||
$tagTablePtr = GetTagTable('Image::ExifTool::DjVu::Main');
|
||||
# modifiy FileType to indicate a multi-page document
|
||||
$$et{VALUE}{FileType} .= " (multi-page)" if $buf2 eq 'DJVM';
|
||||
$type = 'DjVu';
|
||||
} else {
|
||||
return 0 unless $buff =~ /^FORM....(AIF(F|C))/s;
|
||||
$et->SetFileType($1);
|
||||
return 1 if $fast3;
|
||||
$tagTablePtr = GetTagTable('Image::ExifTool::AIFF::Main');
|
||||
$type = 'AIFF';
|
||||
}
|
||||
SetByteOrder('MM');
|
||||
my $verbose = $et->Options('Verbose');
|
||||
#
|
||||
# Read through the IFF chunks
|
||||
#
|
||||
for (;;) {
|
||||
$raf->Read($buff, 8) == 8 or last;
|
||||
$pos += 8;
|
||||
my ($tag, $len) = unpack('a4N', $buff);
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
|
||||
$et->VPrint(0, "AIFF '${tag}' chunk ($len bytes of data):\n");
|
||||
# AIFF chunks are padded to an even number of bytes
|
||||
my $len2 = $len + ($len & 0x01);
|
||||
if ($tagInfo) {
|
||||
if ($$tagInfo{TypeOnly}) {
|
||||
$len = $len2 = 4;
|
||||
$page = ($page || 0) + 1;
|
||||
$et->VPrint(0, $$et{INDENT} . "Page $page:\n");
|
||||
}
|
||||
$raf->Read($buff, $len2) >= $len or $err=1, last;
|
||||
unless ($$tagInfo{SubDirectory} or $$tagInfo{Binary}) {
|
||||
$buff =~ s/\0+$//; # remove trailing nulls
|
||||
}
|
||||
$et->HandleTag($tagTablePtr, $tag, $buff,
|
||||
DataPt => \$buff,
|
||||
DataPos => $pos,
|
||||
Start => 0,
|
||||
Size => $len,
|
||||
);
|
||||
} elsif ($verbose > 2 and $len2 < 1024000) {
|
||||
$raf->Read($buff, $len2) == $len2 or $err = 1, last;
|
||||
$et->VerboseDump(\$buff);
|
||||
} else {
|
||||
$raf->Seek($len2, 1) or $err=1, last;
|
||||
}
|
||||
$pos += $len2;
|
||||
}
|
||||
$err and $et->Warn("Error reading $type file (corrupted?)");
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::AIFF - Read AIFF meta information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains routines required by Image::ExifTool to extract
|
||||
information from AIFF (Audio Interchange File Format) audio files.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://developer.apple.com/documentation/QuickTime/INMAC/SOUND/imsoundmgr.30.htm#pgfId=3190>
|
||||
|
||||
=item L<http://astronomy.swin.edu.au/~pbourke/dataformats/aiff/>
|
||||
|
||||
=item L<http://www.mactech.com/articles/mactech/Vol.06/06.01/SANENormalized/>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/AIFF Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,287 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: APE.pm
|
||||
#
|
||||
# Description: Read Monkey's Audio meta information
|
||||
#
|
||||
# Revisions: 11/13/2006 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://www.monkeysaudio.com/
|
||||
# 2) http://www.personal.uni-jena.de/~pfk/mpp/sv8/apetag.html
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::APE;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.05';
|
||||
|
||||
# APE metadata blocks
|
||||
%Image::ExifTool::APE::Main = (
|
||||
GROUPS => { 2 => 'Audio' },
|
||||
NOTES => q{
|
||||
Tags found in Monkey's Audio (APE) information. Only a few common tags are
|
||||
listed below, but ExifTool will extract any tag found. ExifTool supports
|
||||
APEv1 and APEv2 tags, as well as ID3 information in APE files, and will also
|
||||
read APE metadata from MP3 and MPC files.
|
||||
},
|
||||
Album => { },
|
||||
Artist => { },
|
||||
Genre => { },
|
||||
Title => { },
|
||||
Track => { },
|
||||
Year => { },
|
||||
DURATION => {
|
||||
Name => 'Duration',
|
||||
ValueConv => '$val += 4294967296 if $val < 0 and $val >= -2147483648; $val * 1e-7',
|
||||
PrintConv => 'ConvertDuration($val)',
|
||||
},
|
||||
'Tool Version' => { Name => 'ToolVersion' },
|
||||
'Tool Name' => { Name => 'ToolName' },
|
||||
);
|
||||
|
||||
# APE MAC header version 3.97 or earlier
|
||||
%Image::ExifTool::APE::OldHeader = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 1 => 'MAC', 2 => 'Audio' },
|
||||
FORMAT => 'int16u',
|
||||
NOTES => 'APE MAC audio header for version 3.97 or earlier.',
|
||||
0 => {
|
||||
Name => 'APEVersion',
|
||||
ValueConv => '$val / 1000',
|
||||
},
|
||||
1 => 'CompressionLevel',
|
||||
# 2 => 'FormatFlags',
|
||||
3 => 'Channels',
|
||||
4 => { Name => 'SampleRate', Format => 'int32u' },
|
||||
# 6 => { Name => 'HeaderBytes', Format => 'int32u' }, # WAV header bytes
|
||||
# 8 => { Name => 'TerminatingBytes', Format => 'int32u' },
|
||||
10 => { Name => 'TotalFrames', Format => 'int32u' },
|
||||
12 => { Name => 'FinalFrameBlocks', Format => 'int32u' },
|
||||
);
|
||||
|
||||
# APE MAC header version 3.98 or later
|
||||
%Image::ExifTool::APE::NewHeader = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 1 => 'MAC', 2 => 'Audio' },
|
||||
FORMAT => 'int16u',
|
||||
NOTES => 'APE MAC audio header for version 3.98 or later.',
|
||||
0 => 'CompressionLevel',
|
||||
# 1 => 'FormatFlags',
|
||||
2 => { Name => 'BlocksPerFrame', Format => 'int32u' },
|
||||
4 => { Name => 'FinalFrameBlocks', Format => 'int32u' },
|
||||
6 => { Name => 'TotalFrames', Format => 'int32u' },
|
||||
8 => 'BitsPerSample',
|
||||
9 => 'Channels',
|
||||
10 => { Name => 'SampleRate', Format => 'int32u' },
|
||||
);
|
||||
|
||||
# APE Composite tags
|
||||
%Image::ExifTool::APE::Composite = (
|
||||
GROUPS => { 2 => 'Audio' },
|
||||
Duration => {
|
||||
Require => {
|
||||
0 => 'APE:SampleRate',
|
||||
1 => 'APE:TotalFrames',
|
||||
2 => 'APE:BlocksPerFrame',
|
||||
3 => 'APE:FinalFrameBlocks',
|
||||
},
|
||||
RawConv => '($val[0] && $val[1]) ? (($val[1] - 1) * $val[2] + $val[3]) / $val[0]: undef',
|
||||
PrintConv => 'ConvertDuration($val)',
|
||||
},
|
||||
);
|
||||
|
||||
# add our composite tags
|
||||
Image::ExifTool::AddCompositeTags('Image::ExifTool::APE');
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Make tag info hash for specified tag
|
||||
# Inputs: 0) tag name, 1) tag table ref
|
||||
# - must only call if tag doesn't exist
|
||||
sub MakeTag($$)
|
||||
{
|
||||
my ($tag, $tagTablePtr) = @_;
|
||||
my $name = ucfirst(lc($tag));
|
||||
# remove invalid characters in tag name and capitalize following letters
|
||||
$name =~ s/[^\w-]+(.?)/\U$1/sg;
|
||||
$name =~ s/([a-z0-9])_([a-z])/$1\U$2/g;
|
||||
my %tagInfo = ( Name => $name );
|
||||
$tagInfo{Groups} = { 2 => 'Preview' } if $tag =~ /^Cover Art/ and $tag !~ /Desc$/;
|
||||
AddTagToTable($tagTablePtr, $tag, \%tagInfo);
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Extract information from an APE file
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
||||
# - Just looks for APE trailer if FileType is already set
|
||||
# Returns: 1 on success, 0 if this wasn't a valid APE file
|
||||
sub ProcessAPE($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
|
||||
# must first check for leading/trailing ID3 information
|
||||
unless ($$et{DoneID3}) {
|
||||
require Image::ExifTool::ID3;
|
||||
Image::ExifTool::ID3::ProcessID3($et, $dirInfo) and return 1;
|
||||
}
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $verbose = $et->Options('Verbose');
|
||||
my ($buff, $i, $header, $tagTablePtr, $dataPos, $oldIndent);
|
||||
|
||||
$$et{DoneAPE} = 1;
|
||||
|
||||
# check APE signature and process audio information
|
||||
# unless this is some other type of file
|
||||
unless ($$et{VALUE}{FileType}) {
|
||||
$raf->Read($buff, 32) == 32 or return 0;
|
||||
$buff =~ /^(MAC |APETAGEX)/ or return 0;
|
||||
$et->SetFileType();
|
||||
SetByteOrder('II');
|
||||
|
||||
if ($buff =~ /^APETAGEX/) {
|
||||
# we already read the APE header
|
||||
$header = 1;
|
||||
} else {
|
||||
# process the MAC header
|
||||
my $vers = Get16u(\$buff, 4);
|
||||
my $table;
|
||||
if ($vers <= 3970) {
|
||||
$buff = substr($buff, 4);
|
||||
$table = GetTagTable('Image::ExifTool::APE::OldHeader');
|
||||
} else {
|
||||
my $dlen = Get32u(\$buff, 8);
|
||||
my $hlen = Get32u(\$buff, 12);
|
||||
unless ($dlen & 0x80000000 or $hlen & 0x80000000) {
|
||||
if ($raf->Seek($dlen, 0) and $raf->Read($buff, $hlen) == $hlen) {
|
||||
$table = GetTagTable('Image::ExifTool::APE::NewHeader');
|
||||
}
|
||||
}
|
||||
}
|
||||
$et->ProcessDirectory( { DataPt => \$buff }, $table) if $table;
|
||||
}
|
||||
}
|
||||
# look for APE trailer unless we already found an APE header
|
||||
unless ($header) {
|
||||
# look for the APE trailer footer...
|
||||
my $footPos = -32;
|
||||
# (...but before the ID3v1 trailer if it exists)
|
||||
$footPos -= 128 if $$et{DoneID3} == 2;
|
||||
$raf->Seek($footPos, 2) or return 1;
|
||||
$raf->Read($buff, 32) == 32 or return 1;
|
||||
$buff =~ /^APETAGEX/ or return 1;
|
||||
SetByteOrder('II');
|
||||
}
|
||||
#
|
||||
# Read the APE data (we have just read the APE header or footer into $buff)
|
||||
#
|
||||
my ($version, $size, $count, $flags) = unpack('x8V4', $buff);
|
||||
$version /= 1000;
|
||||
$size -= 32; # get size of data only
|
||||
if (($size & 0x80000000) == 0 and
|
||||
($header or $raf->Seek(-$size-32, 1)) and
|
||||
$raf->Read($buff, $size) == $size)
|
||||
{
|
||||
if ($verbose) {
|
||||
$oldIndent = $$et{INDENT};
|
||||
$$et{INDENT} .= '| ';
|
||||
$et->VerboseDir("APEv$version", $count, $size);
|
||||
$et->VerboseDump(\$buff, DataPos => $raf->Tell() - $size);
|
||||
}
|
||||
$tagTablePtr = GetTagTable('Image::ExifTool::APE::Main');
|
||||
$dataPos = $raf->Tell() - $size;
|
||||
} else {
|
||||
$count = -1;
|
||||
}
|
||||
#
|
||||
# Process the APE tags
|
||||
#
|
||||
my $pos = 0;
|
||||
for ($i=0; $i<$count; ++$i) {
|
||||
# read next APE tag
|
||||
last if $pos + 8 > $size;
|
||||
my $len = Get32u(\$buff, $pos);
|
||||
my $flags = Get32u(\$buff, $pos + 4);
|
||||
pos($buff) = $pos + 8;
|
||||
last unless $buff =~ /\G(.*?)\0/sg;
|
||||
my $tag = $1;
|
||||
# avoid conflicts with our special table entries
|
||||
$tag .= '.' if $Image::ExifTool::specialTags{$tag};
|
||||
$pos = pos($buff);
|
||||
last if $pos + $len > $size;
|
||||
my $val = substr($buff, $pos, $len);
|
||||
MakeTag($tag, $tagTablePtr) unless $$tagTablePtr{$tag};
|
||||
# handle binary-value tags
|
||||
if (($flags & 0x06) == 0x02) {
|
||||
my $buf2 = $val;
|
||||
$val = \$buf2;
|
||||
# extract cover art description separately (hackitty hack)
|
||||
if ($tag =~ /^Cover Art/) {
|
||||
$buf2 =~ s/^([\x20-\x7f]*)\0//;
|
||||
if ($1) {
|
||||
my $t = "$tag Desc";
|
||||
my $v = $1;
|
||||
MakeTag($t, $tagTablePtr) unless $$tagTablePtr{$t};
|
||||
$et->HandleTag($tagTablePtr, $t, $v);
|
||||
}
|
||||
}
|
||||
}
|
||||
$et->HandleTag($tagTablePtr, $tag, $val,
|
||||
Index => $i,
|
||||
DataPt => \$buff,
|
||||
DataPos => $dataPos,
|
||||
Start => $pos,
|
||||
Size => $len,
|
||||
);
|
||||
$pos += $len;
|
||||
}
|
||||
$i == $count or $et->Warn('Bad APE trailer');
|
||||
$$et{INDENT} = $oldIndent if defined $oldIndent;
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::APE - Read Monkey's Audio meta information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to extract meta
|
||||
information from Monkey's Audio (APE) audio files.
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
Currently doesn't parse MAC header unless it is at the start of the file.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://www.monkeysaudio.com/>
|
||||
|
||||
=item L<http://www.personal.uni-jena.de/~pfk/mpp/sv8/apetag.html>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/APE Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,322 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: APP12.pm
|
||||
#
|
||||
# Description: Read APP12 meta information
|
||||
#
|
||||
# Revisions: 10/18/2005 - P. Harvey Created
|
||||
#
|
||||
# References: 1) Heinrich Giesen private communication
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::APP12;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.13';
|
||||
|
||||
sub ProcessAPP12($$$);
|
||||
sub ProcessDucky($$$);
|
||||
sub WriteDucky($$$);
|
||||
|
||||
# APP12 tags (ref PH)
|
||||
%Image::ExifTool::APP12::PictureInfo = (
|
||||
PROCESS_PROC => \&ProcessAPP12,
|
||||
GROUPS => { 0 => 'APP12', 1 => 'PictureInfo', 2 => 'Image' },
|
||||
PRIORITY => 0,
|
||||
NOTES => q{
|
||||
The JPEG APP12 "Picture Info" segment was used by some older cameras, and
|
||||
contains ASCII-based meta information. Below are some tags which have been
|
||||
observed Agfa and Polaroid images, however ExifTool will extract information
|
||||
from any tags found in this segment.
|
||||
},
|
||||
FNumber => {
|
||||
ValueConv => '$val=~s/^[A-Za-z ]*//;$val', # Agfa leads with an 'F'
|
||||
PrintConv => 'sprintf("%.1f",$val)',
|
||||
},
|
||||
Aperture => {
|
||||
PrintConv => 'sprintf("%.1f",$val)',
|
||||
},
|
||||
TimeDate => {
|
||||
Name => 'DateTimeOriginal',
|
||||
Description => 'Date/Time Original',
|
||||
Groups => { 2 => 'Time' },
|
||||
ValueConv => '$val=~/^\d+$/ ? ConvertUnixTime($val) : $val',
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
Shutter => {
|
||||
Name => 'ExposureTime',
|
||||
ValueConv => '$val * 1e-6',
|
||||
PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
|
||||
},
|
||||
shtr => {
|
||||
Name => 'ExposureTime',
|
||||
ValueConv => '$val * 1e-6',
|
||||
PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
|
||||
},
|
||||
'Serial#' => {
|
||||
Name => 'SerialNumber',
|
||||
Groups => { 2 => 'Camera' },
|
||||
},
|
||||
Flash => { PrintConv => { 0 => 'Off', 1 => 'On' } },
|
||||
Macro => { PrintConv => { 0 => 'Off', 1 => 'On' } },
|
||||
StrobeTime => { },
|
||||
Ytarget => { Name => 'YTarget' },
|
||||
ylevel => { Name => 'YLevel' },
|
||||
FocusPos => { },
|
||||
FocusMode => { },
|
||||
Quality => { },
|
||||
ExpBias => 'ExposureCompensation',
|
||||
FWare => 'FirmwareVersion',
|
||||
StrobeTime => { },
|
||||
Resolution => { },
|
||||
Protect => { },
|
||||
ConTake => { },
|
||||
ImageSize => { PrintConv => '$val=~tr/-/x/;$val' },
|
||||
ColorMode => { },
|
||||
Zoom => { },
|
||||
ZoomPos => { },
|
||||
LightS => { },
|
||||
Type => {
|
||||
Name => 'CameraType',
|
||||
Groups => { 2 => 'Camera' },
|
||||
DataMember => 'CameraType',
|
||||
RawConv => '$self->{CameraType} = $val',
|
||||
},
|
||||
Version => { Groups => { 2 => 'Camera' } },
|
||||
ID => { Groups => { 2 => 'Camera' } },
|
||||
);
|
||||
|
||||
# APP12 segment written in Photoshop "Save For Web" images
|
||||
# (from tests with Photoshop 7 files - PH/1)
|
||||
%Image::ExifTool::APP12::Ducky = (
|
||||
PROCESS_PROC => \&ProcessDucky,
|
||||
WRITE_PROC => \&WriteDucky,
|
||||
GROUPS => { 0 => 'Ducky', 1 => 'Ducky', 2 => 'Image' },
|
||||
WRITABLE => 'string',
|
||||
NOTES => q{
|
||||
Photoshop uses the JPEG APP12 "Ducky" segment to store some information in
|
||||
"Save for Web" images.
|
||||
},
|
||||
1 => { #PH
|
||||
Name => 'Quality',
|
||||
Priority => 0,
|
||||
Avoid => 1,
|
||||
Writable => 'int32u',
|
||||
ValueConv => 'unpack("N",$val)', # 4-byte integer
|
||||
ValueConvInv => 'pack("N",$val)',
|
||||
PrintConv => '"$val%"',
|
||||
PrintConvInv => '$val=~/(\d+)/ ? $1 : undef',
|
||||
},
|
||||
2 => { #1
|
||||
Name => 'Comment',
|
||||
Priority => 0,
|
||||
Avoid => 1,
|
||||
# (ignore 4-byte character count at start of value)
|
||||
ValueConv => '$self->Decode(substr($val,4),"UCS2","MM")',
|
||||
ValueConvInv => 'pack("N",length $val) . $self->Encode($val,"UCS2","MM")',
|
||||
},
|
||||
3 => { #PH
|
||||
Name => 'Copyright',
|
||||
Priority => 0,
|
||||
Avoid => 1,
|
||||
Groups => { 2 => 'Author' },
|
||||
# (ignore 4-byte character count at start of value)
|
||||
ValueConv => '$self->Decode(substr($val,4),"UCS2","MM")',
|
||||
ValueConvInv => 'pack("N",length $val) . $self->Encode($val,"UCS2","MM")',
|
||||
},
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Write APP12 Ducky segment
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: New directory data or undefined on error
|
||||
sub WriteDucky($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
$et or return 1; # allow dummy access to autoload this package
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $pos = $$dirInfo{DirStart};
|
||||
my $newTags = $et->GetNewTagInfoHash($tagTablePtr);
|
||||
my @addTags = sort { $a <=> $b } keys(%$newTags);
|
||||
my ($dirEnd, %doneTags);
|
||||
if ($dataPt) {
|
||||
$dirEnd = $pos + $$dirInfo{DirLen};
|
||||
} else {
|
||||
my $tmp = '';
|
||||
$dataPt = \$tmp;
|
||||
$pos = $dirEnd = 0;
|
||||
}
|
||||
my $newData = '';
|
||||
SetByteOrder('MM');
|
||||
# process all data blocks in Ducky segment
|
||||
for (;;) {
|
||||
my ($tag, $len, $val);
|
||||
if ($pos + 4 <= $dirEnd) {
|
||||
$tag = Get16u($dataPt, $pos);
|
||||
$len = Get16u($dataPt, $pos + 2);
|
||||
$pos += 4;
|
||||
if ($pos + $len > $dirEnd) {
|
||||
$et->Warn('Invalid Ducky block length');
|
||||
return undef;
|
||||
}
|
||||
$val = substr($$dataPt, $pos, $len);
|
||||
$pos += $len;
|
||||
} else {
|
||||
last unless @addTags;
|
||||
$tag = pop @addTags;
|
||||
next if $doneTags{$tag};
|
||||
}
|
||||
$doneTags{$tag} = 1;
|
||||
my $tagInfo = $$newTags{$tag};
|
||||
if ($tagInfo) {
|
||||
my $nvHash = $et->GetNewValueHash($tagInfo);
|
||||
my $isNew;
|
||||
if (defined $val) {
|
||||
if ($et->IsOverwriting($nvHash, $val)) {
|
||||
$et->VerboseValue("- Ducky:$$tagInfo{Name}", $val);
|
||||
$isNew = 1;
|
||||
}
|
||||
} else {
|
||||
next unless $$nvHash{IsCreating};
|
||||
$isNew = 1;
|
||||
}
|
||||
if ($isNew) {
|
||||
$val = $et->GetNewValue($nvHash);
|
||||
++$$et{CHANGED};
|
||||
next unless defined $val; # next if tag is being deleted
|
||||
$et->VerboseValue("+ Ducky:$$tagInfo{Name}", $val);
|
||||
}
|
||||
}
|
||||
$newData .= pack('nn', $tag, length $val) . $val;
|
||||
}
|
||||
$newData .= "\0\0" if length $newData;
|
||||
return $newData;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process APP12 Ducky segment (ref PH)
|
||||
# Inputs: 0) ExifTool object reference, 1) Directory information ref, 2) tag table ref
|
||||
# Returns: 1 on success, 0 if this wasn't a recognized Ducky segment
|
||||
# Notes: This segment has the following format:
|
||||
# 1) 5 bytes: "Ducky"
|
||||
# 2) multiple data blocks (all integers are big endian):
|
||||
# a) 2 bytes: block type (0=end, 1=Quality, 2=Comment, 3=Copyright)
|
||||
# b) 2 bytes: block length (N)
|
||||
# c) N bytes: block data
|
||||
sub ProcessDucky($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $pos = $$dirInfo{DirStart};
|
||||
my $dirEnd = $pos + $$dirInfo{DirLen};
|
||||
SetByteOrder('MM');
|
||||
# process all data blocks in Ducky segment
|
||||
for (;;) {
|
||||
last if $pos + 4 > $dirEnd;
|
||||
my $tag = Get16u($dataPt, $pos);
|
||||
my $len = Get16u($dataPt, $pos + 2);
|
||||
$pos += 4;
|
||||
if ($pos + $len > $dirEnd) {
|
||||
$et->Warn('Invalid Ducky block length');
|
||||
last;
|
||||
}
|
||||
my $val = substr($$dataPt, $pos, $len);
|
||||
$et->HandleTag($tagTablePtr, $tag, $val,
|
||||
DataPt => $dataPt,
|
||||
DataPos => $$dirInfo{DataPos},
|
||||
Start => $pos,
|
||||
Size => $len,
|
||||
);
|
||||
$pos += $len;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process APP12 Picture Info segment (ref PH)
|
||||
# Inputs: 0) ExifTool object reference, 1) Directory information ref, 2) tag table ref
|
||||
# Returns: 1 on success, 0 if this wasn't a recognized APP12
|
||||
sub ProcessAPP12($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dirStart = $$dirInfo{DirStart} || 0;
|
||||
my $dirLen = $$dirInfo{DirLen} || (length($$dataPt) - $dirStart);
|
||||
if ($dirLen != $dirStart + length($$dataPt)) {
|
||||
my $buff = substr($$dataPt, $dirStart, $dirLen);
|
||||
$dataPt = \$buff;
|
||||
} else {
|
||||
pos($$dataPt) = $$dirInfo{DirStart};
|
||||
}
|
||||
my $verbose = $et->Options('Verbose');
|
||||
my $success = 0;
|
||||
my $section = '';
|
||||
pos($$dataPt) = 0;
|
||||
|
||||
# this regular expression is a bit complex, but basically we are looking for
|
||||
# section headers (eg. "[Camera Info]") and tag/value pairs (eg. "tag=value",
|
||||
# where "value" may contain white space), separated by spaces or CR/LF.
|
||||
# (APP12 uses CR/LF, but Olympus TextualInfo is similar and uses spaces)
|
||||
while ($$dataPt =~ /(\[.*?\]|[\w#-]+=[\x20-\x7e]+?(?=\s*([\n\r\0]|[\w#-]+=|\[|$)))/g) {
|
||||
my $token = $1;
|
||||
# was this a section name?
|
||||
if ($token =~ /^\[(.*)\]/) {
|
||||
$et->VerboseDir($1) if $verbose;
|
||||
$section = ($token =~ /\[(\S+) ?Info\]/i) ? $1 : '';
|
||||
$success = 1;
|
||||
next;
|
||||
}
|
||||
$et->VerboseDir($$dirInfo{DirName}) if $verbose and not $success;
|
||||
$success = 1;
|
||||
my ($tag, $val) = ($token =~ /(\S+)=(.+)/);
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
|
||||
$verbose and $et->VerboseInfo($tag, $tagInfo, Value => $val);
|
||||
unless ($tagInfo) {
|
||||
# add new tag to table
|
||||
$tagInfo = { Name => ucfirst $tag };
|
||||
# put in Camera group if information in "Camera" section
|
||||
$$tagInfo{Groups} = { 2 => 'Camera' } if $section =~ /camera/i;
|
||||
AddTagToTable($tagTablePtr, $tag, $tagInfo);
|
||||
}
|
||||
$et->FoundTag($tagInfo, $val);
|
||||
}
|
||||
return $success;
|
||||
}
|
||||
|
||||
|
||||
1; #end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::APP12 - Read APP12 meta information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is loaded automatically by Image::ExifTool when required.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to interpret
|
||||
APP12 meta information.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 ACKNOWLEDGEMENTS
|
||||
|
||||
Thanks to Heinrich Giesen for his help decoding APP12 "Ducky" information.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/APP12 Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,898 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: ASF.pm
|
||||
#
|
||||
# Description: Read ASF/WMA/WMV meta information
|
||||
#
|
||||
# Revisions: 12/23/2005 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://www.microsoft.com/windows/windowsmedia/format/asfspec.aspx
|
||||
# 2) http://www.adobe.com/devnet/xmp/pdfs/XMPSpecificationPart3.pdf (Oct 2008)
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::ASF;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
use Image::ExifTool::Exif;
|
||||
use Image::ExifTool::RIFF;
|
||||
|
||||
$VERSION = '1.25';
|
||||
|
||||
sub ProcessASF($$;$);
|
||||
sub ProcessContentDescription($$$);
|
||||
sub ProcessExtendedContentDescription($$$);
|
||||
sub ProcessMetadata($$$);
|
||||
sub ProcessPicture($$$);
|
||||
sub ProcessCodecList($$$);
|
||||
|
||||
# GUID definitions
|
||||
my %errorCorrection = (
|
||||
'20FB5700-5B55-11CF-A8FD-00805F5C442B' => 'No Error Correction',
|
||||
'BFC3CD50-618F-11CF-8BB2-00AA00B4E220' => 'Audio Spread',
|
||||
);
|
||||
|
||||
my %streamType = (
|
||||
'F8699E40-5B4D-11CF-A8FD-00805F5C442B' => 'Audio',
|
||||
'BC19EFC0-5B4D-11CF-A8FD-00805F5C442B' => 'Video',
|
||||
'59DACFC0-59E6-11D0-A3AC-00A0C90348F6' => 'Command',
|
||||
'B61BE100-5B4E-11CF-A8FD-00805F5C442B' => 'JFIF',
|
||||
'35907DE0-E415-11CF-A917-00805F5C442B' => 'Degradable JPEG',
|
||||
'91BD222C-F21C-497A-8B6D-5AA86BFC0185' => 'File Transfer',
|
||||
'3AFB65E2-47EF-40F2-AC2C-70A90D71D343' => 'Binary',
|
||||
);
|
||||
|
||||
my %mutex = (
|
||||
'D6E22A00-35DA-11D1-9034-00A0C90349BE' => 'MutexLanguage',
|
||||
'D6E22A01-35DA-11D1-9034-00A0C90349BE' => 'MutexBitrate',
|
||||
'D6E22A02-35DA-11D1-9034-00A0C90349BE' => 'MutexUnknown',
|
||||
);
|
||||
|
||||
my %bandwidthSharing = (
|
||||
'AF6060AA-5197-11D2-B6AF-00C04FD908E9' => 'SharingExclusive',
|
||||
'AF6060AB-5197-11D2-B6AF-00C04FD908E9' => 'SharingPartial',
|
||||
);
|
||||
|
||||
my %typeSpecific = (
|
||||
'776257D4-C627-41CB-8F81-7AC7FF1C40CC' => 'WebStreamMediaSubtype',
|
||||
'DA1E6B13-8359-4050-B398-388E965BF00C' => 'WebStreamFormat',
|
||||
);
|
||||
|
||||
my %advancedContentEncryption = (
|
||||
'7A079BB6-DAA4-4e12-A5CA-91D38DC11A8D' => 'DRMNetworkDevices',
|
||||
);
|
||||
|
||||
# ASF top level objects
|
||||
%Image::ExifTool::ASF::Main = (
|
||||
PROCESS_PROC => \&ProcessASF,
|
||||
NOTES => q{
|
||||
The ASF format is used by Windows WMA and WMV files, and DIVX videos. Tag
|
||||
ID's aren't listed because they are huge 128-bit GUID's that would ruin the
|
||||
formatting of this table.
|
||||
},
|
||||
'75B22630-668E-11CF-A6D9-00AA0062CE6C' => {
|
||||
Name => 'Header',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::ASF::Header', Size => 6 },
|
||||
},
|
||||
'75B22636-668E-11CF-A6D9-00AA0062CE6C' => 'Data',
|
||||
'33000890-E5B1-11CF-89F4-00A0C90349CB' => 'SimpleIndex',
|
||||
'D6E229D3-35DA-11D1-9034-00A0C90349BE' => 'Index',
|
||||
'FEB103F8-12AD-4C64-840F-2A1D2F7AD48C' => 'MediaIndex',
|
||||
'3CB73FD0-0C4A-4803-953D-EDF7B6228F0C' => 'TimecodeIndex',
|
||||
'BE7ACFCB-97A9-42E8-9C71-999491E3AFAC' => { #2
|
||||
Name => 'XMP',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
|
||||
},
|
||||
);
|
||||
|
||||
# ASF header objects
|
||||
%Image::ExifTool::ASF::Header = (
|
||||
PROCESS_PROC => \&ProcessASF,
|
||||
'8CABDCA1-A947-11CF-8EE4-00C00C205365' => {
|
||||
Name => 'FileProperties',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::ASF::FileProperties' },
|
||||
},
|
||||
'B7DC0791-A9B7-11CF-8EE6-00C00C205365' => {
|
||||
Name => 'StreamProperties',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::ASF::StreamProperties' },
|
||||
},
|
||||
'5FBF03B5-A92E-11CF-8EE3-00C00C205365' => {
|
||||
Name => 'HeaderExtension',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::ASF::HeaderExtension', Size => 22 },
|
||||
},
|
||||
'86D15240-311D-11D0-A3A4-00A0C90348F6' => {
|
||||
Name => 'CodecList',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::ASF::CodecList' },
|
||||
},
|
||||
'1EFB1A30-0B62-11D0-A39B-00A0C90348F6' => 'ScriptCommand',
|
||||
'F487CD01-A951-11CF-8EE6-00C00C205365' => 'Marker',
|
||||
'D6E229DC-35DA-11D1-9034-00A0C90349BE' => 'BitrateMutualExclusion',
|
||||
'75B22635-668E-11CF-A6D9-00AA0062CE6C' => 'ErrorCorrection',
|
||||
'75B22633-668E-11CF-A6D9-00AA0062CE6C' => {
|
||||
Name => 'ContentDescription',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::ASF::ContentDescr' },
|
||||
},
|
||||
'2211B3FA-BD23-11D2-B4B7-00A0C955FC6E' => {
|
||||
Name => 'ContentBranding',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::ASF::ContentBranding' },
|
||||
},
|
||||
'D2D0A440-E307-11D2-97F0-00A0C95EA850' => {
|
||||
Name => 'ExtendedContentDescr',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::ASF::ExtendedDescr' },
|
||||
},
|
||||
'7BF875CE-468D-11D1-8D82-006097C9A2B2' => 'StreamBitrateProps',
|
||||
'2211B3FB-BD23-11D2-B4B7-00A0C955FC6E' => 'ContentEncryption',
|
||||
'298AE614-2622-4C17-B935-DAE07EE9289C' => 'ExtendedContentEncryption',
|
||||
'2211B3FC-BD23-11D2-B4B7-00A0C955FC6E' => 'DigitalSignature',
|
||||
'1806D474-CADF-4509-A4BA-9AABCB96AAE8' => 'Padding',
|
||||
);
|
||||
|
||||
%Image::ExifTool::ASF::ContentDescr = (
|
||||
PROCESS_PROC => \&ProcessContentDescription,
|
||||
GROUPS => { 2 => 'Video' },
|
||||
0 => 'Title',
|
||||
1 => { Name => 'Author', Groups => { 2 => 'Author' } },
|
||||
2 => { Name => 'Copyright', Groups => { 2 => 'Author' } },
|
||||
3 => 'Description',
|
||||
4 => 'Rating',
|
||||
);
|
||||
|
||||
%Image::ExifTool::ASF::ContentBranding = (
|
||||
PROCESS_PROC => \&ProcessContentBranding,
|
||||
GROUPS => { 2 => 'Author' },
|
||||
0 => {
|
||||
Name => 'BannerImageType',
|
||||
PrintConv => {
|
||||
0 => 'None',
|
||||
1 => 'Bitmap',
|
||||
2 => 'JPEG',
|
||||
3 => 'GIF',
|
||||
},
|
||||
},
|
||||
1 => { Name => 'BannerImage', Groups => { 2 => 'Preview' }, Binary => 1 },
|
||||
2 => 'BannerImageURL',
|
||||
3 => 'CopyrightURL',
|
||||
);
|
||||
|
||||
# Note: Many of these tags are similar to those in Image::ExifTool::Microsoft::Xtra
|
||||
# and Image::ExifTool::WTV::Metadata
|
||||
# (tags in this table may have a leading "WM/" removed)
|
||||
%Image::ExifTool::ASF::ExtendedDescr = (
|
||||
PROCESS_PROC => \&ProcessExtendedContentDescription,
|
||||
GROUPS => { 2 => 'Video' },
|
||||
ASFLeakyBucketPairs => { Binary => 1 },
|
||||
AspectRatioX => {},
|
||||
AspectRatioY => {},
|
||||
Author => { Groups => { 2 => 'Author' } },
|
||||
AverageLevel => {},
|
||||
BannerImageData => {},
|
||||
BannerImageType => {},
|
||||
BannerImageURL => {},
|
||||
Bitrate => { PrintConv => 'ConvertBitrate($val)' },
|
||||
Broadcast => {},
|
||||
BufferAverage => {},
|
||||
Can_Skip_Backward => {},
|
||||
Can_Skip_Forward => {},
|
||||
Copyright => { Groups => { 2 => 'Author' } },
|
||||
CopyrightURL => { Groups => { 2 => 'Author' } },
|
||||
CurrentBitrate => { PrintConv => 'ConvertBitrate($val)' },
|
||||
Description => {},
|
||||
DRM_ContentID => {},
|
||||
DRM_DRMHeader_ContentDistributor => {},
|
||||
DRM_DRMHeader_ContentID => {},
|
||||
DRM_DRMHeader_IndividualizedVersion => {},
|
||||
DRM_DRMHeader_KeyID => {},
|
||||
DRM_DRMHeader_LicenseAcqURL => {},
|
||||
DRM_DRMHeader_SubscriptionContentID => {},
|
||||
DRM_DRMHeader => {},
|
||||
DRM_IndividualizedVersion => {},
|
||||
DRM_KeyID => {},
|
||||
DRM_LASignatureCert => {},
|
||||
DRM_LASignatureLicSrvCert => {},
|
||||
DRM_LASignaturePrivKey => {},
|
||||
DRM_LASignatureRootCert => {},
|
||||
DRM_LicenseAcqURL => {},
|
||||
DRM_V1LicenseAcqURL => {},
|
||||
Duration => { PrintConv => 'ConvertDuration($val)' },
|
||||
FileSize => {},
|
||||
HasArbitraryDataStream => {},
|
||||
HasAttachedImages => {},
|
||||
HasAudio => {},
|
||||
HasFileTransferStream => {},
|
||||
HasImage => {},
|
||||
HasScript => {},
|
||||
HasVideo => {},
|
||||
Is_Protected => {},
|
||||
Is_Trusted => {},
|
||||
IsVBR => {},
|
||||
NSC_Address => {},
|
||||
NSC_Description => {},
|
||||
NSC_Email => {},
|
||||
NSC_Name => {},
|
||||
NSC_Phone => {},
|
||||
NumberOfFrames => {},
|
||||
OptimalBitrate => { PrintConv => 'ConvertBitrate($val)' },
|
||||
PeakValue => {},
|
||||
Rating => {},
|
||||
Seekable => {},
|
||||
Signature_Name => {},
|
||||
Stridable => {},
|
||||
Title => {},
|
||||
VBRPeak => {},
|
||||
# "WM/" tags...
|
||||
AlbumArtist => {},
|
||||
AlbumCoverURL => {},
|
||||
AlbumTitle => {},
|
||||
ASFPacketCount => {},
|
||||
ASFSecurityObjectsSize => {},
|
||||
AudioFileURL => {},
|
||||
AudioSourceURL => {},
|
||||
AuthorURL => { Groups => { 2 => 'Author' } },
|
||||
BeatsPerMinute => {},
|
||||
Category => {},
|
||||
Codec => {},
|
||||
Composer => {},
|
||||
Conductor => {},
|
||||
ContainerFormat => {},
|
||||
ContentDistributor => {},
|
||||
ContentGroupDescription => {},
|
||||
Director => {},
|
||||
DRM => {},
|
||||
DVDID => {},
|
||||
EncodedBy => {},
|
||||
EncodingSettings => {},
|
||||
EncodingTime => { Groups => { 2 => 'Time' }, PrintConv => '$self->ConvertDateTime($val)' },
|
||||
Genre => {},
|
||||
GenreID => {},
|
||||
InitialKey => {},
|
||||
ISRC => {},
|
||||
Language => {},
|
||||
Lyrics => {},
|
||||
Lyrics_Synchronised => {},
|
||||
MCDI => {},
|
||||
MediaClassPrimaryID => { ValueConv => 'Image::ExifTool::ASF::GetGUID($val)' },
|
||||
MediaClassSecondaryID => { ValueConv => 'Image::ExifTool::ASF::GetGUID($val)' },
|
||||
MediaCredits => {},
|
||||
MediaIsDelay => {},
|
||||
MediaIsFinale => {},
|
||||
MediaIsLive => {},
|
||||
MediaIsPremiere => {},
|
||||
MediaIsRepeat => {},
|
||||
MediaIsSAP => {},
|
||||
MediaIsStereo => {},
|
||||
MediaIsSubtitled => {},
|
||||
MediaIsTape => {},
|
||||
MediaNetworkAffiliation => {},
|
||||
MediaOriginalBroadcastDateTime => {
|
||||
Groups => { 2 => 'Time' },
|
||||
ValueConv => '$val=~tr/-T/: /; $val',
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
MediaOriginalChannel => {},
|
||||
MediaStationCallSign => {},
|
||||
MediaStationName => {},
|
||||
ModifiedBy => {},
|
||||
Mood => {},
|
||||
OriginalAlbumTitle => {},
|
||||
OriginalArtist => {},
|
||||
OriginalFilename => 'OriginalFileName',
|
||||
OriginalLyricist => {},
|
||||
OriginalReleaseTime => {
|
||||
Groups => { 2 => 'Time' },
|
||||
ValueConv => '$val=~tr/-T/: /; $val',
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
OriginalReleaseYear => { Groups => { 2 => 'Time' } },
|
||||
ParentalRating => {},
|
||||
ParentalRatingReason => {},
|
||||
PartOfSet => {},
|
||||
PeakBitrate => { PrintConv => 'ConvertBitrate($val)' },
|
||||
Period => {},
|
||||
Picture => {
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::ASF::Picture',
|
||||
},
|
||||
},
|
||||
PlaylistDelay => {},
|
||||
Producer => {},
|
||||
PromotionURL => {},
|
||||
ProtectionType => {},
|
||||
Provider => {},
|
||||
ProviderCopyright => {},
|
||||
ProviderRating => {},
|
||||
ProviderStyle => {},
|
||||
Publisher => {},
|
||||
RadioStationName => {},
|
||||
RadioStationOwner => {},
|
||||
SharedUserRating => {},
|
||||
StreamTypeInfo => {},
|
||||
SubscriptionContentID => {},
|
||||
SubTitle => 'Subtitle',
|
||||
SubTitleDescription => 'SubtitleDescription',
|
||||
Text => {},
|
||||
ToolName => {},
|
||||
ToolVersion => {},
|
||||
Track => {},
|
||||
TrackNumber => {},
|
||||
UniqueFileIdentifier => {},
|
||||
UserWebURL => {},
|
||||
VideoClosedCaptioning => {},
|
||||
VideoFrameRate => {},
|
||||
VideoHeight => {},
|
||||
VideoWidth => {},
|
||||
WMADRCAverageReference => {},
|
||||
WMADRCAverageTarget => {},
|
||||
WMADRCPeakReference => {},
|
||||
WMADRCPeakTarget => {},
|
||||
WMCollectionGroupID => {},
|
||||
WMCollectionID => {},
|
||||
WMContentID => {},
|
||||
Writer => { Groups => { 2 => 'Author' } },
|
||||
Year => { Groups => { 2 => 'Time' } },
|
||||
);
|
||||
|
||||
%Image::ExifTool::ASF::Picture = (
|
||||
PROCESS_PROC => \&ProcessPicture,
|
||||
GROUPS => { 2 => 'Image' },
|
||||
0 => {
|
||||
Name => 'PictureType',
|
||||
PrintConv => { # (Note: Duplicated in ID3, ASF and FLAC modules!)
|
||||
0 => 'Other',
|
||||
1 => '32x32 PNG Icon',
|
||||
2 => 'Other Icon',
|
||||
3 => 'Front Cover',
|
||||
4 => 'Back Cover',
|
||||
5 => 'Leaflet',
|
||||
6 => 'Media',
|
||||
7 => 'Lead Artist',
|
||||
8 => 'Artist',
|
||||
9 => 'Conductor',
|
||||
10 => 'Band',
|
||||
11 => 'Composer',
|
||||
12 => 'Lyricist',
|
||||
13 => 'Recording Studio or Location',
|
||||
14 => 'Recording Session',
|
||||
15 => 'Performance',
|
||||
16 => 'Capture from Movie or Video',
|
||||
17 => 'Bright(ly) Colored Fish',
|
||||
18 => 'Illustration',
|
||||
19 => 'Band Logo',
|
||||
20 => 'Publisher Logo',
|
||||
},
|
||||
},
|
||||
1 => 'PictureMIMEType',
|
||||
2 => 'PictureDescription',
|
||||
3 => {
|
||||
Name => 'Picture',
|
||||
Groups => { 2 => 'Preview' },
|
||||
Binary => 1,
|
||||
},
|
||||
);
|
||||
|
||||
%Image::ExifTool::ASF::FileProperties = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 2 => 'Video' },
|
||||
0 => {
|
||||
Name => 'FileID',
|
||||
Format => 'binary[16]',
|
||||
ValueConv => 'Image::ExifTool::ASF::GetGUID($val)',
|
||||
},
|
||||
16 => { Name => 'FileLength', Format => 'int64u' },
|
||||
24 => {
|
||||
Name => 'CreationDate',
|
||||
Format => 'int64u',
|
||||
Groups => { 2 => 'Time' },
|
||||
# time is in 100 ns intervals since 0:00 UTC Jan 1, 1601
|
||||
ValueConv => q{ # (89 leap years between 1601 and 1970)
|
||||
my $t = $val / 1e7 - (((1970-1601)*365+89)*24*3600);
|
||||
return Image::ExifTool::ConvertUnixTime($t) . 'Z';
|
||||
},
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
32 => { Name => 'DataPackets', Format => 'int64u' },
|
||||
40 => {
|
||||
Name => 'Duration',
|
||||
Format => 'int64u',
|
||||
Notes => 'called PlayDuration by the ASF spec',
|
||||
Priority => 0,
|
||||
ValueConv => '$val / 1e7',
|
||||
PrintConv => 'ConvertDuration($val)',
|
||||
},
|
||||
48 => {
|
||||
Name => 'SendDuration',
|
||||
Format => 'int64u',
|
||||
ValueConv => '$val / 1e7',
|
||||
PrintConv => 'ConvertDuration($val)',
|
||||
},
|
||||
56 => { Name => 'Preroll', Format => 'int64u' },
|
||||
64 => { Name => 'Flags', Format => 'int32u' },
|
||||
68 => { Name => 'MinPacketSize',Format => 'int32u' },
|
||||
72 => { Name => 'MaxPacketSize',Format => 'int32u' },
|
||||
76 => { Name => 'MaxBitrate', Format => 'int32u', PrintConv => 'ConvertBitrate($val)' },
|
||||
);
|
||||
|
||||
%Image::ExifTool::ASF::StreamProperties = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 2 => 'Video' },
|
||||
NOTES => 'Tags with index 54 and greater are conditional based on the StreamType.',
|
||||
0 => {
|
||||
Name => 'StreamType',
|
||||
Format => 'binary[16]',
|
||||
RawConv => sub { # set ASF_STREAM_TYPE for use in conditional tags
|
||||
my ($val, $et) = @_;
|
||||
$$et{ASF_STREAM_TYPE} = $streamType{GetGUID($val)} || '';
|
||||
return $val;
|
||||
},
|
||||
ValueConv => 'Image::ExifTool::ASF::GetGUID($val)',
|
||||
PrintConv => \%streamType,
|
||||
},
|
||||
16 => {
|
||||
Name => 'ErrorCorrectionType',
|
||||
Format => 'binary[16]',
|
||||
ValueConv => 'Image::ExifTool::ASF::GetGUID($val)',
|
||||
PrintConv => \%errorCorrection,
|
||||
},
|
||||
32 => {
|
||||
Name => 'TimeOffset',
|
||||
Format => 'int64u',
|
||||
ValueConv => '$val / 1e7',
|
||||
PrintConv => '"$val s"',
|
||||
},
|
||||
48 => {
|
||||
Name => 'StreamNumber',
|
||||
Format => 'int16u',
|
||||
PrintConv => '($val & 0x7f) . ($val & 0x8000 ? " (encrypted)" : "")',
|
||||
},
|
||||
54 => [
|
||||
{
|
||||
Condition => '$self->{ASF_STREAM_TYPE} eq "Audio"',
|
||||
Name => 'AudioCodecID',
|
||||
Format => 'int16u',
|
||||
PrintHex => 1,
|
||||
SeparateTable => 'RIFF AudioEncoding',
|
||||
PrintConv => \%Image::ExifTool::RIFF::audioEncoding,
|
||||
},
|
||||
{
|
||||
Condition => '$self->{ASF_STREAM_TYPE} =~ /^(Video|JFIF|Degradable JPEG)$/',
|
||||
Name => 'ImageWidth',
|
||||
Format => 'int32u',
|
||||
},
|
||||
],
|
||||
56 => {
|
||||
Condition => '$self->{ASF_STREAM_TYPE} eq "Audio"',
|
||||
Name => 'AudioChannels',
|
||||
Format => 'int16u',
|
||||
},
|
||||
58 => [
|
||||
{
|
||||
Condition => '$self->{ASF_STREAM_TYPE} eq "Audio"',
|
||||
Name => 'AudioSampleRate',
|
||||
Format => 'int32u',
|
||||
},
|
||||
{
|
||||
Condition => '$self->{ASF_STREAM_TYPE} =~ /^(Video|JFIF|Degradable JPEG)$/',
|
||||
Name => 'ImageHeight',
|
||||
Format => 'int32u',
|
||||
},
|
||||
],
|
||||
);
|
||||
|
||||
%Image::ExifTool::ASF::HeaderExtension = (
|
||||
PROCESS_PROC => \&ProcessASF,
|
||||
'14E6A5CB-C672-4332-8399-A96952065B5A' => 'ExtendedStreamProps',
|
||||
'A08649CF-4775-4670-8A16-6E35357566CD' => 'AdvancedMutualExcl',
|
||||
'D1465A40-5A79-4338-B71B-E36B8FD6C249' => 'GroupMutualExclusion',
|
||||
'D4FED15B-88D3-454F-81F0-ED5C45999E24' => 'StreamPrioritization',
|
||||
'A69609E6-517B-11D2-B6AF-00C04FD908E9' => 'BandwidthSharing',
|
||||
'7C4346A9-EFE0-4BFC-B229-393EDE415C85' => 'LanguageList',
|
||||
'C5F8CBEA-5BAF-4877-8467-AA8C44FA4CCA' => {
|
||||
Name => 'Metadata',
|
||||
SubDirectory => {
|
||||
# have seen some tags same as ExtendedDescr, so use this table - PH
|
||||
TagTable => 'Image::ExifTool::ASF::ExtendedDescr',
|
||||
ProcessProc => \&ProcessMetadata,
|
||||
},
|
||||
},
|
||||
'44231C94-9498-49D1-A141-1D134E457054' => {
|
||||
Name => 'MetadataLibrary',
|
||||
SubDirectory => {
|
||||
# have seen some tags same as ExtendedDescr, so use this table - PH
|
||||
TagTable => 'Image::ExifTool::ASF::ExtendedDescr',
|
||||
ProcessProc => \&ProcessMetadata,
|
||||
},
|
||||
},
|
||||
'D6E229DF-35DA-11D1-9034-00A0C90349BE' => 'IndexParameters',
|
||||
'6B203BAD-3F11-48E4-ACA8-D7613DE2CFA7' => 'TimecodeIndexParms',
|
||||
'75B22630-668E-11CF-A6D9-00AA0062CE6C' => 'Compatibility',
|
||||
'43058533-6981-49E6-9B74-AD12CB86D58C' => 'AdvancedContentEncryption',
|
||||
'ABD3D211-A9BA-11cf-8EE6-00C00C205365' => 'Reserved1',
|
||||
);
|
||||
|
||||
%Image::ExifTool::ASF::CodecList = (
|
||||
PROCESS_PROC => \&ProcessCodecList,
|
||||
VideoCodecName => {},
|
||||
VideoCodecDescription => {},
|
||||
AudioCodecName => {},
|
||||
AudioCodecDescription => {},
|
||||
OtherCodecName => {},
|
||||
OtherCodecDescription => {},
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Generate GUID from 16 bytes of binary data
|
||||
# Inputs: 0) data
|
||||
# Returns: GUID
|
||||
sub GetGUID($)
|
||||
{
|
||||
# must do some byte swapping
|
||||
my $val = shift;
|
||||
return $val unless length($val) == 16;
|
||||
my $buff = unpack('H*',pack('NnnNN',unpack('VvvNN',$val)));
|
||||
$buff =~ s/(.{8})(.{4})(.{4})(.{4})/$1-$2-$3-$4-/;
|
||||
return uc($buff);
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process ASF content description
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
|
||||
# Returns: 1 on success
|
||||
sub ProcessContentDescription($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dirLen = $$dirInfo{DirLen};
|
||||
return 0 if $dirLen < 10;
|
||||
my @len = unpack('v5', $$dataPt);
|
||||
my $pos = 10;
|
||||
my $tag;
|
||||
foreach $tag (0..4) {
|
||||
my $len = shift @len;
|
||||
next unless $len;
|
||||
return 0 if $pos + $len > $dirLen;
|
||||
my $val = $et->Decode(substr($$dataPt,$pos,$len),'UCS2','II');
|
||||
$et->HandleTag($tagTablePtr, $tag, $val);
|
||||
$pos += $len;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process ASF content branding
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
|
||||
# Returns: 1 on success
|
||||
sub ProcessContentBranding($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dirLen = $$dirInfo{DirLen};
|
||||
return 0 if $dirLen < 40;
|
||||
# decode banner image type
|
||||
$et->HandleTag($tagTablePtr, 0, unpack('V', $$dataPt));
|
||||
# decode banner image, banner URL and copyright URL
|
||||
my $pos = 4;
|
||||
my $tag;
|
||||
foreach $tag (1..3) {
|
||||
return 0 if $pos + 4 > $dirLen;
|
||||
my $size = unpack("x${pos}V", $$dataPt);
|
||||
$pos += 4;
|
||||
next unless $size;
|
||||
return 0 if $pos + $size > $dirLen;
|
||||
my $val = substr($$dataPt, $pos, $size);
|
||||
$et->HandleTag($tagTablePtr, $tag, $val);
|
||||
$pos += $size;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read ASF value
|
||||
# Inputs: 0) ExifTool object ref, 1) data reference, 2) value offset,
|
||||
# 3) format number, 4) size
|
||||
# Returns: converted value
|
||||
sub ReadASF($$$$$)
|
||||
{
|
||||
my ($et, $dataPt, $pos, $format, $size) = @_;
|
||||
my @vals;
|
||||
if ($format == 0) { # unicode string
|
||||
$vals[0] = $et->Decode(substr($$dataPt,$pos,$size),'UCS2','II');
|
||||
} elsif ($format == 2) { # 4-byte boolean
|
||||
@vals = ReadValue($dataPt, $pos, 'int32u', undef, $size);
|
||||
foreach (@vals) {
|
||||
$_ = $_ ? 'True' : 'False';
|
||||
}
|
||||
} elsif ($format == 3) { # int32u
|
||||
@vals = ReadValue($dataPt, $pos, 'int32u', undef, $size);
|
||||
} elsif ($format == 4) { # int64u
|
||||
@vals = ReadValue($dataPt, $pos, 'int64u', undef, $size);
|
||||
} elsif ($format == 5) { # int16u
|
||||
@vals = ReadValue($dataPt, $pos, 'int16u', undef, $size);
|
||||
} else { # any other format (including 1, byte array): return raw data
|
||||
$vals[0] = substr($$dataPt,$pos,$size);
|
||||
}
|
||||
return join ' ', @vals;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process extended content description
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
|
||||
# Returns: 1 on success
|
||||
sub ProcessExtendedContentDescription($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dirLen = $$dirInfo{DirLen};
|
||||
return 0 if $dirLen < 2;
|
||||
my $count = Get16u($dataPt, 0);
|
||||
$et->VerboseDir($dirInfo, $count);
|
||||
my $pos = 2;
|
||||
my $i;
|
||||
for ($i=0; $i<$count; ++$i) {
|
||||
return 0 if $pos + 6 > $dirLen;
|
||||
my $nameLen = unpack("x${pos}v", $$dataPt);
|
||||
$pos += 2;
|
||||
return 0 if $pos + $nameLen + 4 > $dirLen;
|
||||
my $tag = Image::ExifTool::Decode(undef,substr($$dataPt,$pos,$nameLen),'UCS2','II','Latin');
|
||||
$tag =~ s/^WM\///; # remove leading "WM/"
|
||||
$pos += $nameLen;
|
||||
my ($dType, $dLen) = unpack("x${pos}v2", $$dataPt);
|
||||
$pos += 4;
|
||||
return 0 if $pos + $dLen > $dirLen;
|
||||
my $val = ReadASF($et,$dataPt,$pos,$dType,$dLen);
|
||||
$et->HandleTag($tagTablePtr, $tag, $val,
|
||||
DataPt => $dataPt,
|
||||
Start => $pos,
|
||||
Size => $dLen,
|
||||
);
|
||||
$pos += $dLen;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process ASF metadata library (similar to ProcessExtendedContentDescription above)
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
|
||||
# Returns: 1 on success
|
||||
sub ProcessMetadata($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dirLen = $$dirInfo{DirLen};
|
||||
return 0 if $dirLen < 2;
|
||||
my $count = Get16u($dataPt, 0);
|
||||
$et->VerboseDir($dirInfo, $count);
|
||||
my $pos = 2;
|
||||
my $i;
|
||||
for ($i=0; $i<$count; ++$i) {
|
||||
return 0 if $pos + 12 > $dirLen;
|
||||
my ($index, $stream, $nameLen, $dType, $dLen) = unpack("x${pos}v4V", $$dataPt);
|
||||
$pos += 12;
|
||||
return 0 if $pos + $nameLen + $dLen > $dirLen;
|
||||
my $tag = Image::ExifTool::Decode(undef,substr($$dataPt,$pos,$nameLen),'UCS2','II','Latin');
|
||||
$tag =~ s/^WM\///; # remove leading "WM/"
|
||||
$pos += $nameLen;
|
||||
my $val = ReadASF($et,$dataPt,$pos,$dType,$dLen);
|
||||
$et->HandleTag($tagTablePtr, $tag, $val,
|
||||
DataPt => $dataPt,
|
||||
Start => $pos,
|
||||
Size => $dLen,
|
||||
);
|
||||
$pos += $dLen;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process WM/Picture preview
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
|
||||
# Returns: 1 on success
|
||||
sub ProcessPicture($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dirStart = $$dirInfo{DirStart};
|
||||
my $dirLen = $$dirInfo{DirLen};
|
||||
return 0 unless $dirLen > 9;
|
||||
# extract picture type and length
|
||||
my ($type, $picLen) = unpack("x${dirStart}CV", $$dataPt);
|
||||
$et->VerboseDir('Picture');
|
||||
$et->HandleTag($tagTablePtr, 0, $type);
|
||||
# extract mime type and description strings (null-terminated unicode strings)
|
||||
my $n = $dirLen - 5 - $picLen;
|
||||
return 0 if $n & 0x01 or $n < 4;
|
||||
my $str = substr($$dataPt, $dirStart+5, $n);
|
||||
if ($str =~ /^((?:..)*?)\0\0((?:..)*?)\0\0/s) {
|
||||
my ($mime, $desc) = ($1, $2);
|
||||
$et->HandleTag($tagTablePtr, 1, $et->Decode($mime,'UCS2','II'));
|
||||
$et->HandleTag($tagTablePtr, 2, $et->Decode($desc,'UCS2','II')) if length $desc;
|
||||
}
|
||||
$et->HandleTag($tagTablePtr, 3, substr($$dataPt, $dirStart+5+$n, $picLen));
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process codec list
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo ref, 2) tag table reference
|
||||
# Returns: 1 on success
|
||||
sub ProcessCodecList($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dirLen = $$dirInfo{DirLen};
|
||||
return 0 if $dirLen < 20;
|
||||
my $count = Get32u($dataPt, 16);
|
||||
$et->VerboseDir($dirInfo, $count);
|
||||
my $pos = 20;
|
||||
my $i;
|
||||
my %codecType = ( 1 => 'Video', 2 => 'Audio' );
|
||||
for ($i=0; $i<$count; ++$i) {
|
||||
return 0 if $pos + 8 > $dirLen;
|
||||
my $type = ($codecType{Get16u($dataPt, $pos)} || 'Other') . 'Codec';
|
||||
# stupid Windows programmers: these lengths are in characters (others are in bytes)
|
||||
my $nameLen = Get16u($dataPt, $pos + 2) * 2;
|
||||
$pos += 4;
|
||||
return 0 if $pos + $nameLen + 2 > $dirLen;
|
||||
my $name = $et->Decode(substr($$dataPt,$pos,$nameLen),'UCS2','II');
|
||||
$et->HandleTag($tagTablePtr, "${type}Name", $name);
|
||||
my $descLen = Get16u($dataPt, $pos + $nameLen) * 2;
|
||||
$pos += $nameLen + 2;
|
||||
return 0 if $pos + $descLen + 2 > $dirLen;
|
||||
my $desc = $et->Decode(substr($$dataPt,$pos,$descLen),'UCS2','II');
|
||||
$et->HandleTag($tagTablePtr, "${type}Description", $desc);
|
||||
my $infoLen = Get16u($dataPt, $pos + $descLen);
|
||||
$pos += $descLen + 2 + $infoLen;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Extract information from a ASF file
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference, 2) tag table ref
|
||||
# Returns: 1 on success, 0 if this wasn't a valid ASF file
|
||||
sub ProcessASF($$;$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $verbose = $et->Options('Verbose');
|
||||
my $rtnVal = 0;
|
||||
my $pos = 0;
|
||||
my ($buff, $err, @parentTable, @childEnd);
|
||||
|
||||
for (;;) {
|
||||
last unless $raf->Read($buff, 24) == 24;
|
||||
$pos += 24;
|
||||
my $tag = GetGUID(substr($buff,0,16));
|
||||
unless ($tagTablePtr) {
|
||||
# verify this is a valid ASF file
|
||||
last unless $tag eq '75B22630-668E-11CF-A6D9-00AA0062CE6C';
|
||||
my $fileType = $$et{FILE_EXT};
|
||||
$fileType = 'ASF' unless $fileType and $fileType =~ /^(ASF|WMV|WMA|DIVX)$/;
|
||||
$et->SetFileType($fileType);
|
||||
SetByteOrder('II');
|
||||
$tagTablePtr = GetTagTable('Image::ExifTool::ASF::Main');
|
||||
$rtnVal = 1;
|
||||
}
|
||||
my $size = Image::ExifTool::Get64u(\$buff, 16) - 24;
|
||||
if ($size < 0) {
|
||||
$err = 'Invalid ASF object size';
|
||||
last;
|
||||
}
|
||||
if ($size > 0x7fffffff) {
|
||||
if ($size > 0x7fffffff * 4294967296) {
|
||||
$err = 'Invalid ASF object size';
|
||||
} elsif ($et->Options('LargeFileSupport')) {
|
||||
if ($raf->Seek($size, 1)) {
|
||||
$et->VPrint(0, " Skipped large ASF object ($size bytes)\n");
|
||||
$pos += $size;
|
||||
next;
|
||||
}
|
||||
$err = 'Error seeking past large ASF object';
|
||||
} else {
|
||||
$err = 'Large ASF objects not supported (LargeFileSupport not set)';
|
||||
}
|
||||
last;
|
||||
}
|
||||
# go back to parent tag table if done with previous children
|
||||
if (@childEnd and $pos >= $childEnd[-1]) {
|
||||
pop @childEnd;
|
||||
$tagTablePtr = pop @parentTable;
|
||||
$$et{INDENT} = substr($$et{INDENT},0,-2);
|
||||
}
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
|
||||
$verbose and $et->VerboseInfo($tag, $tagInfo);
|
||||
if ($tagInfo) {
|
||||
my $subdir = $$tagInfo{SubDirectory};
|
||||
if ($subdir) {
|
||||
my $subTable = GetTagTable($$subdir{TagTable});
|
||||
if ($$subTable{PROCESS_PROC} eq \&ProcessASF) {
|
||||
if (defined $$subdir{Size}) {
|
||||
my $s = $$subdir{Size};
|
||||
if ($verbose > 2) {
|
||||
$raf->Read($buff, $s) == $s or $err = 'Truncated file', last;
|
||||
$et->VerboseDump(\$buff);
|
||||
} elsif (not $raf->Seek($s, 1)) {
|
||||
$err = 'Seek error';
|
||||
last;
|
||||
}
|
||||
# continue processing linearly using subTable
|
||||
push @parentTable, $tagTablePtr;
|
||||
push @childEnd, $pos + $size;
|
||||
$tagTablePtr = $subTable;
|
||||
$pos += $$subdir{Size};
|
||||
if ($verbose) {
|
||||
$$et{INDENT} .= '| ';
|
||||
$et->VerboseDir($$tagInfo{Name});
|
||||
}
|
||||
next;
|
||||
}
|
||||
} elsif ($raf->Read($buff, $size) == $size) {
|
||||
my %subdirInfo = (
|
||||
DataPt => \$buff,
|
||||
DirStart => 0,
|
||||
DirLen => $size,
|
||||
DirName => $$tagInfo{Name},
|
||||
);
|
||||
$et->VerboseDump(\$buff) if $verbose > 2;
|
||||
unless ($et->ProcessDirectory(\%subdirInfo, $subTable, $$subdir{ProcessProc})) {
|
||||
$et->Warn("Error processing $$tagInfo{Name} directory");
|
||||
}
|
||||
$pos += $size;
|
||||
next;
|
||||
} else {
|
||||
$err = 'Unexpected end of file';
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
if ($verbose > 2) {
|
||||
$raf->Read($buff, $size) == $size or $err = 'Truncated file', last;
|
||||
$et->VerboseDump(\$buff);
|
||||
} elsif (not $raf->Seek($size, 1)) { # skip the block
|
||||
$err = 'Seek error';
|
||||
last;
|
||||
}
|
||||
$pos += $size;
|
||||
}
|
||||
$err and $et->Warn($err);
|
||||
return $rtnVal;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::ASF - Read ASF/WMA/WMV meta information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains routines required by Image::ExifTool to extract
|
||||
information from Microsoft Advanced Systems Format (ASF) files, including
|
||||
Windows Media Audio (WMA) and Windows Media Video (WMV) files.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://www.microsoft.com/windows/windowsmedia/format/asfspec.aspx>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/ASF Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,161 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Apple.pm
|
||||
#
|
||||
# Description: Apple EXIF maker notes tags
|
||||
#
|
||||
# Revisions: 2013-09-13 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://www.photoinvestigator.co/blog/the-mystery-of-maker-apple-metadata/
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::Apple;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool::Exif;
|
||||
use Image::ExifTool::PLIST;
|
||||
|
||||
$VERSION = '1.04';
|
||||
|
||||
# Apple iPhone metadata (ref PH)
|
||||
%Image::ExifTool::Apple::Main = (
|
||||
WRITE_PROC => \&Image::ExifTool::Exif::WriteExif,
|
||||
CHECK_PROC => \&Image::ExifTool::Exif::CheckExif,
|
||||
WRITABLE => 1,
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Image' },
|
||||
NOTES => 'Tags extracted from the maker notes of iPhone images.',
|
||||
# 0x0001 - int32s: seen 0,1,2,3,4,9
|
||||
# 0x0002 - binary plist with a single data object of size 512 bytes (iPhone5s)
|
||||
0x0003 => {
|
||||
Name => 'RunTime', # (includes time plugged in, but not when suspended, ref 1)
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Apple::RunTime' },
|
||||
},
|
||||
# 0x0004 - int32s: normally 1, but 0 for low-light images
|
||||
# 0x0005 - int32s: seen values 113-247, and 100 for blank images
|
||||
# 0x0006 - int32s: seen values 27-258, and 20 for blank images
|
||||
# 0x0007 - int32s: seen 1
|
||||
0x0008 => { #1
|
||||
Name => 'AccelerationVector',
|
||||
Groups => { 2 => 'Camera' },
|
||||
Writable => 'rational64s',
|
||||
Count => 3,
|
||||
# Note: the directions are contrary to the Apple documentation (which have the
|
||||
# signs of all axes reversed -- apparently the Apple geeks aren't very good
|
||||
# with basic physics, and don't understand the concept of acceleration. See
|
||||
# http://nscookbook.com/2013/03/ios-programming-recipe-19-using-core-motion-to-access-gyro-and-accelerometer/
|
||||
# for one of the few correct descriptions of this). Note that this leads to
|
||||
# a left-handed coordinate system for acceleration.
|
||||
Notes => q{
|
||||
XYZ coordinates of the acceleration vector in units of g. As viewed from
|
||||
the front of the phone, positive X is toward the left side, positive Y is
|
||||
toward the bottom, and positive Z points into the face of the phone
|
||||
},
|
||||
},
|
||||
# 0x0009 - int32s: seen 19,275,531,4371
|
||||
0x000a => {
|
||||
Name => 'HDRImageType',
|
||||
Writable => 'int32s',
|
||||
PrintConv => {
|
||||
# 2 => ? (iPad mini 2)
|
||||
3 => 'HDR Image',
|
||||
4 => 'Original Image',
|
||||
},
|
||||
},
|
||||
0x000b => {
|
||||
Name => 'BurstUUID',
|
||||
Writable => 'string',
|
||||
Notes => 'unique ID for all images in a burst',
|
||||
},
|
||||
# 0x000c - rational64s[2]: eg) "0.1640625 0.19921875"
|
||||
# 0x000d - int32s: 0,1,6,20,24,32,40
|
||||
# 0x000e - int32s: 0,1,4,12 (Orienation? 0=landscape? 4=portrait? ref 1)
|
||||
# 0x000f - int32s: 2,3
|
||||
# 0x0010 - int32s: 1
|
||||
0x0011 => {
|
||||
Name => 'ContentIdentifier', #forum8750
|
||||
Writable => 'string',
|
||||
},
|
||||
# 0x0014 - int32s: 1,2,3,4,5 (iPhone 6s, iOS 6.1)
|
||||
0x0015 => {
|
||||
Name => 'ImageUniqueID',
|
||||
Writable => 'string',
|
||||
},
|
||||
# 0x0016 - string[29]: "AXZ6pMTOh2L+acSh4Kg630XCScoO\0"
|
||||
# 0x0017 - int32s: 0,8192
|
||||
# 0x0019 - int32s: 0,2,128
|
||||
# 0x001a - string[6]: "q825s\0"
|
||||
# 0x001f - int32s: 0
|
||||
);
|
||||
|
||||
# PLIST-format CMTime structure (ref PH)
|
||||
# (CMTime ref https://developer.apple.com/library/ios/documentation/CoreMedia/Reference/CMTime/Reference/reference.html)
|
||||
%Image::ExifTool::Apple::RunTime = (
|
||||
PROCESS_PROC => \&Image::ExifTool::PLIST::ProcessBinaryPLIST,
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Image' },
|
||||
NOTES => q{
|
||||
This PLIST-format information contains the elements of a CMTime structure
|
||||
representing the amount of time the phone has been running since the last
|
||||
boot, not including standby time.
|
||||
},
|
||||
timescale => { Name => 'RunTimeScale' }, # (seen 1000000000 --> ns)
|
||||
epoch => { Name => 'RunTimeEpoch' }, # (seen 0)
|
||||
value => { Name => 'RunTimeValue' }, # (should divide by RunTimeScale to get seconds)
|
||||
flags => {
|
||||
Name => 'RunTimeFlags',
|
||||
PrintConv => { BITMASK => {
|
||||
0 => 'Valid',
|
||||
1 => 'Has been rounded',
|
||||
2 => 'Positive infinity',
|
||||
3 => 'Negative infinity',
|
||||
4 => 'Indefinite',
|
||||
}},
|
||||
},
|
||||
);
|
||||
|
||||
# Apple composite tags
|
||||
%Image::ExifTool::Apple::Composite = (
|
||||
GROUPS => { 2 => 'Camera' },
|
||||
RunTimeSincePowerUp => {
|
||||
Require => {
|
||||
0 => 'Apple:RunTimeValue',
|
||||
1 => 'Apple:RunTimeScale',
|
||||
},
|
||||
ValueConv => '$val[1] ? $val[0] / $val[1] : undef',
|
||||
PrintConv => 'ConvertDuration($val)',
|
||||
},
|
||||
);
|
||||
|
||||
# add our composite tags
|
||||
Image::ExifTool::AddCompositeTags('Image::ExifTool::Apple');
|
||||
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::Apple - Apple EXIF maker notes tags
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is loaded automatically by Image::ExifTool when required.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to interpret
|
||||
Apple maker notes in EXIF information.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/Apple Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,317 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Audible.pm
|
||||
#
|
||||
# Description: Read metadata from Audible audio books
|
||||
#
|
||||
# Revisions: 2015/04/05 - P. Harvey Created
|
||||
#
|
||||
# References: 1) https://github.com/jteeuwen/audible
|
||||
# 2) https://code.google.com/p/pyaudibletags/
|
||||
# 3) http://wiki.multimedia.cx/index.php?title=Audible_Audio
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::Audible;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.02';
|
||||
|
||||
sub ProcessAudible_meta($$$);
|
||||
sub ProcessAudible_cvrx($$$);
|
||||
|
||||
%Image::ExifTool::Audible::Main = (
|
||||
GROUPS => { 2 => 'Audio' },
|
||||
NOTES => q{
|
||||
ExifTool will extract any information found in the metadata dictionary of
|
||||
Audible .AA files, even if not listed in the table below.
|
||||
},
|
||||
# tags found in the metadata dictionary (chunk 2)
|
||||
pubdate => { Name => 'PublishDate', Groups => { 2 => 'Time' } },
|
||||
pub_date_start => { Name => 'PublishDateStart', Groups => { 2 => 'Time' } },
|
||||
author => { Name => 'Author', Groups => { 2 => 'Author' } },
|
||||
copyright => { Name => 'Copyright', Groups => { 2 => 'Author' } },
|
||||
# also seen (ref PH):
|
||||
# product_id, parent_id, title, provider, narrator, price, description,
|
||||
# long_description, short_title, is_aggregation, title_id, codec, HeaderSeed,
|
||||
# EncryptedBlocks, HeaderKey, license_list, CPUType, license_count, <12 hex digits>,
|
||||
# parent_short_title, parent_title, aggregation_id, short_description, user_alias
|
||||
|
||||
# information extracted from other chunks
|
||||
_chapter_count => { Name => 'ChapterCount' }, # from chunk 6
|
||||
_cover_art => { # from chunk 11
|
||||
Name => 'CoverArt',
|
||||
Groups => { 2 => 'Preview' },
|
||||
Binary => 1,
|
||||
},
|
||||
);
|
||||
|
||||
# 'tags' atoms observed in Audible .m4b audio books (ref PH)
|
||||
%Image::ExifTool::Audible::tags = (
|
||||
GROUPS => { 0 => 'QuickTime', 2 => 'Audio' },
|
||||
NOTES => 'Information found in "tags" atom of Audible M4B audio books.',
|
||||
meta => {
|
||||
Name => 'Audible_meta',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Audible::meta' },
|
||||
},
|
||||
cvrx => {
|
||||
Name => 'Audible_cvrx',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Audible::cvrx' },
|
||||
},
|
||||
tseg => {
|
||||
Name => 'Audible_tseg',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Audible::tseg' },
|
||||
},
|
||||
);
|
||||
|
||||
# 'meta' information observed in Audible .m4b audio books (ref PH)
|
||||
%Image::ExifTool::Audible::meta = (
|
||||
PROCESS_PROC => \&ProcessAudible_meta,
|
||||
GROUPS => { 0 => 'QuickTime', 2 => 'Audio' },
|
||||
NOTES => 'Information found in Audible M4B "meta" atom.',
|
||||
Album => 'Album',
|
||||
ALBUMARTIST => { Name => 'AlbumArtist', Groups => { 2 => 'Author' } },
|
||||
Artist => { Name => 'Artist', Groups => { 2 => 'Author' } },
|
||||
Comment => 'Comment',
|
||||
Genre => 'Genre',
|
||||
itunesmediatype => { Name => 'iTunesMediaType', Description => 'iTunes Media Type' },
|
||||
SUBTITLE => 'Subtitle',
|
||||
Title => 'Title',
|
||||
TOOL => 'CreatorTool',
|
||||
Year => { Name => 'Year', Groups => { 2 => 'Time' } },
|
||||
track => 'ChapterName', # (found in 'meta' of 'tseg' atom)
|
||||
);
|
||||
|
||||
# 'cvrx' information observed in Audible .m4b audio books (ref PH)
|
||||
%Image::ExifTool::Audible::cvrx = (
|
||||
PROCESS_PROC => \&ProcessAudible_cvrx,
|
||||
GROUPS => { 0 => 'QuickTime', 2 => 'Audio' },
|
||||
NOTES => 'Audible cover art information in M4B audio books.',
|
||||
VARS => { NO_ID => 1 },
|
||||
CoverArtType => 'CoverArtType',
|
||||
CoverArt => {
|
||||
Name => 'CoverArt',
|
||||
Groups => { 2 => 'Preview' },
|
||||
Binary => 1,
|
||||
},
|
||||
);
|
||||
|
||||
# 'tseg' information observed in Audible .m4b audio books (ref PH)
|
||||
%Image::ExifTool::Audible::tseg = (
|
||||
GROUPS => { 0 => 'QuickTime', 2 => 'Audio' },
|
||||
tshd => {
|
||||
Name => 'ChapterNumber',
|
||||
Format => 'int32u',
|
||||
ValueConv => '$val + 1', # start counting from 1
|
||||
},
|
||||
meta => {
|
||||
Name => 'Audible_meta2',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Audible::meta' },
|
||||
},
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process Audible 'meta' tags from M4B files (ref PH)
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: 1 on success
|
||||
sub ProcessAudible_meta($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dataPos = $$dirInfo{DataPos};
|
||||
my $dirLen = length $$dataPt;
|
||||
return 0 if $dirLen < 4;
|
||||
my $num = Get32u($dataPt, 0);
|
||||
$et->VerboseDir('Audible_meta', $num);
|
||||
my $pos = 4;
|
||||
my $index;
|
||||
for ($index=0; $index<$num; ++$index) {
|
||||
last if $pos + 3 > $dirLen;
|
||||
my $unk = Get8u($dataPt, $pos); # ? (0x80 or 0x00)
|
||||
last unless $unk eq 0x80 or $unk eq 0x00;
|
||||
my $len = Get16u($dataPt, $pos + 1); # tag length
|
||||
$pos += 3;
|
||||
last if $pos + $len + 6 > $dirLen or not $len;
|
||||
my $tag = substr($$dataPt, $pos, $len); # tag ID
|
||||
my $ver = Get16u($dataPt, $pos + $len); # version?
|
||||
last unless $ver eq 0x0001;
|
||||
my $size = Get32u($dataPt, $pos + $len + 2);# data size
|
||||
$pos += $len + 6;
|
||||
last if $pos + $size > $dirLen;
|
||||
my $val = $et->Decode(substr($$dataPt, $pos, $size), 'UTF8');
|
||||
unless ($$tagTablePtr{$tag}) {
|
||||
my $name = Image::ExifTool::MakeTagName(($tag =~ /[a-z]/) ? $tag : lc($tag));
|
||||
AddTagToTable($tagTablePtr, $tag, { Name => $name });
|
||||
}
|
||||
$et->HandleTag($tagTablePtr, $tag, $val,
|
||||
DataPt => $dataPt,
|
||||
DataPos => $dataPos,
|
||||
Start => $pos,
|
||||
Size => $size,
|
||||
Index => $index,
|
||||
);
|
||||
$pos += $size;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process Audible 'cvrx' cover art atom from M4B files (ref PH)
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: 1 on success
|
||||
sub ProcessAudible_cvrx($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dataPos = $$dirInfo{DataPos};
|
||||
my $dirLen = length $$dataPt;
|
||||
return 0 if 0x0a > $dirLen;
|
||||
my $len = Get16u($dataPt, 0x08);
|
||||
return 0 if 0x0a + $len + 6 > $dirLen;
|
||||
my $size = Get32u($dataPt, 0x0a + $len + 2);
|
||||
return 0 if 0x0a + $len + 6 + $size > $dirLen;
|
||||
$et->VerboseDir('Audible_cvrx', undef, $dirLen);
|
||||
$et->HandleTag($tagTablePtr, 'CoverArtType', undef,
|
||||
DataPt => $dataPt,
|
||||
DataPos => $dataPos,
|
||||
Start => 0x0a,
|
||||
Size => $len,
|
||||
);
|
||||
$et->HandleTag($tagTablePtr, 'CoverArt', undef,
|
||||
DataPt => $dataPt,
|
||||
DataPos => $dataPos,
|
||||
Start => 0x0a + $len + 6,
|
||||
Size => $size,
|
||||
);
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read information from an Audible .AA file
|
||||
# Inputs: 0) ExifTool ref, 1) dirInfo ref
|
||||
# Returns: 1 on success, 0 if this wasn't a valid AA file
|
||||
sub ProcessAA($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my ($buff, $toc, $entry, $i);
|
||||
|
||||
# check magic number
|
||||
return 0 unless $raf->Read($buff, 16) == 16 and $buff=~/^.{4}\x57\x90\x75\x36/s;
|
||||
# check file size
|
||||
if (defined $$et{VALUE}{FileSize}) {
|
||||
# first 4 bytes of the file should be the filesize
|
||||
unpack('N', $buff) == $$et{VALUE}{FileSize} or return 0;
|
||||
}
|
||||
$et->SetFileType();
|
||||
SetByteOrder('MM');
|
||||
my $bytes = 12 * Get32u(\$buff, 8); # table of contents size in bytes
|
||||
$bytes > 0xc00 and $et->Warn('Invalid TOC'), return 1;
|
||||
# read the table of contents
|
||||
$raf->Read($toc, $bytes) == $bytes or $et->Warn('Truncated TOC'), return 1;
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::Audible::Main');
|
||||
# parse table of contents (in $toc)
|
||||
for ($entry=0; $entry<$bytes; $entry+=12) {
|
||||
my $type = Get32u(\$toc, $entry);
|
||||
next unless $type == 2 or $type == 6 or $type == 11;
|
||||
my $offset = Get32u(\$toc, $entry + 4);
|
||||
my $length = Get32u(\$toc, $entry + 8) or next;
|
||||
$raf->Seek($offset, 0) or $et->Warn("Chunk $type seek error"), last;
|
||||
if ($type == 6) { # offset table
|
||||
next if $length < 4 or $raf->Read($buff, 4) != 4; # only read the chapter count
|
||||
$et->HandleTag($tagTablePtr, '_chapter_count', Get32u(\$buff, 0));
|
||||
next;
|
||||
}
|
||||
# read the chunk
|
||||
$length > 100000000 and $et->Warn("Chunk $type too big"), next;
|
||||
$raf->Read($buff, $length) == $length or $et->Warn("Chunk $type read error"), last;
|
||||
if ($type == 11) { # cover art
|
||||
next if $length < 8;
|
||||
my $len = Get32u(\$buff, 0);
|
||||
my $off = Get32u(\$buff, 4);
|
||||
next if $off < $offset + 8 or $off - $offset + $len > $length;
|
||||
$et->HandleTag($tagTablePtr, '_cover_art', substr($buff, $off-$offset, $len));
|
||||
next;
|
||||
}
|
||||
# parse metadata dictionary (in $buff)
|
||||
$length < 4 and $et->Warn('Bad dictionary'), next;
|
||||
my $num = Get32u(\$buff, 0);
|
||||
$num > 0x200 and $et->Warn('Bad dictionary count'), next;
|
||||
my $pos = 4; # dictionary starts immediately after count
|
||||
require Image::ExifTool::HTML; # (for UnescapeHTML)
|
||||
$et->VerboseDir('Audible Metadata', $num);
|
||||
for ($i=0; $i<$num; ++$i) {
|
||||
my $tagPos = $pos + 9; # position of tag string
|
||||
$tagPos > $length and $et->Warn('Truncated dictionary'), last;
|
||||
# (1 unknown byte ignored at start of each dictionary entry)
|
||||
my $tagLen = Get32u(\$buff, $pos + 1); # tag string length
|
||||
my $valLen = Get32u(\$buff, $pos + 5); # value string length
|
||||
my $valPos = $tagPos + $tagLen; # position of value string
|
||||
my $nxtPos = $valPos + $valLen; # position of next entry
|
||||
$nxtPos > $length and $et->Warn('Bad dictionary entry'), last;
|
||||
my $tag = substr($buff, $tagPos, $tagLen);
|
||||
my $val = substr($buff, $valPos, $valLen);
|
||||
unless ($$tagTablePtr{$tag}) {
|
||||
my $name = Image::ExifTool::MakeTagName($tag);
|
||||
$name =~ s/_(.)/\U$1/g; # change from underscore-separated to mixed case
|
||||
AddTagToTable($tagTablePtr, $tag, { Name => $name });
|
||||
}
|
||||
# unescape HTML character references and convert from UTF-8
|
||||
$val = $et->Decode(Image::ExifTool::HTML::UnescapeHTML($val), 'UTF8');
|
||||
$et->HandleTag($tagTablePtr, $tag, $val,
|
||||
DataPos => $offset,
|
||||
DataPt => \$buff,
|
||||
Start => $valPos,
|
||||
Size => $valLen,
|
||||
Index => $i,
|
||||
);
|
||||
$pos = $nxtPos; # step to next dictionary entry
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::Audible - Read meta information from Audible audio books
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to read meta
|
||||
information from Audible audio books.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<https://github.com/jteeuwen/audible>
|
||||
|
||||
=item L<https://code.google.com/p/pyaudibletags/>
|
||||
|
||||
=item L<http://wiki.multimedia.cx/index.php?title=Audible_Audio>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/Audible Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,361 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: BMP.pm
|
||||
#
|
||||
# Description: Read BMP meta information
|
||||
#
|
||||
# Revisions: 07/16/2005 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://www.fortunecity.com/skyscraper/windows/364/bmpffrmt.html
|
||||
# 2) http://www.fourcc.org/rgb.php
|
||||
# 3) https://msdn.microsoft.com/en-us/library/dd183381(v=vs.85).aspx
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::BMP;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.09';
|
||||
|
||||
# conversions for fixed-point 2.30 format values
|
||||
my %fixed2_30 = (
|
||||
ValueConv => q{
|
||||
my @a = split ' ', $val;
|
||||
$_ /= 0x40000000 foreach @a;
|
||||
"@a";
|
||||
},
|
||||
PrintConv => q{
|
||||
my @a = split ' ', $val;
|
||||
$_ = sprintf('%.6f', $_) foreach @a;
|
||||
"@a";
|
||||
},
|
||||
);
|
||||
|
||||
# BMP chunks
|
||||
%Image::ExifTool::BMP::Main = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
|
||||
NOTES => q{
|
||||
There really isn't much meta information in a BMP file as such, just a bit
|
||||
of image related information.
|
||||
},
|
||||
0 => {
|
||||
Name => 'BMPVersion',
|
||||
Format => 'int32u',
|
||||
Notes => q{
|
||||
this is actually the size of the BMP header, but used to determine the BMP
|
||||
version
|
||||
},
|
||||
RawConv => '$$self{BMPVersion} = $val',
|
||||
PrintConv => {
|
||||
40 => 'Windows V3',
|
||||
68 => 'AVI BMP structure?', #PH (seen in AVI movies from some Casio and Nikon cameras)
|
||||
108 => 'Windows V4',
|
||||
124 => 'Windows V5',
|
||||
},
|
||||
},
|
||||
4 => {
|
||||
Name => 'ImageWidth',
|
||||
Format => 'int32u',
|
||||
},
|
||||
8 => {
|
||||
Name => 'ImageHeight',
|
||||
Format => 'int32s', # (negative when stored in top-to-bottom order)
|
||||
ValueConv => 'abs($val)',
|
||||
},
|
||||
12 => {
|
||||
Name => 'Planes',
|
||||
Format => 'int16u',
|
||||
# values: 0,1,4,8,16,24,32
|
||||
},
|
||||
14 => {
|
||||
Name => 'BitDepth',
|
||||
Format => 'int16u',
|
||||
},
|
||||
16 => {
|
||||
Name => 'Compression',
|
||||
Format => 'int32u',
|
||||
RawConv => '$$self{BMPCompression} = $val',
|
||||
# (formatted as string[4] for some values in AVI images)
|
||||
ValueConv => '$val > 256 ? unpack("A4",pack("V",$val)) : $val',
|
||||
PrintConv => {
|
||||
0 => 'None',
|
||||
1 => '8-Bit RLE',
|
||||
2 => '4-Bit RLE',
|
||||
3 => 'Bitfields',
|
||||
4 => 'JPEG', #2
|
||||
5 => 'PNG', #2
|
||||
# pass through ASCII video compression codec ID's
|
||||
OTHER => sub {
|
||||
my $val = shift;
|
||||
# convert non-ascii characters
|
||||
$val =~ s/([\0-\x1f\x7f-\xff])/sprintf('\\x%.2x',ord $1)/eg;
|
||||
return $val;
|
||||
},
|
||||
},
|
||||
},
|
||||
20 => {
|
||||
Name => 'ImageLength',
|
||||
Format => 'int32u',
|
||||
RawConv => '$$self{BMPImageLength} = $val',
|
||||
},
|
||||
24 => {
|
||||
Name => 'PixelsPerMeterX',
|
||||
Format => 'int32u',
|
||||
},
|
||||
28 => {
|
||||
Name => 'PixelsPerMeterY',
|
||||
Format => 'int32u',
|
||||
},
|
||||
32 => {
|
||||
Name => 'NumColors',
|
||||
Format => 'int32u',
|
||||
PrintConv => '$val ? $val : "Use BitDepth"',
|
||||
},
|
||||
36 => {
|
||||
Name => 'NumImportantColors',
|
||||
Format => 'int32u',
|
||||
Hook => '$varSize += $size if $$self{BMPVersion} == 68', # (the rest is invalid for AVI BMP's)
|
||||
PrintConv => '$val ? $val : "All"',
|
||||
},
|
||||
40 => {
|
||||
Name => 'RedMask',
|
||||
Format => 'int32u',
|
||||
PrintConv => 'sprintf("0x%.8x",$val)',
|
||||
},
|
||||
44 => {
|
||||
Name => 'GreenMask',
|
||||
Format => 'int32u',
|
||||
PrintConv => 'sprintf("0x%.8x",$val)',
|
||||
},
|
||||
48 => {
|
||||
Name => 'BlueMask',
|
||||
Format => 'int32u',
|
||||
PrintConv => 'sprintf("0x%.8x",$val)',
|
||||
},
|
||||
52 => {
|
||||
Name => 'AlphaMask',
|
||||
Format => 'int32u',
|
||||
PrintConv => 'sprintf("0x%.8x",$val)',
|
||||
},
|
||||
56 => {
|
||||
Name => 'ColorSpace',
|
||||
Format => 'undef[4]',
|
||||
RawConv => '$$self{BMPColorSpace} = $val =~ /\0/ ? Get32u(\$val, 0) : pack("N",unpack("V",$val))',
|
||||
PrintConv => {
|
||||
0 => 'Calibrated RGB',
|
||||
1 => 'Device RGB',
|
||||
2 => 'Device CMYK',
|
||||
LINK => 'Linked Color Profile',
|
||||
MBED => 'Embedded Color Profile',
|
||||
sRGB => 'sRGB',
|
||||
'Win ' => 'Windows Color Space',
|
||||
},
|
||||
},
|
||||
60 => {
|
||||
Name => 'RedEndpoint',
|
||||
Condition => '$$self{BMPColorSpace} eq "0"',
|
||||
Format => 'int32u[3]',
|
||||
%fixed2_30,
|
||||
},
|
||||
72 => {
|
||||
Name => 'GreenEndpoint',
|
||||
Condition => '$$self{BMPColorSpace} eq "0"',
|
||||
Format => 'int32u[3]',
|
||||
%fixed2_30,
|
||||
},
|
||||
84 => {
|
||||
Name => 'BlueEndpoint',
|
||||
Condition => '$$self{BMPColorSpace} eq "0"',
|
||||
Format => 'int32u[3]',
|
||||
%fixed2_30,
|
||||
},
|
||||
96 => {
|
||||
Name => 'GammaRed',
|
||||
Condition => '$$self{BMPColorSpace} eq "0"',
|
||||
Format => 'fixed32u',
|
||||
},
|
||||
100 => {
|
||||
Name => 'GammaGreen',
|
||||
Condition => '$$self{BMPColorSpace} eq "0"',
|
||||
Format => 'fixed32u',
|
||||
},
|
||||
104 => {
|
||||
Name => 'GammaBlue',
|
||||
Condition => '$$self{BMPColorSpace} eq "0"',
|
||||
Format => 'fixed32u',
|
||||
},
|
||||
108 => {
|
||||
Name => 'RenderingIntent',
|
||||
Format => 'int32u',
|
||||
PrintConv => {
|
||||
1 => 'Graphic (LCS_GM_BUSINESS)',
|
||||
2 => 'Proof (LCS_GM_GRAPHICS)',
|
||||
4 => 'Picture (LCS_GM_IMAGES)',
|
||||
8 => 'Absolute Colorimetric (LCS_GM_ABS_COLORIMETRIC)',
|
||||
},
|
||||
},
|
||||
112 => {
|
||||
Name => 'ProfileDataOffset',
|
||||
Condition => '$$self{BMPColorSpace} eq "LINK" or $$self{BMPColorSpace} eq "MBED"',
|
||||
Format => 'int32u',
|
||||
RawConv => '$$self{BMPProfileOffset} = $val',
|
||||
},
|
||||
116 => {
|
||||
Name => 'ProfileSize',
|
||||
Condition => '$$self{BMPColorSpace} eq "LINK" or $$self{BMPColorSpace} eq "MBED"',
|
||||
Format => 'int32u',
|
||||
RawConv => '$$self{BMPProfileSize} = $val',
|
||||
},
|
||||
# 120 - reserved
|
||||
);
|
||||
|
||||
# OS/2 12-byte bitmap header (ref http://www.fileformat.info/format/bmp/egff.htm)
|
||||
%Image::ExifTool::BMP::OS2 = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
|
||||
NOTES => 'Information extracted from OS/2-format BMP images.',
|
||||
0 => {
|
||||
Name => 'BMPVersion',
|
||||
Format => 'int32u',
|
||||
Notes => 'again, the header size is used to determine the BMP version',
|
||||
PrintConv => {
|
||||
12 => 'OS/2 V1',
|
||||
64 => 'OS/2 V2',
|
||||
},
|
||||
},
|
||||
4 => { Name => 'ImageWidth', Format => 'int16u' },
|
||||
6 => { Name => 'ImageHeight', Format => 'int16u' },
|
||||
8 => { Name => 'Planes', Format => 'int16u' },
|
||||
10 => { Name => 'BitDepth', Format => 'int16u' },
|
||||
);
|
||||
|
||||
%Image::ExifTool::BMP::Extra = (
|
||||
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
|
||||
NOTES => 'Extra information extracted from some BMP images.',
|
||||
VARS => { NO_ID => 1 },
|
||||
LinkedProfileName => { },
|
||||
ICC_Profile => { SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main' } },
|
||||
EmbeddedJPG => {
|
||||
Groups => { 2 => 'Preview' },
|
||||
Binary => 1,
|
||||
},
|
||||
EmbeddedPNG => {
|
||||
Groups => { 2 => 'Preview' },
|
||||
Binary => 1,
|
||||
},
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Extract EXIF information from a BMP image
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
||||
# Returns: 1 on success, 0 if this wasn't a valid BMP file
|
||||
sub ProcessBMP($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my ($buff, $tagTablePtr);
|
||||
|
||||
# verify this is a valid BMP file
|
||||
return 0 unless $raf->Read($buff, 18) == 18;
|
||||
return 0 unless $buff =~ /^BM/;
|
||||
SetByteOrder('II');
|
||||
my $len = Get32u(\$buff, 14);
|
||||
# len = v1:12, v4:108, v5:124
|
||||
return 0 unless $len == 12 or $len == 16 or ($len >= 40 and $len < 1000000);
|
||||
return 0 unless $raf->Seek(-4, 1) and $raf->Read($buff, $len) == $len;
|
||||
$et->SetFileType(); # set the FileType tag
|
||||
#
|
||||
# process the BMP header
|
||||
#
|
||||
my %dirInfo = (
|
||||
DataPt => \$buff,
|
||||
DirStart => 0,
|
||||
DirLen => length($buff),
|
||||
);
|
||||
if ($len == 12 or $len == 16 or $len == 64) { # old OS/2 format BMP
|
||||
$tagTablePtr = GetTagTable('Image::ExifTool::BMP::OS2');
|
||||
} else {
|
||||
$tagTablePtr = GetTagTable('Image::ExifTool::BMP::Main');
|
||||
}
|
||||
$et->ProcessDirectory(\%dirInfo, $tagTablePtr);
|
||||
#
|
||||
# extract any embedded images
|
||||
#
|
||||
my $extraTable = GetTagTable('Image::ExifTool::BMP::Extra');
|
||||
if ($$et{BMPCompression} and $$et{BMPImageLength} and
|
||||
($$et{BMPCompression} == 4 or $$et{BMPCompression} == 5))
|
||||
{
|
||||
my $tag = $$et{BMPCompression} == 4 ? 'EmbeddedJPG' : 'EmbeddedPNG';
|
||||
my $val = $et->ExtractBinary($raf->Tell(), $$et{BMPImageLength}, $tag);
|
||||
if ($val) {
|
||||
$et->HandleTag($extraTable, $tag, $val);
|
||||
}
|
||||
}
|
||||
#
|
||||
# process profile data if it exists (v5 header only)
|
||||
#
|
||||
if ($len == 124 and $$et{BMPProfileOffset}) {
|
||||
my $pos = $$et{BMPProfileOffset} + 14; # (note the 14-byte shift!)
|
||||
my $size = $$et{BMPProfileSize};
|
||||
if ($raf->Seek($pos, 0) and $raf->Read($buff, $size) == $size) {
|
||||
my $tag;
|
||||
if ($$et{BMPColorSpace} eq 'LINK') {
|
||||
$buff =~ s/\0+$//; # remove null terminator(s)
|
||||
$buff = $et->Decode($buff, 'Latin'); # convert from Latin
|
||||
$tag = 'LinkedProfileName';
|
||||
} else {
|
||||
$tag = 'ICC_Profile';
|
||||
}
|
||||
$et->HandleTag($extraTable, $tag => $buff, Size => $size, DataPos => $pos);
|
||||
} else {
|
||||
$et->Warn('Error loading profile data', 1);
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::BMP - Read BMP meta information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to read BMP
|
||||
(Windows Bitmap) images.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://www.fortunecity.com/skyscraper/windows/364/bmpffrmt.html>
|
||||
|
||||
=item L<http://www.fourcc.org/rgb.php>
|
||||
|
||||
=item L<https://msdn.microsoft.com/en-us/library/dd183381(v=vs.85).aspx>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/BMP Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,251 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: BPG.pm
|
||||
#
|
||||
# Description: Read BPG meta information
|
||||
#
|
||||
# Revisions: 2016-07-05 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://bellard.org/bpg/
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::BPG;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.00';
|
||||
|
||||
# BPG information
|
||||
%Image::ExifTool::BPG::Main = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
|
||||
NOTES => q{
|
||||
The information listed below is extracted from BPG (Better Portable
|
||||
Graphics) images. See L<http://bellard.org/bpg/> for the specification.
|
||||
},
|
||||
4 => {
|
||||
Name => 'PixelFormat',
|
||||
Format => 'int16u',
|
||||
Mask => 0xe000,
|
||||
PrintConv => {
|
||||
0x0000 => 'Grayscale',
|
||||
0x2000 => '4:2:0 (chroma at 0.5, 0.5)',
|
||||
0x4000 => '4:2:2 (chroma at 0.5, 0)',
|
||||
0x6000 => '4:4:4',
|
||||
0x8000 => '4:2:0 (chroma at 0, 0.5)',
|
||||
0xa000 => '4:2:2 (chroma at 0, 0)',
|
||||
},
|
||||
},
|
||||
4.1 => {
|
||||
Name => 'Alpha',
|
||||
Format => 'int16u',
|
||||
Mask => 0x1004,
|
||||
PrintConv => {
|
||||
0x0000 => 'No Alpha Plane',
|
||||
0x1000 => 'Alpha Exists (color not premultiplied)',
|
||||
0x1004 => 'Alpha Exists (color premultiplied)',
|
||||
0x0004 => 'Alpha Exists (W color component)',
|
||||
},
|
||||
},
|
||||
4.2 => {
|
||||
Name => 'BitDepth',
|
||||
Format => 'int16u',
|
||||
Mask => 0x0f00,
|
||||
ValueConv => '($val >> 8) + 8',
|
||||
},
|
||||
4.3 => {
|
||||
Name => 'ColorSpace',
|
||||
Format => 'int16u',
|
||||
Mask => 0x00f0,
|
||||
PrintConv => {
|
||||
0x0000 => 'YCbCr (BT 601)',
|
||||
0x0010 => 'RGB',
|
||||
0x0020 => 'YCgCo',
|
||||
0x0030 => 'YCbCr (BT 709)',
|
||||
0x0040 => 'YCbCr (BT 2020)',
|
||||
0x0050 => 'BT 2020 Constant Luminance',
|
||||
},
|
||||
},
|
||||
4.4 => {
|
||||
Name => 'Flags',
|
||||
Format => 'int16u',
|
||||
Mask => 0x000b,
|
||||
PrintConv => { BITMASK => {
|
||||
0 => 'Animation',
|
||||
1 => 'Limited Range',
|
||||
3 => 'Extension Present',
|
||||
}},
|
||||
},
|
||||
6 => { Name => 'ImageWidth', Format => 'var_ue7' },
|
||||
7 => { Name => 'ImageHeight', Format => 'var_ue7' },
|
||||
# length of image data or 0 to EOF
|
||||
# (must be decoded so we know where the extension data starts)
|
||||
8 => { Name => 'ImageLength', Format => 'var_ue7' },
|
||||
);
|
||||
|
||||
%Image::ExifTool::BPG::Extensions = (
|
||||
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
|
||||
VARS => { ALPHA_FIRST => 1 },
|
||||
1 => {
|
||||
Name => 'EXIF',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::Exif::Main',
|
||||
ProcessProc => \&Image::ExifTool::ProcessTIFF,
|
||||
},
|
||||
},
|
||||
2 => {
|
||||
Name => 'ICC_Profile',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main' },
|
||||
},
|
||||
3 => {
|
||||
Name => 'XMP',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
|
||||
},
|
||||
4 => {
|
||||
Name => 'ThumbnailBPG',
|
||||
Binary => 1,
|
||||
},
|
||||
5 => {
|
||||
Name => 'AnimationControl',
|
||||
Binary => 1,
|
||||
Unknown => 1,
|
||||
},
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Get ue7 integer from binary data (max 32 bits)
|
||||
# Inputs: 0) data ref, 1) location in data (undef for 0)
|
||||
# Returns: 0) ue7 as integer or undef on error, 1) length of ue7 in bytes
|
||||
sub Get_ue7($;$)
|
||||
{
|
||||
my $dataPt = shift;
|
||||
my $pos = shift || 0;
|
||||
my $size = length $$dataPt;
|
||||
my $val = 0;
|
||||
my $i;
|
||||
for ($i=0; ; ) {
|
||||
return() if $pos+$i >= $size or $i >= 5;
|
||||
my $byte = Get8u($dataPt, $pos + $i);
|
||||
$val = ($val << 7) | ($byte & 0x7f);
|
||||
unless ($byte & 0x80) {
|
||||
return() if $i == 4 and $byte & 0x70; # error if bits 32-34 are set
|
||||
last; # this was the last byte
|
||||
}
|
||||
return() if $i == 0 and $byte == 0x80; # error if first byte is 0x80
|
||||
++$i; # step to the next byte
|
||||
}
|
||||
return($val, $i+1);
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Extract EXIF information from a BPG image
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
||||
# Returns: 1 on success, 0 if this wasn't a valid BPG file
|
||||
sub ProcessBPG($$)
|
||||
{
|
||||
local $_;
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my ($buff, $size, $n, $len, $pos);
|
||||
|
||||
# verify this is a valid BPG file
|
||||
return 0 unless $raf->Read($buff, 21) == 21; # (21 bytes is maximum header length)
|
||||
return 0 unless $buff =~ /^BPG\xfb/;
|
||||
$et->SetFileType(); # set the FileType tag
|
||||
|
||||
SetByteOrder('MM');
|
||||
my %dirInfo = (
|
||||
DataPt => \$buff,
|
||||
DirStart => 0,
|
||||
DirLen => length($buff),
|
||||
VarFormatData => [ ],
|
||||
);
|
||||
$et->ProcessDirectory(\%dirInfo, GetTagTable('Image::ExifTool::BPG::Main'));
|
||||
|
||||
return 1 unless $$et{VALUE}{Flags} & 0x0008; # all done unless extension flag is set
|
||||
|
||||
# add varSize from last entry in VarFormatData to determine
|
||||
# the current read position in the file
|
||||
my $dataPos = 9 + $dirInfo{VarFormatData}[-1][1];
|
||||
# read extension length
|
||||
unless ($raf->Seek($dataPos, 0) and $raf->Read($buff, 5) == 5) {
|
||||
$et->Warn('Missing BPG extension data');
|
||||
return 1;
|
||||
}
|
||||
($size, $n) = Get_ue7(\$buff);
|
||||
defined $size or $et->Warn('Corrupted BPG extension length'), return 1;
|
||||
$dataPos += $n;
|
||||
$size > 10000000 and $et->Warn('BPG extension is too large'), return 1;
|
||||
unless ($raf->Seek($dataPos, 0) and $raf->Read($buff, $size) == $size) {
|
||||
$et->Warn('Truncated BPG extension');
|
||||
return 1;
|
||||
}
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::BPG::Extensions');
|
||||
# loop through the individual extensions
|
||||
for ($pos=0; $pos<$size; $pos+=$len) {
|
||||
my $type = Get8u(\$buff, $pos);
|
||||
# get length of this extension
|
||||
($len, $n) = Get_ue7(\$buff, ++$pos);
|
||||
defined $len or $et->Warn('Corrupted BPG extension'), last;
|
||||
$pos += $n; # point to start of data for this extension
|
||||
$pos + $len > $size and $et->Warn('Invalid BPG extension size'), last;
|
||||
$$tagTablePtr{$type} or $et->Warn("Unrecognized BPG extension $type ($len bytes)", 1), next;
|
||||
# libbpg (in my opinion) incorrectly copies the padding byte after the
|
||||
# "EXIF\0" APP1 header to the start of the BPG EXIF extension, so issue a
|
||||
# minor warning and ignore the padding if we find it before the TIFF header
|
||||
if ($type == 1 and $len > 3 and substr($buff,$pos,3)=~/^.(II|MM)/s) {
|
||||
$et->Warn("Ignored extra byte at start of EXIF extension", 1);
|
||||
++$pos;
|
||||
--$len;
|
||||
}
|
||||
$et->HandleTag($tagTablePtr, $type, undef,
|
||||
DataPt => \$buff,
|
||||
DataPos => $dataPos,
|
||||
Start => $pos,
|
||||
Size => $len,
|
||||
Parent => 'BPG',
|
||||
);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::BPG - Read BPG meta information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to read BPG
|
||||
(Better Portable Graphics) images.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://bellard.org/bpg/>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/BPG Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,472 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: BZZ.pm
|
||||
#
|
||||
# Description: Utility to decode BZZ compressed data
|
||||
#
|
||||
# Revisions: 09/22/2008 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://djvu.sourceforge.net/
|
||||
# 2) http://www.djvu.org/
|
||||
#
|
||||
# Notes: This code based on ZPCodec and BSByteStream of DjVuLibre 3.5.21
|
||||
# (see NOTES documentation below for license/copyright details)
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::BZZ;
|
||||
|
||||
use strict;
|
||||
use integer; # IMPORTANT!! use integer arithmetic throughout
|
||||
require Exporter;
|
||||
use vars qw($VERSION @ISA @EXPORT_OK);
|
||||
|
||||
$VERSION = '1.00';
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT_OK = qw(Decode);
|
||||
|
||||
# constants
|
||||
sub FREQMAX { 4 }
|
||||
sub CTXIDS { 3 }
|
||||
sub MAXBLOCK { 4096 }
|
||||
|
||||
# This table has been designed for the ZPCoder
|
||||
# by running the following command in file 'zptable.sn':
|
||||
# (fast-crude (steady-mat 0.0035 0.0002) 260)))
|
||||
my @default_ztable_p = (
|
||||
0x8000, 0x8000, 0x8000, 0x6bbd, 0x6bbd, 0x5d45, 0x5d45, 0x51b9, 0x51b9, 0x4813,
|
||||
0x4813, 0x3fd5, 0x3fd5, 0x38b1, 0x38b1, 0x3275, 0x3275, 0x2cfd, 0x2cfd, 0x2825,
|
||||
0x2825, 0x23ab, 0x23ab, 0x1f87, 0x1f87, 0x1bbb, 0x1bbb, 0x1845, 0x1845, 0x1523,
|
||||
0x1523, 0x1253, 0x1253, 0x0fcf, 0x0fcf, 0x0d95, 0x0d95, 0x0b9d, 0x0b9d, 0x09e3,
|
||||
0x09e3, 0x0861, 0x0861, 0x0711, 0x0711, 0x05f1, 0x05f1, 0x04f9, 0x04f9, 0x0425,
|
||||
0x0425, 0x0371, 0x0371, 0x02d9, 0x02d9, 0x0259, 0x0259, 0x01ed, 0x01ed, 0x0193,
|
||||
0x0193, 0x0149, 0x0149, 0x010b, 0x010b, 0x00d5, 0x00d5, 0x00a5, 0x00a5, 0x007b,
|
||||
0x007b, 0x0057, 0x0057, 0x003b, 0x003b, 0x0023, 0x0023, 0x0013, 0x0013, 0x0007,
|
||||
0x0007, 0x0001, 0x0001, 0x5695, 0x24ee, 0x8000, 0x0d30, 0x481a, 0x0481, 0x3579,
|
||||
0x017a, 0x24ef, 0x007b, 0x1978, 0x0028, 0x10ca, 0x000d, 0x0b5d, 0x0034, 0x078a,
|
||||
0x00a0, 0x050f, 0x0117, 0x0358, 0x01ea, 0x0234, 0x0144, 0x0173, 0x0234, 0x00f5,
|
||||
0x0353, 0x00a1, 0x05c5, 0x011a, 0x03cf, 0x01aa, 0x0285, 0x0286, 0x01ab, 0x03d3,
|
||||
0x011a, 0x05c5, 0x00ba, 0x08ad, 0x007a, 0x0ccc, 0x01eb, 0x1302, 0x02e6, 0x1b81,
|
||||
0x045e, 0x24ef, 0x0690, 0x2865, 0x09de, 0x3987, 0x0dc8, 0x2c99, 0x10ca, 0x3b5f,
|
||||
0x0b5d, 0x5695, 0x078a, 0x8000, 0x050f, 0x24ee, 0x0358, 0x0d30, 0x0234, 0x0481,
|
||||
0x0173, 0x017a, 0x00f5, 0x007b, 0x00a1, 0x0028, 0x011a, 0x000d, 0x01aa, 0x0034,
|
||||
0x0286, 0x00a0, 0x03d3, 0x0117, 0x05c5, 0x01ea, 0x08ad, 0x0144, 0x0ccc, 0x0234,
|
||||
0x1302, 0x0353, 0x1b81, 0x05c5, 0x24ef, 0x03cf, 0x2b74, 0x0285, 0x201d, 0x01ab,
|
||||
0x1715, 0x011a, 0x0fb7, 0x00ba, 0x0a67, 0x01eb, 0x06e7, 0x02e6, 0x0496, 0x045e,
|
||||
0x030d, 0x0690, 0x0206, 0x09de, 0x0155, 0x0dc8, 0x00e1, 0x2b74, 0x0094, 0x201d,
|
||||
0x0188, 0x1715, 0x0252, 0x0fb7, 0x0383, 0x0a67, 0x0547, 0x06e7, 0x07e2, 0x0496,
|
||||
0x0bc0, 0x030d, 0x1178, 0x0206, 0x19da, 0x0155, 0x24ef, 0x00e1, 0x320e, 0x0094,
|
||||
0x432a, 0x0188, 0x447d, 0x0252, 0x5ece, 0x0383, 0x8000, 0x0547, 0x481a, 0x07e2,
|
||||
0x3579, 0x0bc0, 0x24ef, 0x1178, 0x1978, 0x19da, 0x2865, 0x24ef, 0x3987, 0x320e,
|
||||
0x2c99, 0x432a, 0x3b5f, 0x447d, 0x5695, 0x5ece, 0x8000, 0x8000, 0x5695, 0x481a,
|
||||
0x481a, 0, 0, 0, 0, 0
|
||||
);
|
||||
my @default_ztable_m = (
|
||||
0x0000, 0x0000, 0x0000, 0x10a5, 0x10a5, 0x1f28, 0x1f28, 0x2bd3, 0x2bd3, 0x36e3,
|
||||
0x36e3, 0x408c, 0x408c, 0x48fd, 0x48fd, 0x505d, 0x505d, 0x56d0, 0x56d0, 0x5c71,
|
||||
0x5c71, 0x615b, 0x615b, 0x65a5, 0x65a5, 0x6962, 0x6962, 0x6ca2, 0x6ca2, 0x6f74,
|
||||
0x6f74, 0x71e6, 0x71e6, 0x7404, 0x7404, 0x75d6, 0x75d6, 0x7768, 0x7768, 0x78c2,
|
||||
0x78c2, 0x79ea, 0x79ea, 0x7ae7, 0x7ae7, 0x7bbe, 0x7bbe, 0x7c75, 0x7c75, 0x7d0f,
|
||||
0x7d0f, 0x7d91, 0x7d91, 0x7dfe, 0x7dfe, 0x7e5a, 0x7e5a, 0x7ea6, 0x7ea6, 0x7ee6,
|
||||
0x7ee6, 0x7f1a, 0x7f1a, 0x7f45, 0x7f45, 0x7f6b, 0x7f6b, 0x7f8d, 0x7f8d, 0x7faa,
|
||||
0x7faa, 0x7fc3, 0x7fc3, 0x7fd7, 0x7fd7, 0x7fe7, 0x7fe7, 0x7ff2, 0x7ff2, 0x7ffa,
|
||||
0x7ffa, 0x7fff, 0x7fff, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
||||
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
|
||||
);
|
||||
my @default_ztable_up = (
|
||||
84, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17,
|
||||
18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33,
|
||||
34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49,
|
||||
50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65,
|
||||
66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81,
|
||||
82, 81, 82, 9, 86, 5, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97,
|
||||
82, 99, 76, 101, 70, 103, 66, 105, 106, 107, 66, 109, 60, 111, 56, 69,
|
||||
114, 65, 116, 61, 118, 57, 120, 53, 122, 49, 124, 43, 72, 39, 60, 33,
|
||||
56, 29, 52, 23, 48, 23, 42, 137, 38, 21, 140, 15, 142, 9, 144, 141,
|
||||
146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 70, 157, 66, 81, 62, 75,
|
||||
58, 69, 54, 65, 50, 167, 44, 65, 40, 59, 34, 55, 30, 175, 24, 177,
|
||||
178, 179, 180, 181, 182, 183, 184, 69, 186, 59, 188, 55, 190, 51, 192, 47,
|
||||
194, 41, 196, 37, 198, 199, 72, 201, 62, 203, 58, 205, 54, 207, 50, 209,
|
||||
46, 211, 40, 213, 36, 215, 30, 217, 26, 219, 20, 71, 14, 61, 14, 57,
|
||||
8, 53, 228, 49, 230, 45, 232, 39, 234, 35, 138, 29, 24, 25, 240, 19,
|
||||
22, 13, 16, 13, 10, 7, 244, 249, 10, 89, 230, 0, 0, 0, 0, 0
|
||||
);
|
||||
my @default_ztable_dn = (
|
||||
145, 4, 3, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,
|
||||
14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
|
||||
30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,
|
||||
46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61,
|
||||
62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77,
|
||||
78, 79, 80, 85, 226, 6, 176, 143, 138, 141, 112, 135, 104, 133, 100, 129,
|
||||
98, 127, 72, 125, 102, 123, 60, 121, 110, 119, 108, 117, 54, 115, 48, 113,
|
||||
134, 59, 132, 55, 130, 51, 128, 47, 126, 41, 62, 37, 66, 31, 54, 25,
|
||||
50, 131, 46, 17, 40, 15, 136, 7, 32, 139, 172, 9, 170, 85, 168, 248,
|
||||
166, 247, 164, 197, 162, 95, 160, 173, 158, 165, 156, 161, 60, 159, 56, 71,
|
||||
52, 163, 48, 59, 42, 171, 38, 169, 32, 53, 26, 47, 174, 193, 18, 191,
|
||||
222, 189, 218, 187, 216, 185, 214, 61, 212, 53, 210, 49, 208, 45, 206, 39,
|
||||
204, 195, 202, 31, 200, 243, 64, 239, 56, 237, 52, 235, 48, 233, 44, 231,
|
||||
38, 229, 34, 227, 28, 225, 22, 223, 16, 221, 220, 63, 8, 55, 224, 51,
|
||||
2, 47, 87, 43, 246, 37, 244, 33, 238, 27, 236, 21, 16, 15, 8, 241,
|
||||
242, 7, 10, 245, 2, 1, 83, 250, 2, 143, 246, 0, 0, 0, 0, 0
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# New - create new BZZ object
|
||||
# Inputs: 0) reference to BZZ object or BZZ class name
|
||||
# Returns: blessed BZZ object ref
|
||||
sub new
|
||||
{
|
||||
local $_;
|
||||
my $that = shift;
|
||||
my $class = ref($that) || $that || 'Image::ExifTool::BZZ';
|
||||
return bless {}, $class;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Initialize BZZ object
|
||||
# Inputs: 0) BZZ object ref, 1) data ref, 2) true for DjVu compatibility
|
||||
sub Init($$)
|
||||
{
|
||||
my ($self, $dataPt, $djvucompat) = @_;
|
||||
# Create machine independent ffz table
|
||||
my $ffzt = $$self{ffzt} = [ ];
|
||||
my ($i, $j);
|
||||
for ($i=0; $i<256; $i++) {
|
||||
$$ffzt[$i] = 0;
|
||||
for ($j=$i; $j&0x80; $j<<=1) {
|
||||
$$ffzt[$i] += 1;
|
||||
}
|
||||
}
|
||||
# Initialize table
|
||||
$$self{p} = [ @default_ztable_p ];
|
||||
$$self{'m'} = [ @default_ztable_m ];
|
||||
$$self{up} = [ @default_ztable_up ];
|
||||
$$self{dn} = [ @default_ztable_dn ];
|
||||
# Patch table (and lose DjVu compatibility)
|
||||
unless ($djvucompat) {
|
||||
my ($p, $m, $dn) = ($$self{p}, $$self{'m'}, $$self{dn});
|
||||
for ($j=0; $j<256; $j++) {
|
||||
my $a = (0x10000 - $$p[$j]) & 0xffff;
|
||||
while ($a >= 0x8000) { $a = ($a<<1) & 0xffff }
|
||||
if ($$m[$j]>0 && $a+$$p[$j]>=0x8000 && $a>=$$m[$j]) {
|
||||
$$dn[$j] = $default_ztable_dn[$default_ztable_dn[$j]];
|
||||
}
|
||||
}
|
||||
}
|
||||
$$self{ctx} = [ (0) x 300 ];
|
||||
$$self{DataPt} = $dataPt;
|
||||
$$self{Pos} = 0;
|
||||
$$self{DataLen} = length $$dataPt;
|
||||
$$self{a} = 0;
|
||||
$$self{buffer} = 0;
|
||||
$$self{fence} = 0;
|
||||
$$self{blocksize} = 0;
|
||||
# Read first 16 bits of code
|
||||
if (length($$dataPt) >= 2) {
|
||||
$$self{code} = unpack('n', $$dataPt);
|
||||
$$self{Pos} += 2;
|
||||
} elsif (length($$dataPt) >= 1) {
|
||||
$$self{code} = (unpack('C', $$dataPt) << 8) | 0xff;
|
||||
$$self{Pos}++;
|
||||
} else {
|
||||
$$self{code} = 0xffff;
|
||||
}
|
||||
$$self{byte} = $$self{code} & 0xff;
|
||||
# Preload buffer
|
||||
$$self{delay} = 25;
|
||||
$$self{scount} = 0;
|
||||
# Compute initial fence
|
||||
$$self{fence} = $$self{code} >= 0x8000 ? 0x7fff : $$self{code};
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Decode data block
|
||||
# Inputs: 0) optional BZZ object ref, 1) optional data ref
|
||||
# Returns: decoded data or undefined on error
|
||||
# Notes: If called without a data ref, an input BZZ object ref must be given and
|
||||
# the BZZ object must have been initialized by a previous call to Init()
|
||||
sub Decode($;$)
|
||||
{
|
||||
# Decode input stream
|
||||
local $_;
|
||||
my $self;
|
||||
if (ref $_[0] and UNIVERSAL::isa($_[0],'Image::ExifTool::BZZ')) {
|
||||
$self = shift;
|
||||
} else {
|
||||
$self = new Image::ExifTool::BZZ;
|
||||
}
|
||||
my $dataPt = shift;
|
||||
if ($dataPt) {
|
||||
$self->Init($dataPt, 1);
|
||||
} else {
|
||||
$dataPt = $$self{DataPt} or return undef;
|
||||
}
|
||||
# Decode block size
|
||||
my $n = 1;
|
||||
my $m = (1 << 24);
|
||||
while ($n < $m) {
|
||||
my $b = $self->decode_sub(0x8000 + ($$self{a}>>1));
|
||||
$n = ($n<<1) | $b;
|
||||
}
|
||||
$$self{size} = $n - $m;
|
||||
|
||||
return '' unless $$self{size};
|
||||
return undef if $$self{size} > MAXBLOCK()*1024;
|
||||
# Allocate
|
||||
if ($$self{blocksize} < $$self{size}) {
|
||||
$$self{blocksize} = $$self{size};
|
||||
}
|
||||
# Decode Estimation Speed
|
||||
my $fshift = 0;
|
||||
if ($self->decode_sub(0x8000 + ($$self{a}>>1))) {
|
||||
$fshift += 1;
|
||||
$fshift += 1 if $self->decode_sub(0x8000 + ($$self{a}>>1));
|
||||
}
|
||||
# Prepare Quasi MTF
|
||||
my @mtf = (0..255);
|
||||
my @freq = (0) x FREQMAX();
|
||||
my $fadd = 4;
|
||||
# Decode
|
||||
my $mtfno = 3;
|
||||
my $markerpos = -1;
|
||||
my $cx = $$self{ctx};
|
||||
my ($i, @dat);
|
||||
byte: for ($i=0; $i<$$self{size}; $i++) {
|
||||
# dummy loop avoids use of "goto" statement
|
||||
dummy: for (;;) {
|
||||
my $ctxid = CTXIDS() - 1;
|
||||
$ctxid = $mtfno if $ctxid > $mtfno;
|
||||
my $cp = 0;
|
||||
my ($imtf, $bits);
|
||||
for ($imtf=0; $imtf<2; ++$imtf) {
|
||||
if ($self->decoder($$cx[$cp+$ctxid])) {
|
||||
$mtfno = $imtf;
|
||||
$dat[$i] = $mtf[$mtfno];
|
||||
# (a "goto" here could give a segfault due to a Perl bug)
|
||||
last dummy; # do rotation
|
||||
}
|
||||
$cp += CTXIDS();
|
||||
}
|
||||
for ($bits=1; $bits<8; ++$bits, $imtf<<=1) {
|
||||
if ($self->decoder($$cx[$cp])) {
|
||||
my $n = 1;
|
||||
my $m = (1 << $bits);
|
||||
while ($n < $m) {
|
||||
my $b = $self->decoder($$cx[$cp+$n]);
|
||||
$n = ($n<<1) | $b;
|
||||
}
|
||||
$mtfno = $imtf + $n - $m;
|
||||
$dat[$i] = $mtf[$mtfno];
|
||||
last dummy; # do rotation
|
||||
}
|
||||
$cp += $imtf;
|
||||
}
|
||||
$mtfno=256;
|
||||
$dat[$i] = 0;
|
||||
$markerpos=$i;
|
||||
next byte; # no rotation necessary
|
||||
}
|
||||
# Rotate mtf according to empirical frequencies (new!)
|
||||
# Adjust frequencies for overflow
|
||||
$fadd = $fadd + ($fadd >> $fshift);
|
||||
if ($fadd > 0x10000000) {
|
||||
$fadd >>= 24;
|
||||
$_ >>= 24 foreach @freq;
|
||||
}
|
||||
# Relocate new char according to new freq
|
||||
my $fc = $fadd;
|
||||
$fc += $freq[$mtfno] if $mtfno < FREQMAX();
|
||||
my $k;
|
||||
for ($k=$mtfno; $k>=FREQMAX(); $k--) {
|
||||
$mtf[$k] = $mtf[$k-1];
|
||||
}
|
||||
for (; $k>0 && $fc>=$freq[$k-1]; $k--) {
|
||||
$mtf[$k] = $mtf[$k-1];
|
||||
$freq[$k] = $freq[$k-1];
|
||||
}
|
||||
$mtf[$k] = $dat[$i];
|
||||
$freq[$k] = $fc;
|
||||
# when "goto" was used, Perl 5.8.6 could segfault here
|
||||
# unless "next" was explicitly stated
|
||||
}
|
||||
#
|
||||
# Reconstruct the string
|
||||
#
|
||||
return undef if $markerpos<1 || $markerpos>=$$self{size};
|
||||
# Allocate pointers
|
||||
# Prepare count buffer
|
||||
my @count = (0) x 256;
|
||||
my @posn;
|
||||
# Fill count buffer
|
||||
no integer;
|
||||
for ($i=0; $i<$markerpos; $i++) {
|
||||
my $c = $dat[$i];
|
||||
$posn[$i] = ($c<<24) | ($count[$c]++ & 0xffffff);
|
||||
}
|
||||
$posn[$i++] = 0; # (initialize marker entry just to be safe)
|
||||
for ( ; $i<$$self{size}; $i++) {
|
||||
my $c = $dat[$i];
|
||||
$posn[$i] = ($c<<24) | ($count[$c]++ & 0xffffff);
|
||||
}
|
||||
use integer;
|
||||
# Compute sorted char positions
|
||||
my $last = 1;
|
||||
for ($i=0; $i<256; $i++) {
|
||||
my $tmp = $count[$i];
|
||||
$count[$i] = $last;
|
||||
$last += $tmp;
|
||||
}
|
||||
# Undo the sort transform
|
||||
$i = 0;
|
||||
$last = $$self{size}-1;
|
||||
while ($last > 0) {
|
||||
my $n = $posn[$i];
|
||||
no integer;
|
||||
my $c = $n >> 24;
|
||||
use integer;
|
||||
$dat[--$last] = $c;
|
||||
$i = $count[$c] + ($n & 0xffffff);
|
||||
}
|
||||
# Final check and return decoded data
|
||||
return undef if $i != $markerpos;
|
||||
pop @dat; # (last byte isn't real)
|
||||
return pack 'C*', @dat;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Inputs: 0) BZZ object ref, 1) ctx
|
||||
# Returns: decoded bit
|
||||
sub decoder($$)
|
||||
{
|
||||
my ($self, $ctx) = @_;
|
||||
my $z = $$self{a} + $self->{p}[$ctx];
|
||||
if ($z <= $$self{fence}) {
|
||||
$$self{a} = $z;
|
||||
return ($ctx & 1);
|
||||
}
|
||||
# must pass $_[1] so subroutine can modify value (darned C++ pass-by-reference!)
|
||||
return $self->decode_sub($z, $_[1]);
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Inputs: 0) BZZ object ref, 1) z, 2) ctx (or undef)
|
||||
# Returns: decoded bit
|
||||
sub decode_sub($$;$)
|
||||
{
|
||||
my ($self, $z, $ctx) = @_;
|
||||
|
||||
# ensure that we have at least 16 bits of encoded data available
|
||||
if ($$self{scount} < 16) {
|
||||
# preload byte by byte until we have at least 24 bits
|
||||
while ($$self{scount} <= 24) {
|
||||
if ($$self{Pos} < $$self{DataLen}) {
|
||||
$$self{byte} = ord(substr(${$$self{DataPt}}, $$self{Pos}, 1));
|
||||
++$$self{Pos};
|
||||
} else {
|
||||
$$self{byte} = 0xff;
|
||||
if (--$$self{delay} < 1) {
|
||||
# setting size to zero forces error return from Decode()
|
||||
$$self{size} = 0;
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
$$self{buffer} = ($$self{buffer}<<8) | $$self{byte};
|
||||
$$self{scount} += 8;
|
||||
}
|
||||
}
|
||||
# Save bit
|
||||
my $a = $$self{a};
|
||||
my ($bit, $code);
|
||||
if (defined $ctx) {
|
||||
$bit = ($ctx & 1);
|
||||
# Avoid interval reversion
|
||||
my $d = 0x6000 + (($z+$a)>>2);
|
||||
$z = $d if $z > $d;
|
||||
} else {
|
||||
$bit = 0;
|
||||
}
|
||||
# Test MPS/LPS
|
||||
if ($z > ($code = $$self{code})) {
|
||||
$bit ^= 1;
|
||||
# LPS branch
|
||||
$z = 0x10000 - $z;
|
||||
$a += $z;
|
||||
$code += $z;
|
||||
# LPS adaptation
|
||||
$_[2] = $self->{dn}[$ctx] if defined $ctx;
|
||||
# LPS renormalization
|
||||
my $sft = $a>=0xff00 ? $self->{ffzt}[$a&0xff] + 8 : $self->{ffzt}[($a>>8)&0xff];
|
||||
$$self{scount} -= $sft;
|
||||
$$self{a} = ($a<<$sft) & 0xffff;
|
||||
$code = (($code<<$sft) & 0xffff) | (($$self{buffer}>>$$self{scount}) & ((1<<$sft)-1));
|
||||
} else {
|
||||
# MPS adaptation
|
||||
$_[2] = $self->{up}[$ctx] if defined $ctx and $a >= $self->{'m'}[$ctx];
|
||||
# MPS renormalization
|
||||
$$self{scount} -= 1;
|
||||
$$self{a} = ($z<<1) & 0xffff;
|
||||
$code = (($code<<1) & 0xffff) | (($$self{buffer}>>$$self{scount}) & 1);
|
||||
}
|
||||
# Adjust fence and save new code
|
||||
$$self{fence} = $code >= 0x8000 ? 0x7fff : $code;
|
||||
$$self{code} = $code;
|
||||
return $bit;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::BZZ - Utility to decode BZZ compressed data
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to decode BZZ
|
||||
compressed data in DjVu images.
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
This code is based on ZPCodec and BSByteStream of DjVuLibre 3.5.21 (see
|
||||
additional copyrights and the first reference below), which are covered
|
||||
under the GNU GPL license.
|
||||
|
||||
This is implemented as Image::ExifTool::BZZ instead of Compress::BZZ because
|
||||
I am hoping that someone else will write a proper Compress::BZZ module (with
|
||||
compression ability).
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
Copyright 2002, Leon Bottou and Yann Le Cun
|
||||
Copyright 2001, AT&T
|
||||
Copyright 1999-2001, LizardTech Inc.
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://djvu.sourceforge.net/>
|
||||
|
||||
=item L<http://www.djvu.org/>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::DjVu(3pm)|Image::ExifTool::DjVu>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,282 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: BigTIFF.pm
|
||||
#
|
||||
# Description: Read Big TIFF meta information
|
||||
#
|
||||
# Revisions: 07/03/2007 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://www.awaresystems.be/imaging/tiff/bigtiff.html
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::BigTIFF;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
use Image::ExifTool::Exif;
|
||||
|
||||
$VERSION = '1.06';
|
||||
|
||||
my $maxOffset = 0x7fffffff; # currently supported maximum data offset/size
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process Big IFD directory
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: 1 on success, otherwise returns 0 and sets a Warning
|
||||
sub ProcessBigIFD($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $verbose = $$et{OPTIONS}{Verbose};
|
||||
my $htmlDump = $$et{HTML_DUMP};
|
||||
my $dirName = $$dirInfo{DirName};
|
||||
my $dirStart = $$dirInfo{DirStart};
|
||||
|
||||
$verbose = -1 if $htmlDump; # mix htmlDump into verbose so we can test for both at once
|
||||
|
||||
# loop through IFD chain
|
||||
for (;;) {
|
||||
if ($dirStart > $maxOffset and not $et->Options('LargeFileSupport')) {
|
||||
$et->Warn('Huge offsets not supported (LargeFileSupport not set)');
|
||||
last;
|
||||
}
|
||||
unless ($raf->Seek($dirStart, 0)) {
|
||||
$et->Warn("Bad $dirName offset");
|
||||
return 0;
|
||||
}
|
||||
my ($dirBuff, $index);
|
||||
unless ($raf->Read($dirBuff, 8) == 8) {
|
||||
$et->Warn("Truncated $dirName count");
|
||||
return 0;
|
||||
}
|
||||
my $numEntries = Image::ExifTool::Get64u(\$dirBuff, 0);
|
||||
$verbose > 0 and $et->VerboseDir($dirName, $numEntries);
|
||||
my $bsize = $numEntries * 20;
|
||||
if ($bsize > $maxOffset) {
|
||||
$et->Warn('Huge directory counts not yet supported');
|
||||
last;
|
||||
}
|
||||
my $bufPos = $raf->Tell();
|
||||
unless ($raf->Read($dirBuff, $bsize) == $bsize) {
|
||||
$et->Warn("Truncated $dirName directory");
|
||||
return 0;
|
||||
}
|
||||
my $nextIFD;
|
||||
$raf->Read($nextIFD, 8) == 8 or undef $nextIFD; # try to read next IFD pointer
|
||||
if ($htmlDump) {
|
||||
$et->HDump($bufPos-8, 8, "$dirName entries", "Entry count: $numEntries");
|
||||
if (defined $nextIFD) {
|
||||
my $tip = sprintf("Offset: 0x%.8x", Image::ExifTool::Get64u(\$nextIFD, 0));
|
||||
$et->HDump($bufPos + 20 * $numEntries, 8, "Next IFD", $tip, 0);
|
||||
}
|
||||
}
|
||||
# loop through all entries in this BigTIFF IFD
|
||||
for ($index=0; $index<$numEntries; ++$index) {
|
||||
my $entry = 20 * $index;
|
||||
my $tagID = Get16u(\$dirBuff, $entry);
|
||||
my $format = Get16u(\$dirBuff, $entry+2);
|
||||
my $count = Image::ExifTool::Get64u(\$dirBuff, $entry+4);
|
||||
my $formatSize = $Image::ExifTool::Exif::formatSize[$format];
|
||||
unless (defined $formatSize) {
|
||||
$et->HDump($bufPos+$entry,20,"[invalid IFD entry]",
|
||||
"Bad format value: $format", 1);
|
||||
# warn unless the IFD was just padded with zeros
|
||||
$et->Warn(sprintf("Unknown format ($format) for $dirName tag 0x%x",$tagID));
|
||||
return 0; # assume corrupted IFD
|
||||
}
|
||||
my $formatStr = $Image::ExifTool::Exif::formatName[$format];
|
||||
my $size = $count * $formatSize;
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tagID);
|
||||
next unless defined $tagInfo or $verbose;
|
||||
my $valuePtr = $entry + 12;
|
||||
my ($valBuff, $valBase, $rational);
|
||||
if ($size > 8) {
|
||||
if ($size > $maxOffset) {
|
||||
$et->Warn("Can't handle $dirName entry $index (huge size)");
|
||||
next;
|
||||
}
|
||||
$valuePtr = Image::ExifTool::Get64u(\$dirBuff, $valuePtr);
|
||||
if ($valuePtr > $maxOffset and not $et->Options('LargeFileSupport')) {
|
||||
$et->Warn("Can't handle $dirName entry $index (LargeFileSupport not set)");
|
||||
next;
|
||||
}
|
||||
unless ($raf->Seek($valuePtr, 0) and $raf->Read($valBuff, $size) == $size) {
|
||||
$et->Warn("Error reading $dirName entry $index");
|
||||
next;
|
||||
}
|
||||
$valBase = 0;
|
||||
} else {
|
||||
$valBuff = substr($dirBuff, $valuePtr, $size);
|
||||
$valBase = $bufPos;
|
||||
}
|
||||
if (defined $tagInfo and not $tagInfo) {
|
||||
# GetTagInfo() required the value for a Condition
|
||||
$tagInfo = $et->GetTagInfo($tagTablePtr, $tagID, \$valBuff);
|
||||
}
|
||||
my $val = ReadValue(\$valBuff, 0, $formatStr, $count, $size, \$rational);
|
||||
if ($htmlDump) {
|
||||
my $tval = $val;
|
||||
# show numerator/denominator separately for rational numbers
|
||||
$tval .= " ($rational)" if defined $rational;
|
||||
my ($tagName, $colName);
|
||||
if ($tagID == 0x927c and $dirName eq 'ExifIFD') {
|
||||
$tagName = 'MakerNotes';
|
||||
} elsif ($tagInfo) {
|
||||
$tagName = $$tagInfo{Name};
|
||||
} else {
|
||||
$tagName = sprintf("Tag 0x%.4x",$tagID);
|
||||
}
|
||||
my $dname = sprintf("$dirName-%.2d", $index);
|
||||
# build our tool tip
|
||||
my $tip = sprintf("Tag ID: 0x%.4x\n", $tagID) .
|
||||
"Format: $formatStr\[$count]\nSize: $size bytes\n";
|
||||
if ($size > 8) {
|
||||
$tip .= sprintf("Value offset: 0x%.8x\n", $valuePtr);
|
||||
$colName = "<span class=H>$tagName</span>";
|
||||
} else {
|
||||
$colName = $tagName;
|
||||
}
|
||||
$tval = substr($tval,0,28) . '[...]' if length($tval) > 32;
|
||||
if ($formatStr =~ /^(string|undef|binary)/) {
|
||||
# translate non-printable characters
|
||||
$tval =~ tr/\x00-\x1f\x7f-\xff/./;
|
||||
} elsif ($tagInfo and Image::ExifTool::IsInt($tval)) {
|
||||
if ($$tagInfo{IsOffset}) {
|
||||
$tval = sprintf('0x%.4x', $tval);
|
||||
} elsif ($$tagInfo{PrintHex}) {
|
||||
$tval = sprintf('0x%x', $tval);
|
||||
}
|
||||
}
|
||||
$tip .= "Value: $tval";
|
||||
$et->HDump($entry+$bufPos, 20, "$dname $colName", $tip, 1);
|
||||
if ($size > 8) {
|
||||
# add value data block
|
||||
my $flg = ($tagInfo and $$tagInfo{SubDirectory} and $$tagInfo{MakerNotes}) ? 4 : 0;
|
||||
$et->HDump($valuePtr,$size,"$tagName value",'SAME', $flg);
|
||||
}
|
||||
}
|
||||
if ($tagInfo and $$tagInfo{SubIFD}) {
|
||||
# process all SubIFD's as BigTIFF
|
||||
$verbose > 0 and $et->VerboseInfo($tagID, $tagInfo,
|
||||
Table => $tagTablePtr,
|
||||
Index => $index,
|
||||
Value => $val,
|
||||
DataPt => \$valBuff,
|
||||
DataPos => $valBase + $valuePtr,
|
||||
Start => 0,
|
||||
Size => $size,
|
||||
Format => $formatStr,
|
||||
Count => $count,
|
||||
);
|
||||
my @offsets = split ' ', $val;
|
||||
my $i;
|
||||
for ($i=0; $i<scalar(@offsets); ++$i) {
|
||||
my $subdirName = $$tagInfo{Name};
|
||||
$subdirName .= $i if $i;
|
||||
my %subdirInfo = (
|
||||
RAF => $raf,
|
||||
DataPos => 0,
|
||||
DirStart => $offsets[$i],
|
||||
DirName => $subdirName,
|
||||
Parent => $dirInfo,
|
||||
);
|
||||
$et->ProcessDirectory(\%subdirInfo, $tagTablePtr, \&ProcessBigIFD);
|
||||
}
|
||||
} else {
|
||||
my $tagKey = $et->HandleTag($tagTablePtr, $tagID, $val,
|
||||
Index => $index,
|
||||
DataPt => \$valBuff,
|
||||
DataPos => $valBase + $valuePtr,
|
||||
Start => 0,
|
||||
Size => $size,
|
||||
Format => $formatStr,
|
||||
TagInfo => $tagInfo,
|
||||
RAF => $raf,
|
||||
);
|
||||
$tagKey and $et->SetGroup($tagKey, $dirName);
|
||||
}
|
||||
}
|
||||
last unless $dirName =~ /^(IFD|SubIFD)(\d*)$/;
|
||||
$dirName = $1 . (($2 || 0) + 1);
|
||||
defined $nextIFD or $et->Warn("Bad $dirName pointer"), return 0;
|
||||
$dirStart = Image::ExifTool::Get64u(\$nextIFD, 0);
|
||||
$dirStart or last;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Extract meta information from a BigTIFF image
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
||||
# Returns: 1 on success, 0 if this wasn't a valid BigTIFF image
|
||||
sub ProcessBTF($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $buff;
|
||||
|
||||
return 0 unless $raf->Read($buff, 16) == 16;
|
||||
return 0 unless $buff =~ /^(MM\0\x2b\0\x08\0\0|II\x2b\0\x08\0\0\0)/;
|
||||
if ($$dirInfo{OutFile}) {
|
||||
$et->Error('ExifTool does not support writing of BigTIFF images');
|
||||
return 1;
|
||||
}
|
||||
$et->SetFileType('BTF'); # set the FileType tag
|
||||
SetByteOrder(substr($buff, 0, 2));
|
||||
my $offset = Image::ExifTool::Get64u(\$buff, 8);
|
||||
if ($$et{HTML_DUMP}) {
|
||||
my $o = (GetByteOrder() eq 'II') ? 'Little' : 'Big';
|
||||
$et->HDump(0, 8, "BigTIFF header", "Byte order: $o endian", 0);
|
||||
$et->HDump(8, 8, "IFD0 pointer", sprintf("Offset: 0x%.8x",$offset), 0);
|
||||
}
|
||||
my %dirInfo = (
|
||||
RAF => $raf,
|
||||
DataPos => 0,
|
||||
DirStart => $offset,
|
||||
DirName => 'IFD0',
|
||||
Parent => 'BigTIFF',
|
||||
);
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::Exif::Main');
|
||||
$et->ProcessDirectory(\%dirInfo, $tagTablePtr, \&ProcessBigIFD);
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::BigTIFF - Read Big TIFF meta information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains routines required by Image::ExifTool to read meta
|
||||
information in BigTIFF images.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://www.awaresystems.be/imaging/tiff/bigtiff.html>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/EXIF Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,910 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: CanonRaw.pm
|
||||
#
|
||||
# Description: Read Canon RAW (CRW) meta information
|
||||
#
|
||||
# Revisions: 11/25/2003 - P. Harvey Created
|
||||
# 12/02/2003 - P. Harvey Completely reworked and figured out many
|
||||
# more tags
|
||||
#
|
||||
# References: 1) http://www.cybercom.net/~dcoffin/dcraw/
|
||||
# 2) http://www.wonderland.org/crw/
|
||||
# 3) http://xyrion.org/ciff/CIFFspecV1R04.pdf
|
||||
# 4) Dave Nicholson private communication (PowerShot S30)
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::CanonRaw;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION $AUTOLOAD %crwTagFormat);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
use Image::ExifTool::Exif;
|
||||
use Image::ExifTool::Canon;
|
||||
|
||||
$VERSION = '1.58';
|
||||
|
||||
sub WriteCRW($$);
|
||||
sub ProcessCanonRaw($$$);
|
||||
sub WriteCanonRaw($$$);
|
||||
sub CheckCanonRaw($$$);
|
||||
sub InitMakerNotes($);
|
||||
sub SaveMakerNotes($);
|
||||
sub BuildMakerNotes($$$$$$);
|
||||
|
||||
# formats for CRW tag types (($tag >> 8) & 0x38)
|
||||
# Note: don't define format for undefined types
|
||||
%crwTagFormat = (
|
||||
0x00 => 'int8u',
|
||||
0x08 => 'string',
|
||||
0x10 => 'int16u',
|
||||
0x18 => 'int32u',
|
||||
# 0x20 => 'undef',
|
||||
# 0x28 => 'undef',
|
||||
# 0x30 => 'undef',
|
||||
);
|
||||
|
||||
# Canon raw file tag table
|
||||
# Note: Tag ID's have upper 2 bits set to zero, since these 2 bits
|
||||
# just specify the location of the information
|
||||
%Image::ExifTool::CanonRaw::Main = (
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
|
||||
PROCESS_PROC => \&ProcessCanonRaw,
|
||||
WRITE_PROC => \&WriteCanonRaw,
|
||||
CHECK_PROC => \&CheckCanonRaw,
|
||||
WRITABLE => 1,
|
||||
0x0000 => { Name => 'NullRecord', Writable => 'undef' }, #3
|
||||
0x0001 => { #3
|
||||
Name => 'FreeBytes',
|
||||
Format => 'undef',
|
||||
Binary => 1,
|
||||
},
|
||||
0x0032 => { Name => 'CanonColorInfo1', Writable => 0 },
|
||||
0x0805 => [
|
||||
# this tag is found in more than one directory...
|
||||
{
|
||||
Condition => '$self->{DIR_NAME} eq "ImageDescription"',
|
||||
Name => 'CanonFileDescription',
|
||||
Writable => 'string[32]',
|
||||
},
|
||||
{
|
||||
Name => 'UserComment',
|
||||
Writable => 'string[256]',
|
||||
},
|
||||
],
|
||||
0x080a => {
|
||||
Name => 'CanonRawMakeModel',
|
||||
Writable => 0,
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::CanonRaw::MakeModel' },
|
||||
},
|
||||
0x080b => { Name => 'CanonFirmwareVersion', Writable => 'string[32]' },
|
||||
0x080c => { Name => 'ComponentVersion', Writable => 'string' }, #3
|
||||
0x080d => { Name => 'ROMOperationMode', Writable => 'string[8]' }, #3
|
||||
0x0810 => { Name => 'OwnerName', Writable => 'string[32]' },
|
||||
0x0815 => { Name => 'CanonImageType', Writable => 'string[32]' },
|
||||
0x0816 => { Name => 'OriginalFileName', Writable => 'string[32]' },
|
||||
0x0817 => { Name => 'ThumbnailFileName', Writable => 'string[32]' },
|
||||
0x100a => { #3
|
||||
Name => 'TargetImageType',
|
||||
Writable => 'int16u',
|
||||
PrintConv => {
|
||||
0 => 'Real-world Subject',
|
||||
1 => 'Written Document',
|
||||
},
|
||||
},
|
||||
0x1010 => { #3
|
||||
Name => 'ShutterReleaseMethod',
|
||||
Writable => 'int16u',
|
||||
PrintConv => {
|
||||
0 => 'Single Shot',
|
||||
2 => 'Continuous Shooting',
|
||||
},
|
||||
},
|
||||
0x1011 => { #3
|
||||
Name => 'ShutterReleaseTiming',
|
||||
Writable => 'int16u',
|
||||
PrintConv => {
|
||||
0 => 'Priority on shutter',
|
||||
1 => 'Priority on focus',
|
||||
},
|
||||
},
|
||||
0x1016 => { Name => 'ReleaseSetting', Writable => 'int16u' }, #3
|
||||
0x101c => { Name => 'BaseISO', Writable => 'int16u' }, #3
|
||||
0x1028=> { #PH
|
||||
Name => 'CanonFlashInfo',
|
||||
Writable => 'int16u',
|
||||
Count => 4,
|
||||
Unknown => 1,
|
||||
},
|
||||
0x1029 => {
|
||||
Name => 'CanonFocalLength',
|
||||
Writable => 0,
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Canon::FocalLength' },
|
||||
},
|
||||
0x102a => {
|
||||
Name => 'CanonShotInfo',
|
||||
Writable => 0,
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Canon::ShotInfo' },
|
||||
},
|
||||
0x102c => {
|
||||
Name => 'CanonColorInfo2',
|
||||
Writable => 0,
|
||||
# for the S30, the following information has been decoded: (ref 4)
|
||||
# offset 66: int32u - shutter half press time in ms
|
||||
# offset 70: int32u - image capture time in ms
|
||||
# offset 74: int16u - custom white balance flag (0=Off, 512=On)
|
||||
},
|
||||
0x102d => {
|
||||
Name => 'CanonCameraSettings',
|
||||
Writable => 0,
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Canon::CameraSettings' },
|
||||
},
|
||||
0x1030 => { #4
|
||||
Name => 'WhiteSample',
|
||||
Writable => 0,
|
||||
SubDirectory => {
|
||||
Validate => 'Image::ExifTool::Canon::Validate($dirData,$subdirStart,$size)',
|
||||
TagTable => 'Image::ExifTool::CanonRaw::WhiteSample',
|
||||
},
|
||||
},
|
||||
0x1031 => {
|
||||
Name => 'SensorInfo',
|
||||
Writable => 0,
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Canon::SensorInfo' },
|
||||
},
|
||||
# this tag has only be verified for the 10D in CRW files, but the D30 and D60
|
||||
# also produce CRW images and have CustomFunction information in their JPEG's
|
||||
0x1033 => [
|
||||
{
|
||||
Name => 'CustomFunctions10D',
|
||||
Condition => '$self->{Model} =~ /EOS 10D/',
|
||||
SubDirectory => {
|
||||
Validate => 'Image::ExifTool::Canon::Validate($dirData,$subdirStart,$size)',
|
||||
TagTable => 'Image::ExifTool::CanonCustom::Functions10D',
|
||||
},
|
||||
},
|
||||
{
|
||||
Name => 'CustomFunctionsD30',
|
||||
Condition => '$self->{Model} =~ /EOS D30\b/',
|
||||
SubDirectory => {
|
||||
Validate => 'Image::ExifTool::Canon::Validate($dirData,$subdirStart,$size)',
|
||||
TagTable => 'Image::ExifTool::CanonCustom::FunctionsD30',
|
||||
},
|
||||
},
|
||||
{
|
||||
Name => 'CustomFunctionsD60',
|
||||
Condition => '$self->{Model} =~ /EOS D60\b/',
|
||||
SubDirectory => {
|
||||
# the stored size in the D60 apparently doesn't include the size word:
|
||||
Validate => 'Image::ExifTool::Canon::Validate($dirData,$subdirStart,$size-2,$size)',
|
||||
# (D60 custom functions are basically the same as D30)
|
||||
TagTable => 'Image::ExifTool::CanonCustom::FunctionsD30',
|
||||
},
|
||||
},
|
||||
{
|
||||
Name => 'CustomFunctionsUnknown',
|
||||
SubDirectory => {
|
||||
Validate => 'Image::ExifTool::Canon::Validate($dirData,$subdirStart,$size)',
|
||||
TagTable => 'Image::ExifTool::CanonCustom::FuncsUnknown',
|
||||
},
|
||||
},
|
||||
],
|
||||
0x1038 => {
|
||||
Name => 'CanonAFInfo',
|
||||
Writable => 0,
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Canon::AFInfo' },
|
||||
},
|
||||
0x1093 => {
|
||||
Name => 'CanonFileInfo',
|
||||
SubDirectory => {
|
||||
Validate => 'Image::ExifTool::Canon::Validate($dirData,$subdirStart,$size)',
|
||||
TagTable => 'Image::ExifTool::Canon::FileInfo',
|
||||
},
|
||||
},
|
||||
0x10a9 => {
|
||||
Name => 'ColorBalance',
|
||||
Writable => 0,
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Canon::ColorBalance' },
|
||||
},
|
||||
0x10b5 => { #PH
|
||||
Name => 'RawJpgInfo',
|
||||
SubDirectory => {
|
||||
Validate => 'Image::ExifTool::Canon::Validate($dirData,$subdirStart,$size)',
|
||||
TagTable => 'Image::ExifTool::CanonRaw::RawJpgInfo',
|
||||
},
|
||||
},
|
||||
0x10ae => {
|
||||
Name => 'ColorTemperature',
|
||||
Writable => 'int16u',
|
||||
},
|
||||
0x10b4 => {
|
||||
Name => 'ColorSpace',
|
||||
Writable => 'int16u',
|
||||
PrintConv => {
|
||||
1 => 'sRGB',
|
||||
2 => 'Adobe RGB',
|
||||
0xffff => 'Uncalibrated',
|
||||
},
|
||||
},
|
||||
0x1803 => { #3
|
||||
Name => 'ImageFormat',
|
||||
Writable => 0,
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::CanonRaw::ImageFormat' },
|
||||
},
|
||||
0x1804 => { Name => 'RecordID', Writable => 'int32u' }, #3
|
||||
0x1806 => { #3
|
||||
Name => 'SelfTimerTime',
|
||||
Writable => 'int32u',
|
||||
ValueConv => '$val / 1000',
|
||||
ValueConvInv => '$val * 1000',
|
||||
PrintConv => '"$val s"',
|
||||
PrintConvInv => '$val=~s/\s*s.*//;$val',
|
||||
},
|
||||
0x1807 => {
|
||||
Name => 'TargetDistanceSetting',
|
||||
Format => 'float',
|
||||
PrintConv => '"$val mm"',
|
||||
PrintConvInv => '$val=~s/\s*mm$//;$val',
|
||||
},
|
||||
0x180b => [
|
||||
{
|
||||
# D30
|
||||
Name => 'SerialNumber',
|
||||
Condition => '$$self{Model} =~ /EOS D30\b/',
|
||||
Writable => 'int32u',
|
||||
PrintConv => 'sprintf("%x-%.5d",$val>>16,$val&0xffff)',
|
||||
PrintConvInv => '$val=~/(.*)-(\d+)/ ? (hex($1)<<16)+$2 : undef',
|
||||
},
|
||||
{
|
||||
# all EOS models (D30, 10D, 300D)
|
||||
Name => 'SerialNumber',
|
||||
Condition => '$$self{Model} =~ /EOS/',
|
||||
Writable => 'int32u',
|
||||
PrintConv => 'sprintf("%.10d",$val)',
|
||||
PrintConvInv => '$val',
|
||||
},
|
||||
{
|
||||
# this is not SerialNumber for PowerShot models (but what is it?) - PH
|
||||
Name => 'UnknownNumber',
|
||||
Unknown => 1,
|
||||
},
|
||||
],
|
||||
0x180e => {
|
||||
Name => 'TimeStamp',
|
||||
Writable => 0,
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::CanonRaw::TimeStamp',
|
||||
},
|
||||
},
|
||||
0x1810 => {
|
||||
Name => 'ImageInfo',
|
||||
Writable => 0,
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::CanonRaw::ImageInfo',
|
||||
},
|
||||
},
|
||||
0x1813 => { #3
|
||||
Name => 'FlashInfo',
|
||||
Writable => 0,
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::CanonRaw::FlashInfo',
|
||||
},
|
||||
},
|
||||
0x1814 => { #3
|
||||
Name => 'MeasuredEV',
|
||||
Notes => q{
|
||||
this is the Canon name for what could better be called MeasuredLV, and
|
||||
should be close to the calculated LightValue for a proper exposure with most
|
||||
models
|
||||
},
|
||||
Format => 'float',
|
||||
ValueConv => '$val + 5',
|
||||
ValueConvInv => '$val - 5',
|
||||
},
|
||||
0x1817 => {
|
||||
Name => 'FileNumber',
|
||||
Writable => 'int32u',
|
||||
Groups => { 2 => 'Image' },
|
||||
PrintConv => '$_=$val;s/(\d+)(\d{4})/$1-$2/;$_',
|
||||
PrintConvInv => '$_=$val;s/-//;$_',
|
||||
},
|
||||
0x1818 => { #3
|
||||
Name => 'ExposureInfo',
|
||||
Groups => { 1 => 'CIFF' }, # (only so CIFF shows up in group lists)
|
||||
Writable => 0,
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::CanonRaw::ExposureInfo' },
|
||||
},
|
||||
0x1834 => { #PH
|
||||
Name => 'CanonModelID',
|
||||
Writable => 'int32u',
|
||||
PrintHex => 1,
|
||||
Notes => q{
|
||||
this is the complete list of model ID numbers, but note that many of these
|
||||
models do not produce CRW images
|
||||
},
|
||||
SeparateTable => 'Canon CanonModelID',
|
||||
PrintConv => \%Image::ExifTool::Canon::canonModelID,
|
||||
},
|
||||
0x1835 => {
|
||||
Name => 'DecoderTable',
|
||||
Writable => 0,
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::CanonRaw::DecoderTable' },
|
||||
},
|
||||
0x183b => { #PH
|
||||
# display format for serial number
|
||||
Name => 'SerialNumberFormat',
|
||||
Writable => 'int32u',
|
||||
PrintHex => 1,
|
||||
PrintConv => {
|
||||
0x90000000 => 'Format 1',
|
||||
0xa0000000 => 'Format 2',
|
||||
},
|
||||
},
|
||||
0x2005 => {
|
||||
Name => 'RawData',
|
||||
Writable => 0,
|
||||
Binary => 1,
|
||||
},
|
||||
0x2007 => {
|
||||
Name => 'JpgFromRaw',
|
||||
Groups => { 2 => 'Preview' },
|
||||
Writable => 'resize', # 'resize' allows this value to change size
|
||||
Permanent => 0,
|
||||
RawConv => '$self->ValidateImage(\$val,$tag)',
|
||||
},
|
||||
0x2008 => {
|
||||
Name => 'ThumbnailImage',
|
||||
Groups => { 2 => 'Preview' },
|
||||
Writable => 'resize', # 'resize' allows this value to change size
|
||||
WriteCheck => '$self->CheckImage(\$val)',
|
||||
Permanent => 0,
|
||||
RawConv => '$self->ValidateImage(\$val,$tag)',
|
||||
},
|
||||
# the following entries are subdirectories
|
||||
# (any 0x28 and 0x30 tag types are handled automatically by the decoding logic)
|
||||
0x2804 => {
|
||||
Name => 'ImageDescription',
|
||||
SubDirectory => { },
|
||||
Writable => 0,
|
||||
},
|
||||
0x2807 => { #3
|
||||
Name => 'CameraObject',
|
||||
SubDirectory => { },
|
||||
Writable => 0,
|
||||
},
|
||||
0x3002 => { #3
|
||||
Name => 'ShootingRecord',
|
||||
SubDirectory => { },
|
||||
Writable => 0,
|
||||
},
|
||||
0x3003 => { #3
|
||||
Name => 'MeasuredInfo',
|
||||
SubDirectory => { },
|
||||
Writable => 0,
|
||||
},
|
||||
0x3004 => { #3
|
||||
Name => 'CameraSpecification',
|
||||
SubDirectory => { },
|
||||
Writable => 0,
|
||||
},
|
||||
0x300a => { #3
|
||||
Name => 'ImageProps',
|
||||
SubDirectory => { },
|
||||
Writable => 0,
|
||||
},
|
||||
0x300b => {
|
||||
Name => 'ExifInformation',
|
||||
SubDirectory => { },
|
||||
Writable => 0,
|
||||
},
|
||||
);
|
||||
|
||||
# Canon binary data blocks
|
||||
%Image::ExifTool::CanonRaw::MakeModel = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
|
||||
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
|
||||
DATAMEMBER => [ 0, 6 ], # indices of data members to extract when writing
|
||||
WRITABLE => 1,
|
||||
FORMAT => 'string',
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
|
||||
# (can't specify a first entry because this isn't
|
||||
# a simple binary table with fixed offsets)
|
||||
0 => {
|
||||
Name => 'Make',
|
||||
Format => 'string[6]', # "Canon\0"
|
||||
DataMember => 'Make',
|
||||
RawConv => '$self->{Make} = $val',
|
||||
},
|
||||
6 => {
|
||||
Name => 'Model',
|
||||
Format => 'string', # no size = to the end of the data
|
||||
Description => 'Camera Model Name',
|
||||
DataMember => 'Model',
|
||||
RawConv => '$self->{Model} = $val',
|
||||
},
|
||||
);
|
||||
|
||||
%Image::ExifTool::CanonRaw::TimeStamp = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
|
||||
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
|
||||
WRITABLE => 1,
|
||||
FORMAT => 'int32u',
|
||||
FIRST_ENTRY => 0,
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Time' },
|
||||
0 => {
|
||||
Name => 'DateTimeOriginal',
|
||||
Description => 'Date/Time Original',
|
||||
Shift => 'Time',
|
||||
ValueConv => 'ConvertUnixTime($val)',
|
||||
ValueConvInv => 'GetUnixTime($val)',
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
PrintConvInv => '$self->InverseDateTime($val)',
|
||||
},
|
||||
1 => { #3
|
||||
Name => 'TimeZoneCode',
|
||||
Format => 'int32s',
|
||||
ValueConv => '$val / 3600',
|
||||
ValueConvInv => '$val * 3600',
|
||||
},
|
||||
2 => { #3
|
||||
Name => 'TimeZoneInfo',
|
||||
Notes => 'set to 0x80000000 if TimeZoneCode is valid',
|
||||
},
|
||||
);
|
||||
|
||||
%Image::ExifTool::CanonRaw::ImageFormat = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
|
||||
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
|
||||
WRITABLE => 1,
|
||||
FORMAT => 'int32u',
|
||||
FIRST_ENTRY => 0,
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Image' },
|
||||
0 => {
|
||||
Name => 'FileFormat',
|
||||
Flags => 'PrintHex',
|
||||
PrintConv => {
|
||||
0x00010000 => 'JPEG (lossy)',
|
||||
0x00010002 => 'JPEG (non-quantization)',
|
||||
0x00010003 => 'JPEG (lossy/non-quantization toggled)',
|
||||
0x00020001 => 'CRW',
|
||||
},
|
||||
},
|
||||
1 => {
|
||||
Name => 'TargetCompressionRatio',
|
||||
Format => 'float',
|
||||
},
|
||||
);
|
||||
|
||||
%Image::ExifTool::CanonRaw::RawJpgInfo = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
|
||||
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
|
||||
WRITABLE => 1,
|
||||
FORMAT => 'int16u',
|
||||
FIRST_ENTRY => 1,
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Image' },
|
||||
# 0 => 'RawJpgInfoSize',
|
||||
1 => { #PH
|
||||
Name => 'RawJpgQuality',
|
||||
PrintConv => {
|
||||
1 => 'Economy',
|
||||
2 => 'Normal',
|
||||
3 => 'Fine',
|
||||
5 => 'Superfine',
|
||||
},
|
||||
},
|
||||
2 => { #PH
|
||||
Name => 'RawJpgSize',
|
||||
PrintConv => {
|
||||
0 => 'Large',
|
||||
1 => 'Medium',
|
||||
2 => 'Small',
|
||||
},
|
||||
},
|
||||
3 => 'RawJpgWidth', #PH
|
||||
4 => 'RawJpgHeight', #PH
|
||||
);
|
||||
|
||||
%Image::ExifTool::CanonRaw::FlashInfo = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
|
||||
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
|
||||
WRITABLE => 1,
|
||||
FORMAT => 'float',
|
||||
FIRST_ENTRY => 0,
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Image' },
|
||||
0 => 'FlashGuideNumber',
|
||||
1 => 'FlashThreshold',
|
||||
);
|
||||
|
||||
%Image::ExifTool::CanonRaw::ExposureInfo = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
|
||||
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
|
||||
WRITABLE => 1,
|
||||
FORMAT => 'float',
|
||||
FIRST_ENTRY => 0,
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Image' },
|
||||
0 => 'ExposureCompensation',
|
||||
1 => {
|
||||
Name => 'ShutterSpeedValue',
|
||||
ValueConv => 'abs($val)<100 ? 1/(2**$val) : 0',
|
||||
ValueConvInv => '$val>0 ? -log($val)/log(2) : -100',
|
||||
PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
|
||||
PrintConvInv => 'Image::ExifTool::Exif::ConvertFraction($val)',
|
||||
},
|
||||
2 => {
|
||||
Name => 'ApertureValue',
|
||||
ValueConv => '2 ** ($val / 2)',
|
||||
ValueConvInv => '$val>0 ? 2*log($val)/log(2) : 0',
|
||||
PrintConv => 'sprintf("%.1f",$val)',
|
||||
PrintConvInv => '$val',
|
||||
},
|
||||
);
|
||||
|
||||
%Image::ExifTool::CanonRaw::ImageInfo = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
|
||||
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
|
||||
FORMAT => 'int32u',
|
||||
FIRST_ENTRY => 0,
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Image' },
|
||||
# Note: Don't make these writable (except rotation) because it confuses
|
||||
# Canon decoding software if the are changed
|
||||
0 => 'ImageWidth', #3
|
||||
1 => 'ImageHeight', #3
|
||||
2 => { #3
|
||||
Name => 'PixelAspectRatio',
|
||||
Format => 'float',
|
||||
},
|
||||
3 => {
|
||||
Name => 'Rotation',
|
||||
Format => 'int32s',
|
||||
Writable => 'int32s',
|
||||
},
|
||||
4 => 'ComponentBitDepth', #3
|
||||
5 => 'ColorBitDepth', #3
|
||||
6 => 'ColorBW', #3
|
||||
);
|
||||
|
||||
# ref 4
|
||||
%Image::ExifTool::CanonRaw::DecoderTable = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
|
||||
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
|
||||
FORMAT => 'int32u',
|
||||
FIRST_ENTRY => 0,
|
||||
0 => 'DecoderTableNumber',
|
||||
2 => 'CompressedDataOffset',
|
||||
3 => 'CompressedDataLength',
|
||||
);
|
||||
|
||||
# ref 1/4
|
||||
%Image::ExifTool::CanonRaw::WhiteSample = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
|
||||
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
|
||||
FORMAT => 'int16u',
|
||||
FIRST_ENTRY => 1,
|
||||
1 => 'WhiteSampleWidth',
|
||||
2 => 'WhiteSampleHeight',
|
||||
3 => 'WhiteSampleLeftBorder',
|
||||
4 => 'WhiteSampleTopBorder',
|
||||
5 => 'WhiteSampleBits',
|
||||
# this is followed by the encrypted white sample values (ref 1)
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# AutoLoad our writer routines when necessary
|
||||
#
|
||||
sub AUTOLOAD
|
||||
{
|
||||
return Image::ExifTool::DoAutoLoad($AUTOLOAD, @_);
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process Raw file directory
|
||||
# Inputs: 0) ExifTool object reference
|
||||
# 1) directory information reference, 2) tag table reference
|
||||
# Returns: 1 on success
|
||||
sub ProcessCanonRaw($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $rawTagTable) = @_;
|
||||
my $blockStart = $$dirInfo{DirStart};
|
||||
my $blockSize = $$dirInfo{DirLen};
|
||||
my $raf = $$dirInfo{RAF} or return 0;
|
||||
my $buff;
|
||||
my $verbose = $et->Options('Verbose');
|
||||
my $buildMakerNotes = $et->Options('MakerNotes');
|
||||
|
||||
# 4 bytes at end of block give directory position within block
|
||||
$raf->Seek($blockStart+$blockSize-4, 0) or return 0;
|
||||
$raf->Read($buff, 4) == 4 or return 0;
|
||||
my $dirOffset = Get32u(\$buff,0) + $blockStart;
|
||||
$raf->Seek($dirOffset, 0) or return 0;
|
||||
$raf->Read($buff, 2) == 2 or return 0;
|
||||
my $entries = Get16u(\$buff,0); # get number of entries in directory
|
||||
# read the directory (10 bytes per entry)
|
||||
$raf->Read($buff, 10 * $entries) == 10 * $entries or return 0;
|
||||
|
||||
$verbose and $et->VerboseDir('CIFF', $entries);
|
||||
my $index;
|
||||
for ($index=0; $index<$entries; ++$index) {
|
||||
my $pt = 10 * $index;
|
||||
my $tag = Get16u(\$buff, $pt);
|
||||
my $size = Get32u(\$buff, $pt+2);
|
||||
my $valuePtr = Get32u(\$buff, $pt+6);
|
||||
my $ptr = $valuePtr + $blockStart; # all pointers relative to block start
|
||||
if ($tag & 0x8000) {
|
||||
$et->Warn('Bad CRW directory entry');
|
||||
return 1;
|
||||
}
|
||||
my $tagID = $tag & 0x3fff; # get tag ID
|
||||
my $tagType = ($tag >> 8) & 0x38; # get tag type
|
||||
my $valueInDir = ($tag & 0x4000); # flag for value in directory
|
||||
my $tagInfo = $et->GetTagInfo($rawTagTable, $tagID);
|
||||
if (($tagType==0x28 or $tagType==0x30) and not $valueInDir) {
|
||||
# this type of tag specifies a raw subdirectory
|
||||
my $name;
|
||||
$tagInfo and $name = $$tagInfo{Name};
|
||||
$name or $name = sprintf("CanonRaw_0x%.4x", $tag);
|
||||
my %subdirInfo = (
|
||||
DirName => $name,
|
||||
DataLen => 0,
|
||||
DirStart => $ptr,
|
||||
DirLen => $size,
|
||||
Nesting => $$dirInfo{Nesting} + 1,
|
||||
RAF => $raf,
|
||||
Parent => $$dirInfo{DirName},
|
||||
);
|
||||
if ($verbose) {
|
||||
my $fakeInfo = { Name => $name, SubDirectory => { } };
|
||||
$et->VerboseInfo($tagID, $fakeInfo,
|
||||
'Index' => $index,
|
||||
'Size' => $size,
|
||||
'Start' => $ptr,
|
||||
);
|
||||
}
|
||||
$et->ProcessDirectory(\%subdirInfo, $rawTagTable);
|
||||
next;
|
||||
}
|
||||
my ($valueDataPos, $count, $subdir);
|
||||
my $format = $crwTagFormat{$tagType};
|
||||
if ($tagInfo) {
|
||||
$subdir = $$tagInfo{SubDirectory};
|
||||
$format = $$tagInfo{Format} if $$tagInfo{Format};
|
||||
$count = $$tagInfo{Count};
|
||||
}
|
||||
# get value data
|
||||
my ($value, $delRawConv);
|
||||
if ($valueInDir) { # is the value data in the directory?
|
||||
# this type of tag stores the value in the 'size' and 'ptr' fields
|
||||
$valueDataPos = $dirOffset + $pt + 4;
|
||||
$size = 8;
|
||||
$value = substr($buff, $pt+2, $size);
|
||||
# set count to 1 by default for normal values in directory
|
||||
$count = 1 if not defined $count and $format and
|
||||
$format ne 'string' and not $subdir;
|
||||
} else {
|
||||
$valueDataPos = $ptr;
|
||||
if ($size <= 512 or ($verbose > 2 and $size <= 65536)
|
||||
or ($tagInfo and ($$tagInfo{SubDirectory}
|
||||
or grep(/^$$tagInfo{Name}$/i, $et->GetRequestedTags()) )))
|
||||
{
|
||||
# read value if size is small or specifically requested
|
||||
# or if this is a SubDirectory
|
||||
unless ($raf->Seek($ptr, 0) and $raf->Read($value, $size) == $size) {
|
||||
$et->Warn(sprintf("Error reading %d bytes from 0x%x",$size,$ptr));
|
||||
next;
|
||||
}
|
||||
} else {
|
||||
$value = "Binary data $size bytes";
|
||||
if ($tagInfo) {
|
||||
if ($et->Options('Binary') or $verbose) {
|
||||
# read the value anyway
|
||||
unless ($raf->Seek($ptr, 0) and $raf->Read($value, $size) == $size) {
|
||||
$et->Warn(sprintf("Error reading %d bytes from 0x%x",$size,$ptr));
|
||||
next;
|
||||
}
|
||||
}
|
||||
# force this to be a binary (scalar reference)
|
||||
$$tagInfo{RawConv} = '\$val';
|
||||
$delRawConv = 1;
|
||||
}
|
||||
$size = length $value;
|
||||
undef $format;
|
||||
}
|
||||
}
|
||||
# set count from tagInfo count if necessary
|
||||
if ($format and not $count) {
|
||||
# set count according to format and size
|
||||
my $fnum = $Image::ExifTool::Exif::formatNumber{$format};
|
||||
my $fsiz = $Image::ExifTool::Exif::formatSize[$fnum];
|
||||
$count = int($size / $fsiz);
|
||||
}
|
||||
if ($verbose) {
|
||||
my $val = $value;
|
||||
$format and $val = ReadValue(\$val, 0, $format, $count, $size);
|
||||
$et->VerboseInfo($tagID, $tagInfo,
|
||||
Table => $rawTagTable,
|
||||
Index => $index,
|
||||
Value => $val,
|
||||
DataPt => \$value,
|
||||
DataPos => $valueDataPos,
|
||||
Size => $size,
|
||||
Format => $format,
|
||||
Count => $count,
|
||||
);
|
||||
}
|
||||
if ($buildMakerNotes) {
|
||||
# build maker notes information if requested
|
||||
BuildMakerNotes($et, $tagID, $tagInfo, \$value, $format, $count);
|
||||
}
|
||||
next unless defined $tagInfo;
|
||||
|
||||
if ($subdir) {
|
||||
my $name = $$tagInfo{Name};
|
||||
my $newTagTable;
|
||||
if ($$subdir{TagTable}) {
|
||||
$newTagTable = GetTagTable($$subdir{TagTable});
|
||||
unless ($newTagTable) {
|
||||
warn "Unknown tag table $$subdir{TagTable}\n";
|
||||
next;
|
||||
}
|
||||
} else {
|
||||
warn "Must specify TagTable for SubDirectory $name\n";
|
||||
next;
|
||||
}
|
||||
my $subdirStart = 0;
|
||||
#### eval Start ()
|
||||
$subdirStart = eval $$subdir{Start} if $$subdir{Start};
|
||||
my $dirData = \$value;
|
||||
my %subdirInfo = (
|
||||
Name => $name,
|
||||
DataPt => $dirData,
|
||||
DataLen => $size,
|
||||
DataPos => $valueDataPos,
|
||||
DirStart => $subdirStart,
|
||||
DirLen => $size - $subdirStart,
|
||||
Nesting => $$dirInfo{Nesting} + 1,
|
||||
RAF => $raf,
|
||||
DirName => $name,
|
||||
Parent => $$dirInfo{DirName},
|
||||
);
|
||||
#### eval Validate ($dirData, $subdirStart, $size)
|
||||
if (defined $$subdir{Validate} and not eval $$subdir{Validate}) {
|
||||
$et->Warn("Invalid $name data");
|
||||
} else {
|
||||
$et->ProcessDirectory(\%subdirInfo, $newTagTable, $$subdir{ProcessProc});
|
||||
}
|
||||
} else {
|
||||
# convert to specified format if necessary
|
||||
$format and $value = ReadValue(\$value, 0, $format, $count, $size);
|
||||
# save the information
|
||||
$et->FoundTag($tagInfo, $value);
|
||||
delete $$tagInfo{RawConv} if $delRawConv;
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# get information from raw file
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
||||
# Returns: 1 if this was a valid Canon RAW file
|
||||
sub ProcessCRW($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my ($buff, $sig);
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $buildMakerNotes = $et->Options('MakerNotes');
|
||||
|
||||
$raf->Read($buff,2) == 2 or return 0;
|
||||
SetByteOrder($buff) or return 0;
|
||||
$raf->Read($buff,4) == 4 or return 0;
|
||||
$raf->Read($sig,8) == 8 or return 0; # get file signature
|
||||
$sig =~ /^HEAP(CCDR|JPGM)/ or return 0; # validate signature
|
||||
my $hlen = Get32u(\$buff, 0);
|
||||
|
||||
$raf->Seek(0, 2) or return 0; # seek to end of file
|
||||
my $filesize = $raf->Tell() or return 0;
|
||||
|
||||
# initialize maker note data if building maker notes
|
||||
$buildMakerNotes and InitMakerNotes($et);
|
||||
|
||||
# set the FileType tag unless already done (eg. APP0 CIFF record in JPEG image)
|
||||
$et->SetFileType();
|
||||
|
||||
# build directory information for main raw directory
|
||||
my %dirInfo = (
|
||||
DataLen => 0,
|
||||
DirStart => $hlen,
|
||||
DirLen => $filesize - $hlen,
|
||||
Nesting => 0,
|
||||
RAF => $raf,
|
||||
Parent => 'CRW',
|
||||
);
|
||||
|
||||
# process the raw directory
|
||||
my $rawTagTable = GetTagTable('Image::ExifTool::CanonRaw::Main');
|
||||
my $oldIndent = $$et{INDENT};
|
||||
$$et{INDENT} .= '| ';
|
||||
unless (ProcessCanonRaw($et, \%dirInfo, $rawTagTable)) {
|
||||
$et->Warn('CRW file format error');
|
||||
}
|
||||
$$et{INDENT} = $oldIndent;
|
||||
|
||||
# finish building maker notes if necessary
|
||||
$buildMakerNotes and SaveMakerNotes($et);
|
||||
|
||||
# process trailers if they exist in CRW file (not in CIFF information!)
|
||||
if ($$et{FILE_TYPE} eq 'CRW') {
|
||||
my $trailInfo = Image::ExifTool::IdentifyTrailer($raf);
|
||||
$et->ProcessTrailers($trailInfo) if $trailInfo;
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::CanonRaw - Read Canon RAW (CRW) meta information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is loaded automatically by Image::ExifTool when required.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to interpret
|
||||
meta information from Canon CRW raw files. These files are written directly
|
||||
by some Canon cameras, and contain meta information similar to that found in
|
||||
the EXIF Canon maker notes.
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
The CR2 format written by some Canon cameras is very different the CRW
|
||||
format processed by this module. (CR2 is TIFF-based and uses standard EXIF
|
||||
tags.)
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://www.cybercom.net/~dcoffin/dcraw/>
|
||||
|
||||
=item L<http://www.wonderland.org/crw/>
|
||||
|
||||
=item L<http://xyrion.org/ciff/>
|
||||
|
||||
=item L<http://owl.phy.queensu.ca/~phil/exiftool/canon_raw.html>
|
||||
|
||||
=back
|
||||
|
||||
=head1 ACKNOWLEDGEMENTS
|
||||
|
||||
Thanks to Dave Nicholson for decoding a number of new tags.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/CanonRaw Tags>,
|
||||
L<Image::ExifTool::Canon(3pm)|Image::ExifTool::Canon>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,235 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: CaptureOne.pm
|
||||
#
|
||||
# Description: Read Capture One EIP and COS files
|
||||
#
|
||||
# Revisions: 2009/11/01 - P. Harvey Created
|
||||
#
|
||||
# Notes: The EIP format is a ZIP file containing an image (IIQ or TIFF)
|
||||
# and some settings files (COS). COS files are XML based.
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::CaptureOne;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
use Image::ExifTool::XMP;
|
||||
use Image::ExifTool::ZIP;
|
||||
|
||||
$VERSION = '1.04';
|
||||
|
||||
# CaptureOne COS XML tags
|
||||
# - tags are added dynamically when encountered
|
||||
# - this table is not listed in tag name docs
|
||||
%Image::ExifTool::CaptureOne::Main = (
|
||||
GROUPS => { 0 => 'XML', 1 => 'XML', 2 => 'Image' },
|
||||
PROCESS_PROC => \&Image::ExifTool::XMP::ProcessXMP,
|
||||
VARS => { NO_ID => 1 },
|
||||
ColorCorrections => { ValueConv => '\$val' }, # (long list of floating point numbers)
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# We found an XMP property name/value
|
||||
# Inputs: 0) attribute list ref, 1) attr hash ref,
|
||||
# 2) property name ref, 3) property value ref
|
||||
# Returns: true if value was changed
|
||||
sub HandleCOSAttrs($$$$)
|
||||
{
|
||||
my ($attrList, $attrs, $prop, $valPt) = @_;
|
||||
my $changed;
|
||||
if (not length $$valPt and defined $$attrs{K} and defined $$attrs{V}) {
|
||||
$$prop = $$attrs{K};
|
||||
$$valPt = $$attrs{V};
|
||||
# remove these attributes from the list
|
||||
my @attrs = @$attrList;
|
||||
@$attrList = ( );
|
||||
my $a;
|
||||
foreach $a (@attrs) {
|
||||
if ($a eq 'K' or $a eq 'V') {
|
||||
delete $$attrs{$a};
|
||||
} else {
|
||||
push @$attrList, $a;
|
||||
}
|
||||
}
|
||||
$changed = 1;
|
||||
}
|
||||
return $changed;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# We found a COS property name/value
|
||||
# Inputs: 0) ExifTool object ref, 1) tag table ref
|
||||
# 2) reference to array of XMP property names (last is current property)
|
||||
# 3) property value, 4) attribute hash ref (not used here)
|
||||
# Returns: 1 if valid tag was found
|
||||
sub FoundCOS($$$$;$)
|
||||
{
|
||||
my ($et, $tagTablePtr, $props, $val, $attrs) = @_;
|
||||
|
||||
my $tag = $$props[-1];
|
||||
unless ($$tagTablePtr{$tag}) {
|
||||
$et->VPrint(0, " | [adding $tag]\n");
|
||||
my $name = ucfirst $tag;
|
||||
$name =~ tr/-_a-zA-Z0-9//dc;
|
||||
return 0 unless length $tag;
|
||||
my %tagInfo = ( Name => $tag );
|
||||
# try formatting any tag with "Date" in the name as a date
|
||||
# (shouldn't affect non-date tags)
|
||||
if ($name =~ /Date(?![a-z])/) {
|
||||
$tagInfo{Groups} = { 2 => 'Time' };
|
||||
$tagInfo{ValueConv} = 'Image::ExifTool::XMP::ConvertXMPDate($val,1)';
|
||||
$tagInfo{PrintConv} = '$self->ConvertDateTime($val)';
|
||||
}
|
||||
AddTagToTable($tagTablePtr, $tag, \%tagInfo);
|
||||
}
|
||||
# convert from UTF8 to ExifTool Charset
|
||||
$val = $et->Decode($val, "UTF8");
|
||||
# un-escape XML character entities
|
||||
$val = Image::ExifTool::XMP::UnescapeXML($val);
|
||||
$et->HandleTag($tagTablePtr, $tag, $val);
|
||||
return 0;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Extract information from a COS file
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
||||
# Returns: 1 on success, 0 if this wasn't a valid XML file
|
||||
sub ProcessCOS($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
|
||||
# process using XMP module, but override handling of attributes and tags
|
||||
$$dirInfo{XMPParseOpts} = {
|
||||
AttrProc => \&HandleCOSAttrs,
|
||||
FoundProc => \&FoundCOS,
|
||||
};
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::CaptureOne::Main');
|
||||
my $success = $et->ProcessDirectory($dirInfo, $tagTablePtr);
|
||||
delete $$dirInfo{XMLParseArgs};
|
||||
return $success;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Extract information from a CaptureOne EIP file
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
||||
# Returns: 1
|
||||
# Notes: Upon entry to this routine, the file type has already been verified
|
||||
# and the dirInfo hash contains a ZIP element unique to this process proc:
|
||||
# ZIP - reference to Archive::Zip object for this file
|
||||
sub ProcessEIP($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $zip = $$dirInfo{ZIP};
|
||||
my ($file, $buff, $status, $member, %parseFile);
|
||||
|
||||
$et->SetFileType('EIP');
|
||||
|
||||
# must catch all Archive::Zip warnings
|
||||
local $SIG{'__WARN__'} = \&Image::ExifTool::ZIP::WarnProc;
|
||||
# find all manifest files
|
||||
my @members = $zip->membersMatching('^manifest\d*.xml$');
|
||||
# and choose the one with the highest version number (any better ideas?)
|
||||
while (@members) {
|
||||
my $m = shift @members;
|
||||
my $f = $m->fileName();
|
||||
next if $file and $file gt $f;
|
||||
$member = $m;
|
||||
$file = $f;
|
||||
}
|
||||
# get file names from our chosen manifest file
|
||||
if ($member) {
|
||||
($buff, $status) = $zip->contents($member);
|
||||
if (not $status) {
|
||||
my $foundImage;
|
||||
while ($buff =~ m{<(RawPath|SettingsPath)>(.*?)</\1>}sg) {
|
||||
$file = $2;
|
||||
next unless $file =~ /\.(cos|iiq|jpe?g|tiff?)$/i;
|
||||
$parseFile{$file} = 1; # set flag to parse this file
|
||||
$foundImage = 1 unless $file =~ /\.cos$/i;
|
||||
}
|
||||
# ignore manifest unless it contained a valid image
|
||||
undef %parseFile unless $foundImage;
|
||||
}
|
||||
}
|
||||
# extract meta information from embedded files
|
||||
my $docNum = 0;
|
||||
@members = $zip->members(); # get all members
|
||||
foreach $member (@members) {
|
||||
# get filename of this ZIP member
|
||||
$file = $member->fileName();
|
||||
next unless defined $file;
|
||||
$et->VPrint(0, "File: $file\n");
|
||||
# set the document number and extract ZIP tags
|
||||
$$et{DOC_NUM} = ++$docNum;
|
||||
Image::ExifTool::ZIP::HandleMember($et, $member);
|
||||
if (%parseFile) {
|
||||
next unless $parseFile{$file};
|
||||
} else {
|
||||
# reading the manifest didn't work, so look for image files in the
|
||||
# root directory and .cos files in the CaptureOne directory
|
||||
next unless $file =~ m{^([^/]+\.(iiq|jpe?g|tiff?)|CaptureOne/.*\.cos)$}i;
|
||||
}
|
||||
# extract the contents of the file
|
||||
# Note: this could use a LOT of memory here for RAW images...
|
||||
($buff, $status) = $zip->contents($member);
|
||||
$status and $et->Warn("Error extracting $file"), next;
|
||||
if ($file =~ /\.cos$/i) {
|
||||
# process Capture One Settings files
|
||||
my %dirInfo = (
|
||||
DataPt => \$buff,
|
||||
DirLen => length $buff,
|
||||
DataLen => length $buff,
|
||||
);
|
||||
ProcessCOS($et, \%dirInfo);
|
||||
} else {
|
||||
# set HtmlDump error if necessary because it doesn't work with embedded files
|
||||
if ($$et{HTML_DUMP}) {
|
||||
$$et{HTML_DUMP}{Error} = "Sorry, can't dump images embedded in ZIP files";
|
||||
}
|
||||
# process IIQ, JPEG and TIFF images
|
||||
$et->ExtractInfo(\$buff, { ReEntry => 1 });
|
||||
}
|
||||
undef $buff; # (free memory now)
|
||||
}
|
||||
delete $$et{DOC_NUM};
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::CaptureOne - Read Capture One EIP and COS files
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to extract meta
|
||||
information from Capture One EIP (Enhanced Image Package) and COS (Capture
|
||||
One Settings) files.
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
The EIP format is a ZIP file containing an image (IIQ or TIFF) and some
|
||||
settings files (COS).
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/ZIP Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,431 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Charset.pm
|
||||
#
|
||||
# Description: ExifTool character encoding routines
|
||||
#
|
||||
# Revisions: 2009/08/28 - P. Harvey created
|
||||
# 2010/01/20 - P. Harvey complete re-write
|
||||
# 2010/07/16 - P. Harvey added UTF-16 support
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::Charset;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION %csType);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.11';
|
||||
|
||||
my %charsetTable; # character set tables we've loaded
|
||||
|
||||
# lookup for converting Unicode to 1-byte character sets
|
||||
my %unicode2byte = (
|
||||
Latin => { # pre-load Latin (cp1252) for speed
|
||||
0x20ac => 0x80, 0x0160 => 0x8a, 0x2013 => 0x96,
|
||||
0x201a => 0x82, 0x2039 => 0x8b, 0x2014 => 0x97,
|
||||
0x0192 => 0x83, 0x0152 => 0x8c, 0x02dc => 0x98,
|
||||
0x201e => 0x84, 0x017d => 0x8e, 0x2122 => 0x99,
|
||||
0x2026 => 0x85, 0x2018 => 0x91, 0x0161 => 0x9a,
|
||||
0x2020 => 0x86, 0x2019 => 0x92, 0x203a => 0x9b,
|
||||
0x2021 => 0x87, 0x201c => 0x93, 0x0153 => 0x9c,
|
||||
0x02c6 => 0x88, 0x201d => 0x94, 0x017e => 0x9e,
|
||||
0x2030 => 0x89, 0x2022 => 0x95, 0x0178 => 0x9f,
|
||||
},
|
||||
);
|
||||
|
||||
# bit flags for all supported character sets
|
||||
# (this number must be correct because it dictates the decoding algorithm!)
|
||||
# 0x001 = character set requires a translation module
|
||||
# 0x002 = inverse conversion not yet supported by Recompose()
|
||||
# 0x080 = some characters with codepoints in the range 0x00-0x7f are remapped
|
||||
# 0x100 = 1-byte fixed-width characters
|
||||
# 0x200 = 2-byte fixed-width characters
|
||||
# 0x400 = 4-byte fixed-width characters
|
||||
# 0x800 = 1- and 2-byte variable-width characters, or 1-byte
|
||||
# fixed-width characters that map into multiple codepoints
|
||||
# Note: In its public interface, ExifTool can currently only support type 0x101
|
||||
# and lower character sets because strings are only converted if they
|
||||
# contain characters above 0x7f and there is no provision for specifying
|
||||
# the byte order for input/output values
|
||||
%csType = (
|
||||
UTF8 => 0x100,
|
||||
ASCII => 0x100, # (treated like UTF8)
|
||||
Arabic => 0x101,
|
||||
Baltic => 0x101,
|
||||
Cyrillic => 0x101,
|
||||
Greek => 0x101,
|
||||
Hebrew => 0x101,
|
||||
Latin => 0x101,
|
||||
Latin2 => 0x101,
|
||||
DOSLatinUS => 0x101,
|
||||
DOSLatin1 => 0x101,
|
||||
MacCroatian => 0x101,
|
||||
MacCyrillic => 0x101,
|
||||
MacGreek => 0x101,
|
||||
MacIceland => 0x101,
|
||||
MacLatin2 => 0x101,
|
||||
MacRoman => 0x101,
|
||||
MacRomanian => 0x101,
|
||||
MacTurkish => 0x101,
|
||||
Thai => 0x101,
|
||||
Turkish => 0x101,
|
||||
Vietnam => 0x101,
|
||||
MacArabic => 0x103, # (directional characters not supported)
|
||||
PDFDoc => 0x181,
|
||||
Unicode => 0x200, # (UCS2)
|
||||
UCS2 => 0x200,
|
||||
UTF16 => 0x200,
|
||||
Symbol => 0x201,
|
||||
JIS => 0x201,
|
||||
UCS4 => 0x400,
|
||||
MacChineseCN => 0x803,
|
||||
MacChineseTW => 0x803,
|
||||
MacHebrew => 0x803, # (directional characters not supported)
|
||||
MacKorean => 0x803,
|
||||
MacRSymbol => 0x803,
|
||||
MacThai => 0x803,
|
||||
MacJapanese => 0x883,
|
||||
ShiftJIS => 0x883,
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Load character set module
|
||||
# Inputs: 0) Module name
|
||||
# Returns: Reference to lookup hash, or undef on error
|
||||
sub LoadCharset($)
|
||||
{
|
||||
my $charset = shift;
|
||||
my $conv = $charsetTable{$charset};
|
||||
unless ($conv) {
|
||||
# load translation module
|
||||
my $module = "Image::ExifTool::Charset::$charset";
|
||||
no strict 'refs';
|
||||
if (%$module or eval "require $module") {
|
||||
$conv = $charsetTable{$charset} = \%$module;
|
||||
}
|
||||
}
|
||||
return $conv;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Does an array contain valid UTF-16 characters?
|
||||
# Inputs: 0) array reference to list of UCS-2 values
|
||||
# Returns: 0=invalid UTF-16, 1=valid UTF-16 with no surrogates, 2=valid UTF-16 with surrogates
|
||||
sub IsUTF16($)
|
||||
{
|
||||
local $_;
|
||||
my $uni = shift;
|
||||
my $surrogate;
|
||||
foreach (@$uni) {
|
||||
my $hiBits = ($_ & 0xfc00);
|
||||
if ($hiBits == 0xfc00) {
|
||||
# check for invalid values in UTF-16
|
||||
return 0 if $_ == 0xffff or $_ == 0xfffe or ($_ >= 0xfdd0 and $_ <= 0xfdef);
|
||||
} elsif ($surrogate) {
|
||||
return 0 if $hiBits != 0xdc00;
|
||||
$surrogate = 0;
|
||||
} else {
|
||||
return 0 if $hiBits == 0xdc00;
|
||||
$surrogate = 1 if $hiBits == 0xd800;
|
||||
}
|
||||
}
|
||||
return 1 if not defined $surrogate;
|
||||
return 2 unless $surrogate;
|
||||
return 0;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Decompose string with specified encoding into an array of integer code points
|
||||
# Inputs: 0) ExifTool object ref (or undef), 1) string, 2) character set name,
|
||||
# 3) optional byte order ('II','MM','Unknown' or undef to use ExifTool ordering)
|
||||
# Returns: Reference to array of Unicode values
|
||||
# Notes: Accepts any type of character set
|
||||
# - byte order only used for fixed-width 2-byte and 4-byte character sets
|
||||
# - byte order mark observed and then removed with UCS2 and UCS4
|
||||
# - no warnings are issued if ExifTool object is not provided
|
||||
# - sets ExifTool WrongByteOrder flag if byte order is Unknown and current order is wrong
|
||||
sub Decompose($$$;$)
|
||||
{
|
||||
local $_;
|
||||
my ($et, $val, $charset) = @_; # ($byteOrder assigned later if required)
|
||||
my $type = $csType{$charset};
|
||||
my (@uni, $conv);
|
||||
|
||||
if ($type & 0x001) {
|
||||
$conv = LoadCharset($charset);
|
||||
unless ($conv) {
|
||||
# (shouldn't happen)
|
||||
$et->Warn("Invalid character set $charset") if $et;
|
||||
return \@uni; # error!
|
||||
}
|
||||
} elsif ($type == 0x100) {
|
||||
# convert ASCII and UTF8 (treat ASCII as UTF8)
|
||||
if ($] < 5.006001) {
|
||||
# do it ourself
|
||||
@uni = Image::ExifTool::UnpackUTF8($val);
|
||||
} else {
|
||||
# handle warnings from malformed UTF-8
|
||||
undef $Image::ExifTool::evalWarning;
|
||||
local $SIG{'__WARN__'} = \&Image::ExifTool::SetWarning;
|
||||
# (somehow the meaning of "U0" was reversed in Perl 5.10.0!)
|
||||
@uni = unpack($] < 5.010000 ? 'U0U*' : 'C0U*', $val);
|
||||
# issue warning if we had errors
|
||||
if ($Image::ExifTool::evalWarning and $et and not $$et{WarnBadUTF8}) {
|
||||
$et->Warn('Malformed UTF-8 character(s)');
|
||||
$$et{WarnBadUTF8} = 1;
|
||||
}
|
||||
}
|
||||
return \@uni; # all done!
|
||||
}
|
||||
if ($type & 0x100) { # 1-byte fixed-width characters
|
||||
@uni = unpack('C*', $val);
|
||||
foreach (@uni) {
|
||||
$_ = $$conv{$_} if defined $$conv{$_};
|
||||
}
|
||||
} elsif ($type & 0x600) { # 2-byte or 4-byte fixed-width characters
|
||||
my $unknown;
|
||||
my $byteOrder = $_[3];
|
||||
if (not $byteOrder) {
|
||||
$byteOrder = GetByteOrder();
|
||||
} elsif ($byteOrder eq 'Unknown') {
|
||||
$byteOrder = GetByteOrder();
|
||||
$unknown = 1;
|
||||
}
|
||||
my $fmt = $byteOrder eq 'MM' ? 'n*' : 'v*';
|
||||
if ($type & 0x400) { # 4-byte
|
||||
$fmt = uc $fmt; # unpack as 'N*' or 'V*'
|
||||
# honour BOM if it exists
|
||||
$val =~ s/^(\0\0\xfe\xff|\xff\xfe\0\0)// and $fmt = $1 eq "\0\0\xfe\xff" ? 'N*' : 'V*';
|
||||
undef $unknown; # (byte order logic applies to 2-byte only)
|
||||
} elsif ($val =~ s/^(\xfe\xff|\xff\xfe)//) {
|
||||
$fmt = $1 eq "\xfe\xff" ? 'n*' : 'v*';
|
||||
undef $unknown;
|
||||
}
|
||||
# convert from UCS2 or UCS4
|
||||
@uni = unpack($fmt, $val);
|
||||
|
||||
if (not $conv) {
|
||||
# no translation necessary
|
||||
if ($unknown) {
|
||||
# check the byte order
|
||||
my (%bh, %bl);
|
||||
my ($zh, $zl) = (0, 0);
|
||||
foreach (@uni) {
|
||||
$bh{$_ >> 8} = 1;
|
||||
$bl{$_ & 0xff} = 1;
|
||||
++$zh unless $_ & 0xff00;
|
||||
++$zl unless $_ & 0x00ff;
|
||||
}
|
||||
# count the number of unique values in the hi and lo bytes
|
||||
my ($bh, $bl) = (scalar(keys %bh), scalar(keys %bl));
|
||||
# the byte with the greater number of unique values should be
|
||||
# the low-order byte, otherwise the byte which is zero more
|
||||
# often is likely the high-order byte
|
||||
if ($bh > $bl or ($bh == $bl and $zl > $zh)) {
|
||||
# we guessed wrong, so decode using the other byte order
|
||||
$fmt =~ tr/nvNV/vnVN/;
|
||||
@uni = unpack($fmt, $val);
|
||||
$$et{WrongByteOrder} = 1;
|
||||
}
|
||||
}
|
||||
# handle surrogate pairs of UTF-16
|
||||
if ($charset eq 'UTF16') {
|
||||
my $i;
|
||||
for ($i=0; $i<$#uni; ++$i) {
|
||||
next unless ($uni[$i] & 0xfc00) == 0xd800 and
|
||||
($uni[$i+1] & 0xfc00) == 0xdc00;
|
||||
my $cp = 0x10000 + (($uni[$i] & 0x3ff) << 10) + ($uni[$i+1] & 0x3ff);
|
||||
splice(@uni, $i, 2, $cp);
|
||||
}
|
||||
}
|
||||
} elsif ($unknown) {
|
||||
# count encoding errors as we do the translation
|
||||
my $e1 = 0;
|
||||
foreach (@uni) {
|
||||
defined $$conv{$_} and $_ = $$conv{$_}, next;
|
||||
++$e1;
|
||||
}
|
||||
# try the other byte order if we had any errors
|
||||
if ($e1) {
|
||||
$fmt = $byteOrder eq 'MM' ? 'v*' : 'n*'; #(reversed)
|
||||
my @try = unpack($fmt, $val);
|
||||
my $e2 = 0;
|
||||
foreach (@try) {
|
||||
defined $$conv{$_} and $_ = $$conv{$_}, next;
|
||||
++$e2;
|
||||
}
|
||||
# use this byte order if there are fewer errors
|
||||
if ($e2 < $e1) {
|
||||
$$et{WrongByteOrder} = 1;
|
||||
return \@try;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
# translate any characters found in the lookup
|
||||
foreach (@uni) {
|
||||
$_ = $$conv{$_} if defined $$conv{$_};
|
||||
}
|
||||
}
|
||||
} else { # variable-width characters
|
||||
# unpack into bytes
|
||||
my @bytes = unpack('C*', $val);
|
||||
while (@bytes) {
|
||||
my $ch = shift @bytes;
|
||||
my $cv = $$conv{$ch};
|
||||
# pass straight through if no translation
|
||||
$cv or push(@uni, $ch), next;
|
||||
# byte translates into single Unicode character
|
||||
ref $cv or push(@uni, $cv), next;
|
||||
# byte maps into multiple Unicode characters
|
||||
ref $cv eq 'ARRAY' and push(@uni, @$cv), next;
|
||||
# handle 2-byte character codes
|
||||
$ch = shift @bytes;
|
||||
if (defined $ch) {
|
||||
if ($$cv{$ch}) {
|
||||
$cv = $$cv{$ch};
|
||||
ref $cv or push(@uni, $cv), next;
|
||||
push @uni, @$cv; # multiple Unicode characters
|
||||
} else {
|
||||
push @uni, ord('?'); # encoding error
|
||||
unshift @bytes, $ch;
|
||||
}
|
||||
} else {
|
||||
push @uni, ord('?'); # encoding error
|
||||
}
|
||||
}
|
||||
}
|
||||
return \@uni;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Convert array of code point integers into a string with specified encoding
|
||||
# Inputs: 0) ExifTool ref (or undef), 1) unicode character array ref,
|
||||
# 2) character set (note: not all types are supported)
|
||||
# 3) byte order ('MM' or 'II', multi-byte sets only, defaults to current byte order)
|
||||
# Returns: converted string (truncated at null character if it exists), empty on error
|
||||
# Notes: converts elements of input character array to new code points
|
||||
# - ExifTool ref may be undef provided $charset is defined
|
||||
sub Recompose($$;$$)
|
||||
{
|
||||
local $_;
|
||||
my ($et, $uni, $charset) = @_; # ($byteOrder assigned later if required)
|
||||
my ($outVal, $conv, $inv);
|
||||
$charset or $charset = $$et{OPTIONS}{Charset};
|
||||
my $csType = $csType{$charset};
|
||||
if ($csType == 0x100) { # UTF8 (also treat ASCII as UTF8)
|
||||
if ($] >= 5.006001) {
|
||||
# let Perl do it
|
||||
$outVal = pack('C0U*', @$uni);
|
||||
} else {
|
||||
# do it ourself
|
||||
$outVal = Image::ExifTool::PackUTF8(@$uni);
|
||||
}
|
||||
$outVal =~ s/\0.*//s; # truncate at null terminator
|
||||
return $outVal;
|
||||
}
|
||||
# get references to forward and inverse lookup tables
|
||||
if ($csType & 0x801) {
|
||||
$conv = LoadCharset($charset);
|
||||
unless ($conv) {
|
||||
$et->Warn("Missing charset $charset") if $et;
|
||||
return '';
|
||||
}
|
||||
$inv = $unicode2byte{$charset};
|
||||
# generate inverse lookup if necessary
|
||||
unless ($inv) {
|
||||
if (not $csType or $csType & 0x802) {
|
||||
$et->Warn("Invalid destination charset $charset") if $et;
|
||||
return '';
|
||||
}
|
||||
# prepare table to convert from Unicode to 1-byte characters
|
||||
my ($char, %inv);
|
||||
foreach $char (keys %$conv) {
|
||||
$inv{$$conv{$char}} = $char;
|
||||
}
|
||||
$inv = $unicode2byte{$charset} = \%inv;
|
||||
}
|
||||
}
|
||||
if ($csType & 0x100) { # 1-byte fixed-width
|
||||
# convert to specified character set
|
||||
foreach (@$uni) {
|
||||
next if $_ < 0x80;
|
||||
$$inv{$_} and $_ = $$inv{$_}, next;
|
||||
# our tables omit 1-byte characters with the same values as Unicode,
|
||||
# so pass them straight through after making sure there isn't a
|
||||
# different character with this byte value
|
||||
next if $_ < 0x100 and not $$conv{$_};
|
||||
$_ = ord('?'); # set invalid characters to '?'
|
||||
if ($et and not $$et{EncodingError}) {
|
||||
$et->Warn("Some character(s) could not be encoded in $charset");
|
||||
$$et{EncodingError} = 1;
|
||||
}
|
||||
}
|
||||
# repack as an 8-bit string and truncate at null
|
||||
$outVal = pack('C*', @$uni);
|
||||
$outVal =~ s/\0.*//s;
|
||||
} else { # 2-byte and 4-byte fixed-width
|
||||
# convert if required
|
||||
if ($inv) {
|
||||
$$inv{$_} and $_ = $$inv{$_} foreach @$uni;
|
||||
}
|
||||
# generate surrogate pairs of UTF-16
|
||||
if ($charset eq 'UTF16') {
|
||||
my $i;
|
||||
for ($i=0; $i<@$uni; ++$i) {
|
||||
next unless $$uni[$i] >= 0x10000 and $$uni[$i] < 0x10ffff;
|
||||
my $t = $$uni[$i] - 0x10000;
|
||||
my $w1 = 0xd800 + (($t >> 10) & 0x3ff);
|
||||
my $w2 = 0xdc00 + ($t & 0x3ff);
|
||||
splice(@$uni, $i, 1, $w1, $w2);
|
||||
++$i; # skip surrogate pair
|
||||
}
|
||||
}
|
||||
# pack as 2- or 4-byte integer in specified byte order
|
||||
my $byteOrder = $_[3] || GetByteOrder();
|
||||
my $fmt = $byteOrder eq 'MM' ? 'n*' : 'v*';
|
||||
$fmt = uc($fmt) if $csType & 0x400;
|
||||
$outVal = pack($fmt, @$uni);
|
||||
}
|
||||
return $outVal;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::Charset - ExifTool character encoding routines
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is required by Image::ExifTool.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains routines used by ExifTool to translate special
|
||||
character sets. Currently, the following character sets are supported:
|
||||
|
||||
UTF8, UTF16, UCS2, UCS4, Arabic, Baltic, Cyrillic, Greek, Hebrew, JIS,
|
||||
Latin, Latin2, DOSLatinUS, DOSLatin1, MacArabic, MacChineseCN,
|
||||
MacChineseTW, MacCroatian, MacCyrillic, MacGreek, MacHebrew, MacIceland,
|
||||
MacJapanese, MacKorean, MacLatin2, MacRSymbol, MacRoman, MacRomanian,
|
||||
MacThai, MacTurkish, PDFDoc, RSymbol, ShiftJIS, Symbol, Thai, Turkish,
|
||||
Vietnam
|
||||
|
||||
However, only some of these character sets are available to the user via
|
||||
ExifTool options -- the multi-byte character sets are used only internally
|
||||
when decoding certain types of information.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,39 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Arabic.pm
|
||||
#
|
||||
# Description: cp1256 to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1256.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::Arabic = (
|
||||
0x80 => 0x20ac, 0x81 => 0x067e, 0x82 => 0x201a, 0x83 => 0x0192,
|
||||
0x84 => 0x201e, 0x85 => 0x2026, 0x86 => 0x2020, 0x87 => 0x2021,
|
||||
0x88 => 0x02c6, 0x89 => 0x2030, 0x8a => 0x0679, 0x8b => 0x2039,
|
||||
0x8c => 0x0152, 0x8d => 0x0686, 0x8e => 0x0698, 0x8f => 0x0688,
|
||||
0x90 => 0x06af, 0x91 => 0x2018, 0x92 => 0x2019, 0x93 => 0x201c,
|
||||
0x94 => 0x201d, 0x95 => 0x2022, 0x96 => 0x2013, 0x97 => 0x2014,
|
||||
0x98 => 0x06a9, 0x99 => 0x2122, 0x9a => 0x0691, 0x9b => 0x203a,
|
||||
0x9c => 0x0153, 0x9d => 0x200c, 0x9e => 0x200d, 0x9f => 0x06ba,
|
||||
0xa1 => 0x060c, 0xaa => 0x06be, 0xba => 0x061b, 0xbf => 0x061f,
|
||||
0xc0 => 0x06c1, 0xc1 => 0x0621, 0xc2 => 0x0622, 0xc3 => 0x0623,
|
||||
0xc4 => 0x0624, 0xc5 => 0x0625, 0xc6 => 0x0626, 0xc7 => 0x0627,
|
||||
0xc8 => 0x0628, 0xc9 => 0x0629, 0xca => 0x062a, 0xcb => 0x062b,
|
||||
0xcc => 0x062c, 0xcd => 0x062d, 0xce => 0x062e, 0xcf => 0x062f,
|
||||
0xd0 => 0x0630, 0xd1 => 0x0631, 0xd2 => 0x0632, 0xd3 => 0x0633,
|
||||
0xd4 => 0x0634, 0xd5 => 0x0635, 0xd6 => 0x0636, 0xd8 => 0x0637,
|
||||
0xd9 => 0x0638, 0xda => 0x0639, 0xdb => 0x063a, 0xdc => 0x0640,
|
||||
0xdd => 0x0641, 0xde => 0x0642, 0xdf => 0x0643, 0xe1 => 0x0644,
|
||||
0xe3 => 0x0645, 0xe4 => 0x0646, 0xe5 => 0x0647, 0xe6 => 0x0648,
|
||||
0xec => 0x0649, 0xed => 0x064a, 0xf0 => 0x064b, 0xf1 => 0x064c,
|
||||
0xf2 => 0x064d, 0xf3 => 0x064e, 0xf5 => 0x064f, 0xf6 => 0x0650,
|
||||
0xf8 => 0x0651, 0xfa => 0x0652, 0xfd => 0x200e, 0xfe => 0x200f,
|
||||
0xff => 0x06d2,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,35 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Baltic.pm
|
||||
#
|
||||
# Description: cp1257 to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1257.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::Baltic = (
|
||||
0x80 => 0x20ac, 0x82 => 0x201a, 0x84 => 0x201e, 0x85 => 0x2026,
|
||||
0x86 => 0x2020, 0x87 => 0x2021, 0x89 => 0x2030, 0x8b => 0x2039, 0x8d => 0xa8,
|
||||
0x8e => 0x02c7, 0x8f => 0xb8, 0x91 => 0x2018, 0x92 => 0x2019, 0x93 => 0x201c,
|
||||
0x94 => 0x201d, 0x95 => 0x2022, 0x96 => 0x2013, 0x97 => 0x2014,
|
||||
0x99 => 0x2122, 0x9b => 0x203a, 0x9d => 0xaf, 0x9e => 0x02db, 0xa8 => 0xd8,
|
||||
0xaa => 0x0156, 0xaf => 0xc6, 0xb8 => 0xf8, 0xba => 0x0157, 0xbf => 0xe6,
|
||||
0xc0 => 0x0104, 0xc1 => 0x012e, 0xc2 => 0x0100, 0xc3 => 0x0106,
|
||||
0xc6 => 0x0118, 0xc7 => 0x0112, 0xc8 => 0x010c, 0xca => 0x0179,
|
||||
0xcb => 0x0116, 0xcc => 0x0122, 0xcd => 0x0136, 0xce => 0x012a,
|
||||
0xcf => 0x013b, 0xd0 => 0x0160, 0xd1 => 0x0143, 0xd2 => 0x0145,
|
||||
0xd4 => 0x014c, 0xd8 => 0x0172, 0xd9 => 0x0141, 0xda => 0x015a,
|
||||
0xdb => 0x016a, 0xdd => 0x017b, 0xde => 0x017d, 0xe0 => 0x0105,
|
||||
0xe1 => 0x012f, 0xe2 => 0x0101, 0xe3 => 0x0107, 0xe6 => 0x0119,
|
||||
0xe7 => 0x0113, 0xe8 => 0x010d, 0xea => 0x017a, 0xeb => 0x0117,
|
||||
0xec => 0x0123, 0xed => 0x0137, 0xee => 0x012b, 0xef => 0x013c,
|
||||
0xf0 => 0x0161, 0xf1 => 0x0144, 0xf2 => 0x0146, 0xf4 => 0x014d,
|
||||
0xf8 => 0x0173, 0xf9 => 0x0142, 0xfa => 0x015b, 0xfb => 0x016b,
|
||||
0xfd => 0x017c, 0xfe => 0x017e, 0xff => 0x02d9,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,45 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Cyrillic.pm
|
||||
#
|
||||
# Description: cp1251 to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1251.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::Cyrillic = (
|
||||
0x80 => 0x0402, 0x81 => 0x0403, 0x82 => 0x201a, 0x83 => 0x0453,
|
||||
0x84 => 0x201e, 0x85 => 0x2026, 0x86 => 0x2020, 0x87 => 0x2021,
|
||||
0x88 => 0x20ac, 0x89 => 0x2030, 0x8a => 0x0409, 0x8b => 0x2039,
|
||||
0x8c => 0x040a, 0x8d => 0x040c, 0x8e => 0x040b, 0x8f => 0x040f,
|
||||
0x90 => 0x0452, 0x91 => 0x2018, 0x92 => 0x2019, 0x93 => 0x201c,
|
||||
0x94 => 0x201d, 0x95 => 0x2022, 0x96 => 0x2013, 0x97 => 0x2014,
|
||||
0x99 => 0x2122, 0x9a => 0x0459, 0x9b => 0x203a, 0x9c => 0x045a,
|
||||
0x9d => 0x045c, 0x9e => 0x045b, 0x9f => 0x045f, 0xa1 => 0x040e,
|
||||
0xa2 => 0x045e, 0xa3 => 0x0408, 0xa5 => 0x0490, 0xa8 => 0x0401,
|
||||
0xaa => 0x0404, 0xaf => 0x0407, 0xb2 => 0x0406, 0xb3 => 0x0456,
|
||||
0xb4 => 0x0491, 0xb8 => 0x0451, 0xb9 => 0x2116, 0xba => 0x0454,
|
||||
0xbc => 0x0458, 0xbd => 0x0405, 0xbe => 0x0455, 0xbf => 0x0457,
|
||||
0xc0 => 0x0410, 0xc1 => 0x0411, 0xc2 => 0x0412, 0xc3 => 0x0413,
|
||||
0xc4 => 0x0414, 0xc5 => 0x0415, 0xc6 => 0x0416, 0xc7 => 0x0417,
|
||||
0xc8 => 0x0418, 0xc9 => 0x0419, 0xca => 0x041a, 0xcb => 0x041b,
|
||||
0xcc => 0x041c, 0xcd => 0x041d, 0xce => 0x041e, 0xcf => 0x041f,
|
||||
0xd0 => 0x0420, 0xd1 => 0x0421, 0xd2 => 0x0422, 0xd3 => 0x0423,
|
||||
0xd4 => 0x0424, 0xd5 => 0x0425, 0xd6 => 0x0426, 0xd7 => 0x0427,
|
||||
0xd8 => 0x0428, 0xd9 => 0x0429, 0xda => 0x042a, 0xdb => 0x042b,
|
||||
0xdc => 0x042c, 0xdd => 0x042d, 0xde => 0x042e, 0xdf => 0x042f,
|
||||
0xe0 => 0x0430, 0xe1 => 0x0431, 0xe2 => 0x0432, 0xe3 => 0x0433,
|
||||
0xe4 => 0x0434, 0xe5 => 0x0435, 0xe6 => 0x0436, 0xe7 => 0x0437,
|
||||
0xe8 => 0x0438, 0xe9 => 0x0439, 0xea => 0x043a, 0xeb => 0x043b,
|
||||
0xec => 0x043c, 0xed => 0x043d, 0xee => 0x043e, 0xef => 0x043f,
|
||||
0xf0 => 0x0440, 0xf1 => 0x0441, 0xf2 => 0x0442, 0xf3 => 0x0443,
|
||||
0xf4 => 0x0444, 0xf5 => 0x0445, 0xf6 => 0x0446, 0xf7 => 0x0447,
|
||||
0xf8 => 0x0448, 0xf9 => 0x0449, 0xfa => 0x044a, 0xfb => 0x044b,
|
||||
0xfc => 0x044c, 0xfd => 0x044d, 0xfe => 0x044e, 0xff => 0x044f,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,49 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: DOSLatin1.pm
|
||||
#
|
||||
# Description: cp850 to Unicode
|
||||
#
|
||||
# Revisions: 2017/10/31- P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/PC/CP850.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::DOSLatin1 = (
|
||||
0x80 => 0x00c7, 0x81 => 0x00fc, 0x82 => 0x00e9, 0x83 => 0x00e2,
|
||||
0x84 => 0x00e4, 0x85 => 0x00e0, 0x86 => 0x00e5, 0x87 => 0x00e7,
|
||||
0x88 => 0x00ea, 0x89 => 0x00eb, 0x8a => 0x00e8, 0x8b => 0x00ef,
|
||||
0x8c => 0x00ee, 0x8d => 0x00ec, 0x8e => 0x00c4, 0x8f => 0x00c5,
|
||||
0x90 => 0x00c9, 0x91 => 0x00e6, 0x92 => 0x00c6, 0x93 => 0x00f4,
|
||||
0x94 => 0x00f6, 0x95 => 0x00f2, 0x96 => 0x00fb, 0x97 => 0x00f9,
|
||||
0x98 => 0x00ff, 0x99 => 0x00d6, 0x9a => 0x00dc, 0x9b => 0x00f8,
|
||||
0x9c => 0x00a3, 0x9d => 0x00d8, 0x9e => 0x00d7, 0x9f => 0x0192,
|
||||
0xa0 => 0x00e1, 0xa1 => 0x00ed, 0xa2 => 0x00f3, 0xa3 => 0x00fa,
|
||||
0xa4 => 0x00f1, 0xa5 => 0x00d1, 0xa6 => 0x00aa, 0xa7 => 0x00ba,
|
||||
0xa8 => 0x00bf, 0xa9 => 0x00ae, 0xaa => 0x00ac, 0xab => 0x00bd,
|
||||
0xac => 0x00bc, 0xad => 0x00a1, 0xae => 0x00ab, 0xaf => 0x00bb,
|
||||
0xb0 => 0x2591, 0xb1 => 0x2592, 0xb2 => 0x2593, 0xb3 => 0x2502,
|
||||
0xb4 => 0x2524, 0xb5 => 0x00c1, 0xb6 => 0x00c2, 0xb7 => 0x00c0,
|
||||
0xb8 => 0x00a9, 0xb9 => 0x2563, 0xba => 0x2551, 0xbb => 0x2557,
|
||||
0xbc => 0x255d, 0xbd => 0x00a2, 0xbe => 0x00a5, 0xbf => 0x2510,
|
||||
0xc0 => 0x2514, 0xc1 => 0x2534, 0xc2 => 0x252c, 0xc3 => 0x251c,
|
||||
0xc4 => 0x2500, 0xc5 => 0x253c, 0xc6 => 0x00e3, 0xc7 => 0x00c3,
|
||||
0xc8 => 0x255a, 0xc9 => 0x2554, 0xca => 0x2569, 0xcb => 0x2566,
|
||||
0xcc => 0x2560, 0xcd => 0x2550, 0xce => 0x256c, 0xcf => 0x00a4,
|
||||
0xd0 => 0x00f0, 0xd1 => 0x00d0, 0xd2 => 0x00ca, 0xd3 => 0x00cb,
|
||||
0xd4 => 0x00c8, 0xd5 => 0x0131, 0xd6 => 0x00cd, 0xd7 => 0x00ce,
|
||||
0xd8 => 0x00cf, 0xd9 => 0x2518, 0xda => 0x250c, 0xdb => 0x2588,
|
||||
0xdc => 0x2584, 0xdd => 0x00a6, 0xde => 0x00cc, 0xdf => 0x2580,
|
||||
0xe0 => 0x00d3, 0xe1 => 0x00df, 0xe2 => 0x00d4, 0xe3 => 0x00d2,
|
||||
0xe4 => 0x00f5, 0xe5 => 0x00d5, 0xe6 => 0x00b5, 0xe7 => 0x00fe,
|
||||
0xe8 => 0x00de, 0xe9 => 0x00da, 0xea => 0x00db, 0xeb => 0x00d9,
|
||||
0xec => 0x00fd, 0xed => 0x00dd, 0xee => 0x00af, 0xef => 0x00b4,
|
||||
0xf0 => 0x00ad, 0xf1 => 0x00b1, 0xf2 => 0x2017, 0xf3 => 0x00be,
|
||||
0xf4 => 0x00b6, 0xf5 => 0x00a7, 0xf6 => 0x00f7, 0xf7 => 0x00b8,
|
||||
0xf8 => 0x00b0, 0xf9 => 0x00a8, 0xfa => 0x00b7, 0xfb => 0x00b9,
|
||||
0xfc => 0x00b3, 0xfd => 0x00b2, 0xfe => 0x25a0, 0xff => 0x00a0,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,49 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: DOSLatinUS.pm
|
||||
#
|
||||
# Description: cp437 to Unicode
|
||||
#
|
||||
# Revisions: 2017/10/31- P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/PC/CP437.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::DOSLatinUS = (
|
||||
0x80 => 0x00c7, 0x81 => 0x00fc, 0x82 => 0x00e9, 0x83 => 0x00e2,
|
||||
0x84 => 0x00e4, 0x85 => 0x00e0, 0x86 => 0x00e5, 0x87 => 0x00e7,
|
||||
0x88 => 0x00ea, 0x89 => 0x00eb, 0x8a => 0x00e8, 0x8b => 0x00ef,
|
||||
0x8c => 0x00ee, 0x8d => 0x00ec, 0x8e => 0x00c4, 0x8f => 0x00c5,
|
||||
0x90 => 0x00c9, 0x91 => 0x00e6, 0x92 => 0x00c6, 0x93 => 0x00f4,
|
||||
0x94 => 0x00f6, 0x95 => 0x00f2, 0x96 => 0x00fb, 0x97 => 0x00f9,
|
||||
0x98 => 0x00ff, 0x99 => 0x00d6, 0x9a => 0x00dc, 0x9b => 0x00a2,
|
||||
0x9c => 0x00a3, 0x9d => 0x00a5, 0x9e => 0x20a7, 0x9f => 0x0192,
|
||||
0xa0 => 0x00e1, 0xa1 => 0x00ed, 0xa2 => 0x00f3, 0xa3 => 0x00fa,
|
||||
0xa4 => 0x00f1, 0xa5 => 0x00d1, 0xa6 => 0x00aa, 0xa7 => 0x00ba,
|
||||
0xa8 => 0x00bf, 0xa9 => 0x2310, 0xaa => 0x00ac, 0xab => 0x00bd,
|
||||
0xac => 0x00bc, 0xad => 0x00a1, 0xae => 0x00ab, 0xaf => 0x00bb,
|
||||
0xb0 => 0x2591, 0xb1 => 0x2592, 0xb2 => 0x2593, 0xb3 => 0x2502,
|
||||
0xb4 => 0x2524, 0xb5 => 0x2561, 0xb6 => 0x2562, 0xb7 => 0x2556,
|
||||
0xb8 => 0x2555, 0xb9 => 0x2563, 0xba => 0x2551, 0xbb => 0x2557,
|
||||
0xbc => 0x255d, 0xbd => 0x255c, 0xbe => 0x255b, 0xbf => 0x2510,
|
||||
0xc0 => 0x2514, 0xc1 => 0x2534, 0xc2 => 0x252c, 0xc3 => 0x251c,
|
||||
0xc4 => 0x2500, 0xc5 => 0x253c, 0xc6 => 0x255e, 0xc7 => 0x255f,
|
||||
0xc8 => 0x255a, 0xc9 => 0x2554, 0xca => 0x2569, 0xcb => 0x2566,
|
||||
0xcc => 0x2560, 0xcd => 0x2550, 0xce => 0x256c, 0xcf => 0x2567,
|
||||
0xd0 => 0x2568, 0xd1 => 0x2564, 0xd2 => 0x2565, 0xd3 => 0x2559,
|
||||
0xd4 => 0x2558, 0xd5 => 0x2552, 0xd6 => 0x2553, 0xd7 => 0x256b,
|
||||
0xd8 => 0x256a, 0xd9 => 0x2518, 0xda => 0x250c, 0xdb => 0x2588,
|
||||
0xdc => 0x2584, 0xdd => 0x258c, 0xde => 0x2590, 0xdf => 0x2580,
|
||||
0xe0 => 0x03b1, 0xe1 => 0x00df, 0xe2 => 0x0393, 0xe3 => 0x03c0,
|
||||
0xe4 => 0x03a3, 0xe5 => 0x03c3, 0xe6 => 0x00b5, 0xe7 => 0x03c4,
|
||||
0xe8 => 0x03a6, 0xe9 => 0x0398, 0xea => 0x03a9, 0xeb => 0x03b4,
|
||||
0xec => 0x221e, 0xed => 0x03c6, 0xee => 0x03b5, 0xef => 0x2229,
|
||||
0xf0 => 0x2261, 0xf1 => 0x00b1, 0xf2 => 0x2265, 0xf3 => 0x2264,
|
||||
0xf4 => 0x2320, 0xf5 => 0x2321, 0xf6 => 0x00f7, 0xf7 => 0x2248,
|
||||
0xf8 => 0x00b0, 0xf9 => 0x2219, 0xfa => 0x00b7, 0xfb => 0x221a,
|
||||
0xfc => 0x207f, 0xfd => 0x00b2, 0xfe => 0x25a0, 0xff => 0x00a0,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,40 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Greek.pm
|
||||
#
|
||||
# Description: cp1253 to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1253.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::Greek = (
|
||||
0x80 => 0x20ac, 0x82 => 0x201a, 0x83 => 0x0192, 0x84 => 0x201e,
|
||||
0x85 => 0x2026, 0x86 => 0x2020, 0x87 => 0x2021, 0x89 => 0x2030,
|
||||
0x8b => 0x2039, 0x91 => 0x2018, 0x92 => 0x2019, 0x93 => 0x201c,
|
||||
0x94 => 0x201d, 0x95 => 0x2022, 0x96 => 0x2013, 0x97 => 0x2014,
|
||||
0x99 => 0x2122, 0x9b => 0x203a, 0xa1 => 0x0385, 0xa2 => 0x0386,
|
||||
0xaf => 0x2015, 0xb4 => 0x0384, 0xb8 => 0x0388, 0xb9 => 0x0389,
|
||||
0xba => 0x038a, 0xbc => 0x038c, 0xbe => 0x038e, 0xbf => 0x038f,
|
||||
0xc0 => 0x0390, 0xc1 => 0x0391, 0xc2 => 0x0392, 0xc3 => 0x0393,
|
||||
0xc4 => 0x0394, 0xc5 => 0x0395, 0xc6 => 0x0396, 0xc7 => 0x0397,
|
||||
0xc8 => 0x0398, 0xc9 => 0x0399, 0xca => 0x039a, 0xcb => 0x039b,
|
||||
0xcc => 0x039c, 0xcd => 0x039d, 0xce => 0x039e, 0xcf => 0x039f,
|
||||
0xd0 => 0x03a0, 0xd1 => 0x03a1, 0xd3 => 0x03a3, 0xd4 => 0x03a4,
|
||||
0xd5 => 0x03a5, 0xd6 => 0x03a6, 0xd7 => 0x03a7, 0xd8 => 0x03a8,
|
||||
0xd9 => 0x03a9, 0xda => 0x03aa, 0xdb => 0x03ab, 0xdc => 0x03ac,
|
||||
0xdd => 0x03ad, 0xde => 0x03ae, 0xdf => 0x03af, 0xe0 => 0x03b0,
|
||||
0xe1 => 0x03b1, 0xe2 => 0x03b2, 0xe3 => 0x03b3, 0xe4 => 0x03b4,
|
||||
0xe5 => 0x03b5, 0xe6 => 0x03b6, 0xe7 => 0x03b7, 0xe8 => 0x03b8,
|
||||
0xe9 => 0x03b9, 0xea => 0x03ba, 0xeb => 0x03bb, 0xec => 0x03bc,
|
||||
0xed => 0x03bd, 0xee => 0x03be, 0xef => 0x03bf, 0xf0 => 0x03c0,
|
||||
0xf1 => 0x03c1, 0xf2 => 0x03c2, 0xf3 => 0x03c3, 0xf4 => 0x03c4,
|
||||
0xf5 => 0x03c5, 0xf6 => 0x03c6, 0xf7 => 0x03c7, 0xf8 => 0x03c8,
|
||||
0xf9 => 0x03c9, 0xfa => 0x03ca, 0xfb => 0x03cb, 0xfc => 0x03cc,
|
||||
0xfd => 0x03cd, 0xfe => 0x03ce,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,36 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Hebrew.pm
|
||||
#
|
||||
# Description: cp1255 to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1255.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::Hebrew = (
|
||||
0x80 => 0x20ac, 0x82 => 0x201a, 0x83 => 0x0192, 0x84 => 0x201e,
|
||||
0x85 => 0x2026, 0x86 => 0x2020, 0x87 => 0x2021, 0x88 => 0x02c6,
|
||||
0x89 => 0x2030, 0x8b => 0x2039, 0x91 => 0x2018, 0x92 => 0x2019,
|
||||
0x93 => 0x201c, 0x94 => 0x201d, 0x95 => 0x2022, 0x96 => 0x2013,
|
||||
0x97 => 0x2014, 0x98 => 0x02dc, 0x99 => 0x2122, 0x9b => 0x203a,
|
||||
0xa4 => 0x20aa, 0xaa => 0xd7, 0xba => 0xf7, 0xc0 => 0x05b0, 0xc1 => 0x05b1,
|
||||
0xc2 => 0x05b2, 0xc3 => 0x05b3, 0xc4 => 0x05b4, 0xc5 => 0x05b5,
|
||||
0xc6 => 0x05b6, 0xc7 => 0x05b7, 0xc8 => 0x05b8, 0xc9 => 0x05b9,
|
||||
0xcb => 0x05bb, 0xcc => 0x05bc, 0xcd => 0x05bd, 0xce => 0x05be,
|
||||
0xcf => 0x05bf, 0xd0 => 0x05c0, 0xd1 => 0x05c1, 0xd2 => 0x05c2,
|
||||
0xd3 => 0x05c3, 0xd4 => 0x05f0, 0xd5 => 0x05f1, 0xd6 => 0x05f2,
|
||||
0xd7 => 0x05f3, 0xd8 => 0x05f4, 0xe0 => 0x05d0, 0xe1 => 0x05d1,
|
||||
0xe2 => 0x05d2, 0xe3 => 0x05d3, 0xe4 => 0x05d4, 0xe5 => 0x05d5,
|
||||
0xe6 => 0x05d6, 0xe7 => 0x05d7, 0xe8 => 0x05d8, 0xe9 => 0x05d9,
|
||||
0xea => 0x05da, 0xeb => 0x05db, 0xec => 0x05dc, 0xed => 0x05dd,
|
||||
0xee => 0x05de, 0xef => 0x05df, 0xf0 => 0x05e0, 0xf1 => 0x05e1,
|
||||
0xf2 => 0x05e2, 0xf3 => 0x05e3, 0xf4 => 0x05e4, 0xf5 => 0x05e5,
|
||||
0xf6 => 0x05e6, 0xf7 => 0x05e7, 0xf8 => 0x05e8, 0xf9 => 0x05e9,
|
||||
0xfa => 0x05ea, 0xfd => 0x200e, 0xfe => 0x200f,
|
||||
);
|
||||
|
||||
1; # end
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,24 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Latin.pm
|
||||
#
|
||||
# Description: cp1252 to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1252.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::Latin = (
|
||||
0x80 => 0x20ac, 0x82 => 0x201a, 0x83 => 0x0192, 0x84 => 0x201e,
|
||||
0x85 => 0x2026, 0x86 => 0x2020, 0x87 => 0x2021, 0x88 => 0x02c6,
|
||||
0x89 => 0x2030, 0x8a => 0x0160, 0x8b => 0x2039, 0x8c => 0x0152,
|
||||
0x8e => 0x017d, 0x91 => 0x2018, 0x92 => 0x2019, 0x93 => 0x201c,
|
||||
0x94 => 0x201d, 0x95 => 0x2022, 0x96 => 0x2013, 0x97 => 0x2014,
|
||||
0x98 => 0x02dc, 0x99 => 0x2122, 0x9a => 0x0161, 0x9b => 0x203a,
|
||||
0x9c => 0x0153, 0x9e => 0x017e, 0x9f => 0x0178,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,36 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Latin2.pm
|
||||
#
|
||||
# Description: cp1250 to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1250.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::Latin2 = (
|
||||
0x80 => 0x20ac, 0x82 => 0x201a, 0x84 => 0x201e, 0x85 => 0x2026,
|
||||
0x86 => 0x2020, 0x87 => 0x2021, 0x89 => 0x2030, 0x8a => 0x0160,
|
||||
0x8b => 0x2039, 0x8c => 0x015a, 0x8d => 0x0164, 0x8e => 0x017d,
|
||||
0x8f => 0x0179, 0x91 => 0x2018, 0x92 => 0x2019, 0x93 => 0x201c,
|
||||
0x94 => 0x201d, 0x95 => 0x2022, 0x96 => 0x2013, 0x97 => 0x2014,
|
||||
0x99 => 0x2122, 0x9a => 0x0161, 0x9b => 0x203a, 0x9c => 0x015b,
|
||||
0x9d => 0x0165, 0x9e => 0x017e, 0x9f => 0x017a, 0xa1 => 0x02c7,
|
||||
0xa2 => 0x02d8, 0xa3 => 0x0141, 0xa5 => 0x0104, 0xaa => 0x015e,
|
||||
0xaf => 0x017b, 0xb2 => 0x02db, 0xb3 => 0x0142, 0xb9 => 0x0105,
|
||||
0xba => 0x015f, 0xbc => 0x013d, 0xbd => 0x02dd, 0xbe => 0x013e,
|
||||
0xbf => 0x017c, 0xc0 => 0x0154, 0xc3 => 0x0102, 0xc5 => 0x0139,
|
||||
0xc6 => 0x0106, 0xc8 => 0x010c, 0xca => 0x0118, 0xcc => 0x011a,
|
||||
0xcf => 0x010e, 0xd0 => 0x0110, 0xd1 => 0x0143, 0xd2 => 0x0147,
|
||||
0xd5 => 0x0150, 0xd8 => 0x0158, 0xd9 => 0x016e, 0xdb => 0x0170,
|
||||
0xde => 0x0162, 0xe0 => 0x0155, 0xe3 => 0x0103, 0xe5 => 0x013a,
|
||||
0xe6 => 0x0107, 0xe8 => 0x010d, 0xea => 0x0119, 0xec => 0x011b,
|
||||
0xef => 0x010f, 0xf0 => 0x0111, 0xf1 => 0x0144, 0xf2 => 0x0148,
|
||||
0xf5 => 0x0151, 0xf8 => 0x0159, 0xf9 => 0x016f, 0xfb => 0x0171,
|
||||
0xfe => 0x0163, 0xff => 0x02d9,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,47 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: MacArabic.pm
|
||||
#
|
||||
# Description: Mac Arabic to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/ARABIC.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
# and directional characters are ignored
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::MacArabic = (
|
||||
0x80 => 0xc4, 0x81 => 0xa0, 0x82 => 0xc7, 0x83 => 0xc9, 0x84 => 0xd1,
|
||||
0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0xe1, 0x88 => 0xe0, 0x89 => 0xe2,
|
||||
0x8a => 0xe4, 0x8b => 0x06ba, 0x8c => 0xab, 0x8d => 0xe7, 0x8e => 0xe9,
|
||||
0x8f => 0xe8, 0x90 => 0xea, 0x91 => 0xeb, 0x92 => 0xed, 0x93 => 0x2026,
|
||||
0x94 => 0xee, 0x95 => 0xef, 0x96 => 0xf1, 0x97 => 0xf3, 0x98 => 0xbb,
|
||||
0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xf7, 0x9c => 0xfa, 0x9d => 0xf9,
|
||||
0x9e => 0xfb, 0x9f => 0xfc, 0xa0 => 0x20, 0xa1 => 0x21, 0xa2 => 0x22,
|
||||
0xa3 => 0x23, 0xa4 => 0x24, 0xa5 => 0x066a, 0xa6 => 0x26, 0xa7 => 0x27,
|
||||
0xa8 => 0x28, 0xa9 => 0x29, 0xaa => 0x2a, 0xab => 0x2b, 0xac => 0x060c,
|
||||
0xad => 0x2d, 0xae => 0x2e, 0xaf => 0x2f, 0xb0 => 0x0660, 0xb1 => 0x0661,
|
||||
0xb2 => 0x0662, 0xb3 => 0x0663, 0xb4 => 0x0664, 0xb5 => 0x0665,
|
||||
0xb6 => 0x0666, 0xb7 => 0x0667, 0xb8 => 0x0668, 0xb9 => 0x0669, 0xba => 0x3a,
|
||||
0xbb => 0x061b, 0xbc => 0x3c, 0xbd => 0x3d, 0xbe => 0x3e, 0xbf => 0x061f,
|
||||
0xc0 => 0x274a, 0xc1 => 0x0621, 0xc2 => 0x0622, 0xc3 => 0x0623,
|
||||
0xc4 => 0x0624, 0xc5 => 0x0625, 0xc6 => 0x0626, 0xc7 => 0x0627,
|
||||
0xc8 => 0x0628, 0xc9 => 0x0629, 0xca => 0x062a, 0xcb => 0x062b,
|
||||
0xcc => 0x062c, 0xcd => 0x062d, 0xce => 0x062e, 0xcf => 0x062f,
|
||||
0xd0 => 0x0630, 0xd1 => 0x0631, 0xd2 => 0x0632, 0xd3 => 0x0633,
|
||||
0xd4 => 0x0634, 0xd5 => 0x0635, 0xd6 => 0x0636, 0xd7 => 0x0637,
|
||||
0xd8 => 0x0638, 0xd9 => 0x0639, 0xda => 0x063a, 0xdb => 0x5b, 0xdc => 0x5c,
|
||||
0xdd => 0x5d, 0xde => 0x5e, 0xdf => 0x5f, 0xe0 => 0x0640, 0xe1 => 0x0641,
|
||||
0xe2 => 0x0642, 0xe3 => 0x0643, 0xe4 => 0x0644, 0xe5 => 0x0645,
|
||||
0xe6 => 0x0646, 0xe7 => 0x0647, 0xe8 => 0x0648, 0xe9 => 0x0649,
|
||||
0xea => 0x064a, 0xeb => 0x064b, 0xec => 0x064c, 0xed => 0x064d,
|
||||
0xee => 0x064e, 0xef => 0x064f, 0xf0 => 0x0650, 0xf1 => 0x0651,
|
||||
0xf2 => 0x0652, 0xf3 => 0x067e, 0xf4 => 0x0679, 0xf5 => 0x0686,
|
||||
0xf6 => 0x06d5, 0xf7 => 0x06a4, 0xf8 => 0x06af, 0xf9 => 0x0688,
|
||||
0xfa => 0x0691, 0xfb => 0x7b, 0xfc => 0x7c, 0xfd => 0x7d, 0xfe => 0x0698,
|
||||
0xff => 0x06d2,
|
||||
);
|
||||
|
||||
1; # end
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,43 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: MacCroatian.pm
|
||||
#
|
||||
# Description: Mac Croatian to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/CROATIAN.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::MacCroatian = (
|
||||
0x80 => 0xc4, 0x81 => 0xc5, 0x82 => 0xc7, 0x83 => 0xc9, 0x84 => 0xd1,
|
||||
0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0xe1, 0x88 => 0xe0, 0x89 => 0xe2,
|
||||
0x8a => 0xe4, 0x8b => 0xe3, 0x8c => 0xe5, 0x8d => 0xe7, 0x8e => 0xe9,
|
||||
0x8f => 0xe8, 0x90 => 0xea, 0x91 => 0xeb, 0x92 => 0xed, 0x93 => 0xec,
|
||||
0x94 => 0xee, 0x95 => 0xef, 0x96 => 0xf1, 0x97 => 0xf3, 0x98 => 0xf2,
|
||||
0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xf5, 0x9c => 0xfa, 0x9d => 0xf9,
|
||||
0x9e => 0xfb, 0x9f => 0xfc, 0xa0 => 0x2020, 0xa1 => 0xb0, 0xa4 => 0xa7,
|
||||
0xa5 => 0x2022, 0xa6 => 0xb6, 0xa7 => 0xdf, 0xa8 => 0xae, 0xa9 => 0x0160,
|
||||
0xaa => 0x2122, 0xab => 0xb4, 0xac => 0xa8, 0xad => 0x2260, 0xae => 0x017d,
|
||||
0xaf => 0xd8, 0xb0 => 0x221e, 0xb2 => 0x2264, 0xb3 => 0x2265, 0xb4 => 0x2206,
|
||||
0xb6 => 0x2202, 0xb7 => 0x2211, 0xb8 => 0x220f, 0xb9 => 0x0161,
|
||||
0xba => 0x222b, 0xbb => 0xaa, 0xbc => 0xba, 0xbd => 0x03a9, 0xbe => 0x017e,
|
||||
0xbf => 0xf8, 0xc0 => 0xbf, 0xc1 => 0xa1, 0xc2 => 0xac, 0xc3 => 0x221a,
|
||||
0xc4 => 0x0192, 0xc5 => 0x2248, 0xc6 => 0x0106, 0xc7 => 0xab, 0xc8 => 0x010c,
|
||||
0xc9 => 0x2026, 0xca => 0xa0, 0xcb => 0xc0, 0xcc => 0xc3, 0xcd => 0xd5,
|
||||
0xce => 0x0152, 0xcf => 0x0153, 0xd0 => 0x0110, 0xd1 => 0x2014,
|
||||
0xd2 => 0x201c, 0xd3 => 0x201d, 0xd4 => 0x2018, 0xd5 => 0x2019, 0xd6 => 0xf7,
|
||||
0xd7 => 0x25ca, 0xd8 => 0xf8ff, 0xd9 => 0xa9, 0xda => 0x2044, 0xdb => 0x20ac,
|
||||
0xdc => 0x2039, 0xdd => 0x203a, 0xde => 0xc6, 0xdf => 0xbb, 0xe0 => 0x2013,
|
||||
0xe1 => 0xb7, 0xe2 => 0x201a, 0xe3 => 0x201e, 0xe4 => 0x2030, 0xe5 => 0xc2,
|
||||
0xe6 => 0x0107, 0xe7 => 0xc1, 0xe8 => 0x010d, 0xe9 => 0xc8, 0xea => 0xcd,
|
||||
0xeb => 0xce, 0xec => 0xcf, 0xed => 0xcc, 0xee => 0xd3, 0xef => 0xd4,
|
||||
0xf0 => 0x0111, 0xf1 => 0xd2, 0xf2 => 0xda, 0xf3 => 0xdb, 0xf4 => 0xd9,
|
||||
0xf5 => 0x0131, 0xf6 => 0x02c6, 0xf7 => 0x02dc, 0xf8 => 0xaf, 0xf9 => 0x03c0,
|
||||
0xfa => 0xcb, 0xfb => 0x02da, 0xfc => 0xb8, 0xfd => 0xca, 0xfe => 0xe6,
|
||||
0xff => 0x02c7,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,47 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: MacCyrillic.pm
|
||||
#
|
||||
# Description: Mac Cyrillic to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/CYRILLIC.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::MacCyrillic = (
|
||||
0x80 => 0x0410, 0x81 => 0x0411, 0x82 => 0x0412, 0x83 => 0x0413,
|
||||
0x84 => 0x0414, 0x85 => 0x0415, 0x86 => 0x0416, 0x87 => 0x0417,
|
||||
0x88 => 0x0418, 0x89 => 0x0419, 0x8a => 0x041a, 0x8b => 0x041b,
|
||||
0x8c => 0x041c, 0x8d => 0x041d, 0x8e => 0x041e, 0x8f => 0x041f,
|
||||
0x90 => 0x0420, 0x91 => 0x0421, 0x92 => 0x0422, 0x93 => 0x0423,
|
||||
0x94 => 0x0424, 0x95 => 0x0425, 0x96 => 0x0426, 0x97 => 0x0427,
|
||||
0x98 => 0x0428, 0x99 => 0x0429, 0x9a => 0x042a, 0x9b => 0x042b,
|
||||
0x9c => 0x042c, 0x9d => 0x042d, 0x9e => 0x042e, 0x9f => 0x042f,
|
||||
0xa0 => 0x2020, 0xa1 => 0xb0, 0xa2 => 0x0490, 0xa4 => 0xa7, 0xa5 => 0x2022,
|
||||
0xa6 => 0xb6, 0xa7 => 0x0406, 0xa8 => 0xae, 0xaa => 0x2122, 0xab => 0x0402,
|
||||
0xac => 0x0452, 0xad => 0x2260, 0xae => 0x0403, 0xaf => 0x0453,
|
||||
0xb0 => 0x221e, 0xb2 => 0x2264, 0xb3 => 0x2265, 0xb4 => 0x0456,
|
||||
0xb6 => 0x0491, 0xb7 => 0x0408, 0xb8 => 0x0404, 0xb9 => 0x0454,
|
||||
0xba => 0x0407, 0xbb => 0x0457, 0xbc => 0x0409, 0xbd => 0x0459,
|
||||
0xbe => 0x040a, 0xbf => 0x045a, 0xc0 => 0x0458, 0xc1 => 0x0405, 0xc2 => 0xac,
|
||||
0xc3 => 0x221a, 0xc4 => 0x0192, 0xc5 => 0x2248, 0xc6 => 0x2206, 0xc7 => 0xab,
|
||||
0xc8 => 0xbb, 0xc9 => 0x2026, 0xca => 0xa0, 0xcb => 0x040b, 0xcc => 0x045b,
|
||||
0xcd => 0x040c, 0xce => 0x045c, 0xcf => 0x0455, 0xd0 => 0x2013,
|
||||
0xd1 => 0x2014, 0xd2 => 0x201c, 0xd3 => 0x201d, 0xd4 => 0x2018,
|
||||
0xd5 => 0x2019, 0xd6 => 0xf7, 0xd7 => 0x201e, 0xd8 => 0x040e, 0xd9 => 0x045e,
|
||||
0xda => 0x040f, 0xdb => 0x045f, 0xdc => 0x2116, 0xdd => 0x0401,
|
||||
0xde => 0x0451, 0xdf => 0x044f, 0xe0 => 0x0430, 0xe1 => 0x0431,
|
||||
0xe2 => 0x0432, 0xe3 => 0x0433, 0xe4 => 0x0434, 0xe5 => 0x0435,
|
||||
0xe6 => 0x0436, 0xe7 => 0x0437, 0xe8 => 0x0438, 0xe9 => 0x0439,
|
||||
0xea => 0x043a, 0xeb => 0x043b, 0xec => 0x043c, 0xed => 0x043d,
|
||||
0xee => 0x043e, 0xef => 0x043f, 0xf0 => 0x0440, 0xf1 => 0x0441,
|
||||
0xf2 => 0x0442, 0xf3 => 0x0443, 0xf4 => 0x0444, 0xf5 => 0x0445,
|
||||
0xf6 => 0x0446, 0xf7 => 0x0447, 0xf8 => 0x0448, 0xf9 => 0x0449,
|
||||
0xfa => 0x044a, 0xfb => 0x044b, 0xfc => 0x044c, 0xfd => 0x044d,
|
||||
0xfe => 0x044e, 0xff => 0x20ac,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,45 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: MacGreek.pm
|
||||
#
|
||||
# Description: Mac Greek to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/GREEK.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::MacGreek = (
|
||||
0x80 => 0xc4, 0x81 => 0xb9, 0x82 => 0xb2, 0x83 => 0xc9, 0x84 => 0xb3,
|
||||
0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0x0385, 0x88 => 0xe0, 0x89 => 0xe2,
|
||||
0x8a => 0xe4, 0x8b => 0x0384, 0x8c => 0xa8, 0x8d => 0xe7, 0x8e => 0xe9,
|
||||
0x8f => 0xe8, 0x90 => 0xea, 0x91 => 0xeb, 0x92 => 0xa3, 0x93 => 0x2122,
|
||||
0x94 => 0xee, 0x95 => 0xef, 0x96 => 0x2022, 0x97 => 0xbd, 0x98 => 0x2030,
|
||||
0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xa6, 0x9c => 0x20ac, 0x9d => 0xf9,
|
||||
0x9e => 0xfb, 0x9f => 0xfc, 0xa0 => 0x2020, 0xa1 => 0x0393, 0xa2 => 0x0394,
|
||||
0xa3 => 0x0398, 0xa4 => 0x039b, 0xa5 => 0x039e, 0xa6 => 0x03a0, 0xa7 => 0xdf,
|
||||
0xa8 => 0xae, 0xaa => 0x03a3, 0xab => 0x03aa, 0xac => 0xa7, 0xad => 0x2260,
|
||||
0xae => 0xb0, 0xaf => 0xb7, 0xb0 => 0x0391, 0xb2 => 0x2264, 0xb3 => 0x2265,
|
||||
0xb4 => 0xa5, 0xb5 => 0x0392, 0xb6 => 0x0395, 0xb7 => 0x0396, 0xb8 => 0x0397,
|
||||
0xb9 => 0x0399, 0xba => 0x039a, 0xbb => 0x039c, 0xbc => 0x03a6,
|
||||
0xbd => 0x03ab, 0xbe => 0x03a8, 0xbf => 0x03a9, 0xc0 => 0x03ac,
|
||||
0xc1 => 0x039d, 0xc2 => 0xac, 0xc3 => 0x039f, 0xc4 => 0x03a1, 0xc5 => 0x2248,
|
||||
0xc6 => 0x03a4, 0xc7 => 0xab, 0xc8 => 0xbb, 0xc9 => 0x2026, 0xca => 0xa0,
|
||||
0xcb => 0x03a5, 0xcc => 0x03a7, 0xcd => 0x0386, 0xce => 0x0388,
|
||||
0xcf => 0x0153, 0xd0 => 0x2013, 0xd1 => 0x2015, 0xd2 => 0x201c,
|
||||
0xd3 => 0x201d, 0xd4 => 0x2018, 0xd5 => 0x2019, 0xd6 => 0xf7, 0xd7 => 0x0389,
|
||||
0xd8 => 0x038a, 0xd9 => 0x038c, 0xda => 0x038e, 0xdb => 0x03ad,
|
||||
0xdc => 0x03ae, 0xdd => 0x03af, 0xde => 0x03cc, 0xdf => 0x038f,
|
||||
0xe0 => 0x03cd, 0xe1 => 0x03b1, 0xe2 => 0x03b2, 0xe3 => 0x03c8,
|
||||
0xe4 => 0x03b4, 0xe5 => 0x03b5, 0xe6 => 0x03c6, 0xe7 => 0x03b3,
|
||||
0xe8 => 0x03b7, 0xe9 => 0x03b9, 0xea => 0x03be, 0xeb => 0x03ba,
|
||||
0xec => 0x03bb, 0xed => 0x03bc, 0xee => 0x03bd, 0xef => 0x03bf,
|
||||
0xf0 => 0x03c0, 0xf1 => 0x03ce, 0xf2 => 0x03c1, 0xf3 => 0x03c3,
|
||||
0xf4 => 0x03c4, 0xf5 => 0x03b8, 0xf6 => 0x03c9, 0xf7 => 0x03c2,
|
||||
0xf8 => 0x03c7, 0xf9 => 0x03c5, 0xfa => 0x03b6, 0xfb => 0x03ca,
|
||||
0xfc => 0x03cb, 0xfd => 0x0390, 0xfe => 0x03b0, 0xff => 0xad,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,47 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: MacHebrew.pm
|
||||
#
|
||||
# Description: Mac Hebrew to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/HEBREW.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
# and directional characters are ignored
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::MacHebrew = (
|
||||
0x80 => 0xc4, 0x81 => [0x05f2,0x05b7], 0x82 => 0xc7, 0x83 => 0xc9,
|
||||
0x84 => 0xd1, 0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0xe1, 0x88 => 0xe0,
|
||||
0x89 => 0xe2, 0x8a => 0xe4, 0x8b => 0xe3, 0x8c => 0xe5, 0x8d => 0xe7,
|
||||
0x8e => 0xe9, 0x8f => 0xe8, 0x90 => 0xea, 0x91 => 0xeb, 0x92 => 0xed,
|
||||
0x93 => 0xec, 0x94 => 0xee, 0x95 => 0xef, 0x96 => 0xf1, 0x97 => 0xf3,
|
||||
0x98 => 0xf2, 0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xf5, 0x9c => 0xfa,
|
||||
0x9d => 0xf9, 0x9e => 0xfb, 0x9f => 0xfc, 0xa0 => 0x20, 0xa1 => 0x21,
|
||||
0xa2 => 0x22, 0xa3 => 0x23, 0xa4 => 0x24, 0xa5 => 0x25, 0xa6 => 0x20aa,
|
||||
0xa7 => 0x27, 0xa8 => 0x29, 0xa9 => 0x28, 0xaa => 0x2a, 0xab => 0x2b,
|
||||
0xac => 0x2c, 0xad => 0x2d, 0xae => 0x2e, 0xaf => 0x2f, 0xb0 => 0x30,
|
||||
0xb1 => 0x31, 0xb2 => 0x32, 0xb3 => 0x33, 0xb4 => 0x34, 0xb5 => 0x35,
|
||||
0xb6 => 0x36, 0xb7 => 0x37, 0xb8 => 0x38, 0xb9 => 0x39, 0xba => 0x3a,
|
||||
0xbb => 0x3b, 0xbc => 0x3c, 0xbd => 0x3d, 0xbe => 0x3e, 0xbf => 0x3f,
|
||||
0xc0 => [0xf86a,0x05dc,0x05b9], 0xc1 => 0x201e, 0xc2 => 0xf89b,
|
||||
0xc3 => 0xf89c, 0xc4 => 0xf89d, 0xc5 => 0xf89e, 0xc6 => 0x05bc,
|
||||
0xc7 => 0xfb4b, 0xc8 => 0xfb35, 0xc9 => 0x2026, 0xca => 0xa0, 0xcb => 0x05b8,
|
||||
0xcc => 0x05b7, 0xcd => 0x05b5, 0xce => 0x05b6, 0xcf => 0x05b4,
|
||||
0xd0 => 0x2013, 0xd1 => 0x2014, 0xd2 => 0x201c, 0xd3 => 0x201d,
|
||||
0xd4 => 0x2018, 0xd5 => 0x2019, 0xd6 => 0xfb2a, 0xd7 => 0xfb2b,
|
||||
0xd8 => 0x05bf, 0xd9 => 0x05b0, 0xda => 0x05b2, 0xdb => 0x05b1,
|
||||
0xdc => 0x05bb, 0xdd => 0x05b9, 0xde => [0x05b8,0xf87f], 0xdf => 0x05b3,
|
||||
0xe0 => 0x05d0, 0xe1 => 0x05d1, 0xe2 => 0x05d2, 0xe3 => 0x05d3,
|
||||
0xe4 => 0x05d4, 0xe5 => 0x05d5, 0xe6 => 0x05d6, 0xe7 => 0x05d7,
|
||||
0xe8 => 0x05d8, 0xe9 => 0x05d9, 0xea => 0x05da, 0xeb => 0x05db,
|
||||
0xec => 0x05dc, 0xed => 0x05dd, 0xee => 0x05de, 0xef => 0x05df,
|
||||
0xf0 => 0x05e0, 0xf1 => 0x05e1, 0xf2 => 0x05e2, 0xf3 => 0x05e3,
|
||||
0xf4 => 0x05e4, 0xf5 => 0x05e5, 0xf6 => 0x05e6, 0xf7 => 0x05e7,
|
||||
0xf8 => 0x05e8, 0xf9 => 0x05e9, 0xfa => 0x05ea, 0xfb => 0x7d, 0xfc => 0x5d,
|
||||
0xfd => 0x7b, 0xfe => 0x5b, 0xff => 0x7c,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,42 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: MacIceland.pm
|
||||
#
|
||||
# Description: Mac Icelandic to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/ICELAND.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::MacIceland = (
|
||||
0x80 => 0xc4, 0x81 => 0xc5, 0x82 => 0xc7, 0x83 => 0xc9, 0x84 => 0xd1,
|
||||
0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0xe1, 0x88 => 0xe0, 0x89 => 0xe2,
|
||||
0x8a => 0xe4, 0x8b => 0xe3, 0x8c => 0xe5, 0x8d => 0xe7, 0x8e => 0xe9,
|
||||
0x8f => 0xe8, 0x90 => 0xea, 0x91 => 0xeb, 0x92 => 0xed, 0x93 => 0xec,
|
||||
0x94 => 0xee, 0x95 => 0xef, 0x96 => 0xf1, 0x97 => 0xf3, 0x98 => 0xf2,
|
||||
0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xf5, 0x9c => 0xfa, 0x9d => 0xf9,
|
||||
0x9e => 0xfb, 0x9f => 0xfc, 0xa0 => 0xdd, 0xa1 => 0xb0, 0xa4 => 0xa7,
|
||||
0xa5 => 0x2022, 0xa6 => 0xb6, 0xa7 => 0xdf, 0xa8 => 0xae, 0xaa => 0x2122,
|
||||
0xab => 0xb4, 0xac => 0xa8, 0xad => 0x2260, 0xae => 0xc6, 0xaf => 0xd8,
|
||||
0xb0 => 0x221e, 0xb2 => 0x2264, 0xb3 => 0x2265, 0xb4 => 0xa5, 0xb6 => 0x2202,
|
||||
0xb7 => 0x2211, 0xb8 => 0x220f, 0xb9 => 0x03c0, 0xba => 0x222b, 0xbb => 0xaa,
|
||||
0xbc => 0xba, 0xbd => 0x03a9, 0xbe => 0xe6, 0xbf => 0xf8, 0xc0 => 0xbf,
|
||||
0xc1 => 0xa1, 0xc2 => 0xac, 0xc3 => 0x221a, 0xc4 => 0x0192, 0xc5 => 0x2248,
|
||||
0xc6 => 0x2206, 0xc7 => 0xab, 0xc8 => 0xbb, 0xc9 => 0x2026, 0xca => 0xa0,
|
||||
0xcb => 0xc0, 0xcc => 0xc3, 0xcd => 0xd5, 0xce => 0x0152, 0xcf => 0x0153,
|
||||
0xd0 => 0x2013, 0xd1 => 0x2014, 0xd2 => 0x201c, 0xd3 => 0x201d,
|
||||
0xd4 => 0x2018, 0xd5 => 0x2019, 0xd6 => 0xf7, 0xd7 => 0x25ca, 0xd8 => 0xff,
|
||||
0xd9 => 0x0178, 0xda => 0x2044, 0xdb => 0x20ac, 0xdc => 0xd0, 0xdd => 0xf0,
|
||||
0xdf => 0xfe, 0xe0 => 0xfd, 0xe1 => 0xb7, 0xe2 => 0x201a, 0xe3 => 0x201e,
|
||||
0xe4 => 0x2030, 0xe5 => 0xc2, 0xe6 => 0xca, 0xe7 => 0xc1, 0xe8 => 0xcb,
|
||||
0xe9 => 0xc8, 0xea => 0xcd, 0xeb => 0xce, 0xec => 0xcf, 0xed => 0xcc,
|
||||
0xee => 0xd3, 0xef => 0xd4, 0xf0 => 0xf8ff, 0xf1 => 0xd2, 0xf2 => 0xda,
|
||||
0xf3 => 0xdb, 0xf4 => 0xd9, 0xf5 => 0x0131, 0xf6 => 0x02c6, 0xf7 => 0x02dc,
|
||||
0xf8 => 0xaf, 0xf9 => 0x02d8, 0xfa => 0x02d9, 0xfb => 0x02da, 0xfc => 0xb8,
|
||||
0xfd => 0x02dd, 0xfe => 0x02db, 0xff => 0x02c7,
|
||||
);
|
||||
|
||||
1; # end
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,44 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: MacLatin2.pm
|
||||
#
|
||||
# Description: Mac Central European to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/CENTEURO.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::MacLatin2 = (
|
||||
0x80 => 0xc4, 0x81 => 0x0100, 0x82 => 0x0101, 0x83 => 0xc9, 0x84 => 0x0104,
|
||||
0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0xe1, 0x88 => 0x0105, 0x89 => 0x010c,
|
||||
0x8a => 0xe4, 0x8b => 0x010d, 0x8c => 0x0106, 0x8d => 0x0107, 0x8e => 0xe9,
|
||||
0x8f => 0x0179, 0x90 => 0x017a, 0x91 => 0x010e, 0x92 => 0xed, 0x93 => 0x010f,
|
||||
0x94 => 0x0112, 0x95 => 0x0113, 0x96 => 0x0116, 0x97 => 0xf3, 0x98 => 0x0117,
|
||||
0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xf5, 0x9c => 0xfa, 0x9d => 0x011a,
|
||||
0x9e => 0x011b, 0x9f => 0xfc, 0xa0 => 0x2020, 0xa1 => 0xb0, 0xa2 => 0x0118,
|
||||
0xa4 => 0xa7, 0xa5 => 0x2022, 0xa6 => 0xb6, 0xa7 => 0xdf, 0xa8 => 0xae,
|
||||
0xaa => 0x2122, 0xab => 0x0119, 0xac => 0xa8, 0xad => 0x2260, 0xae => 0x0123,
|
||||
0xaf => 0x012e, 0xb0 => 0x012f, 0xb1 => 0x012a, 0xb2 => 0x2264,
|
||||
0xb3 => 0x2265, 0xb4 => 0x012b, 0xb5 => 0x0136, 0xb6 => 0x2202,
|
||||
0xb7 => 0x2211, 0xb8 => 0x0142, 0xb9 => 0x013b, 0xba => 0x013c,
|
||||
0xbb => 0x013d, 0xbc => 0x013e, 0xbd => 0x0139, 0xbe => 0x013a,
|
||||
0xbf => 0x0145, 0xc0 => 0x0146, 0xc1 => 0x0143, 0xc2 => 0xac, 0xc3 => 0x221a,
|
||||
0xc4 => 0x0144, 0xc5 => 0x0147, 0xc6 => 0x2206, 0xc7 => 0xab, 0xc8 => 0xbb,
|
||||
0xc9 => 0x2026, 0xca => 0xa0, 0xcb => 0x0148, 0xcc => 0x0150, 0xcd => 0xd5,
|
||||
0xce => 0x0151, 0xcf => 0x014c, 0xd0 => 0x2013, 0xd1 => 0x2014,
|
||||
0xd2 => 0x201c, 0xd3 => 0x201d, 0xd4 => 0x2018, 0xd5 => 0x2019, 0xd6 => 0xf7,
|
||||
0xd7 => 0x25ca, 0xd8 => 0x014d, 0xd9 => 0x0154, 0xda => 0x0155,
|
||||
0xdb => 0x0158, 0xdc => 0x2039, 0xdd => 0x203a, 0xde => 0x0159,
|
||||
0xdf => 0x0156, 0xe0 => 0x0157, 0xe1 => 0x0160, 0xe2 => 0x201a,
|
||||
0xe3 => 0x201e, 0xe4 => 0x0161, 0xe5 => 0x015a, 0xe6 => 0x015b, 0xe7 => 0xc1,
|
||||
0xe8 => 0x0164, 0xe9 => 0x0165, 0xea => 0xcd, 0xeb => 0x017d, 0xec => 0x017e,
|
||||
0xed => 0x016a, 0xee => 0xd3, 0xef => 0xd4, 0xf0 => 0x016b, 0xf1 => 0x016e,
|
||||
0xf2 => 0xda, 0xf3 => 0x016f, 0xf4 => 0x0170, 0xf5 => 0x0171, 0xf6 => 0x0172,
|
||||
0xf7 => 0x0173, 0xf8 => 0xdd, 0xf9 => 0xfd, 0xfa => 0x0137, 0xfb => 0x017b,
|
||||
0xfc => 0x0141, 0xfd => 0x017c, 0xfe => 0x0122, 0xff => 0x02c7,
|
||||
);
|
||||
|
||||
1; # end
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,42 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: MacRoman.pm
|
||||
#
|
||||
# Description: Mac Roman to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/ROMAN.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::MacRoman = (
|
||||
0x80 => 0xc4, 0x81 => 0xc5, 0x82 => 0xc7, 0x83 => 0xc9, 0x84 => 0xd1,
|
||||
0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0xe1, 0x88 => 0xe0, 0x89 => 0xe2,
|
||||
0x8a => 0xe4, 0x8b => 0xe3, 0x8c => 0xe5, 0x8d => 0xe7, 0x8e => 0xe9,
|
||||
0x8f => 0xe8, 0x90 => 0xea, 0x91 => 0xeb, 0x92 => 0xed, 0x93 => 0xec,
|
||||
0x94 => 0xee, 0x95 => 0xef, 0x96 => 0xf1, 0x97 => 0xf3, 0x98 => 0xf2,
|
||||
0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xf5, 0x9c => 0xfa, 0x9d => 0xf9,
|
||||
0x9e => 0xfb, 0x9f => 0xfc, 0xa0 => 0x2020, 0xa1 => 0xb0, 0xa4 => 0xa7,
|
||||
0xa5 => 0x2022, 0xa6 => 0xb6, 0xa7 => 0xdf, 0xa8 => 0xae, 0xaa => 0x2122,
|
||||
0xab => 0xb4, 0xac => 0xa8, 0xad => 0x2260, 0xae => 0xc6, 0xaf => 0xd8,
|
||||
0xb0 => 0x221e, 0xb2 => 0x2264, 0xb3 => 0x2265, 0xb4 => 0xa5, 0xb6 => 0x2202,
|
||||
0xb7 => 0x2211, 0xb8 => 0x220f, 0xb9 => 0x03c0, 0xba => 0x222b, 0xbb => 0xaa,
|
||||
0xbc => 0xba, 0xbd => 0x03a9, 0xbe => 0xe6, 0xbf => 0xf8, 0xc0 => 0xbf,
|
||||
0xc1 => 0xa1, 0xc2 => 0xac, 0xc3 => 0x221a, 0xc4 => 0x0192, 0xc5 => 0x2248,
|
||||
0xc6 => 0x2206, 0xc7 => 0xab, 0xc8 => 0xbb, 0xc9 => 0x2026, 0xca => 0xa0,
|
||||
0xcb => 0xc0, 0xcc => 0xc3, 0xcd => 0xd5, 0xce => 0x0152, 0xcf => 0x0153,
|
||||
0xd0 => 0x2013, 0xd1 => 0x2014, 0xd2 => 0x201c, 0xd3 => 0x201d,
|
||||
0xd4 => 0x2018, 0xd5 => 0x2019, 0xd6 => 0xf7, 0xd7 => 0x25ca, 0xd8 => 0xff,
|
||||
0xd9 => 0x0178, 0xda => 0x2044, 0xdb => 0x20ac, 0xdc => 0x2039,
|
||||
0xdd => 0x203a, 0xde => 0xfb01, 0xdf => 0xfb02, 0xe0 => 0x2021, 0xe1 => 0xb7,
|
||||
0xe2 => 0x201a, 0xe3 => 0x201e, 0xe4 => 0x2030, 0xe5 => 0xc2, 0xe6 => 0xca,
|
||||
0xe7 => 0xc1, 0xe8 => 0xcb, 0xe9 => 0xc8, 0xea => 0xcd, 0xeb => 0xce,
|
||||
0xec => 0xcf, 0xed => 0xcc, 0xee => 0xd3, 0xef => 0xd4, 0xf0 => 0xf8ff,
|
||||
0xf1 => 0xd2, 0xf2 => 0xda, 0xf3 => 0xdb, 0xf4 => 0xd9, 0xf5 => 0x0131,
|
||||
0xf6 => 0x02c6, 0xf7 => 0x02dc, 0xf8 => 0xaf, 0xf9 => 0x02d8, 0xfa => 0x02d9,
|
||||
0xfb => 0x02da, 0xfc => 0xb8, 0xfd => 0x02dd, 0xfe => 0x02db, 0xff => 0x02c7,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,42 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: MacRomanian.pm
|
||||
#
|
||||
# Description: Mac Romanian to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/ROMANIAN.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::MacRomanian = (
|
||||
0x80 => 0xc4, 0x81 => 0xc5, 0x82 => 0xc7, 0x83 => 0xc9, 0x84 => 0xd1,
|
||||
0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0xe1, 0x88 => 0xe0, 0x89 => 0xe2,
|
||||
0x8a => 0xe4, 0x8b => 0xe3, 0x8c => 0xe5, 0x8d => 0xe7, 0x8e => 0xe9,
|
||||
0x8f => 0xe8, 0x90 => 0xea, 0x91 => 0xeb, 0x92 => 0xed, 0x93 => 0xec,
|
||||
0x94 => 0xee, 0x95 => 0xef, 0x96 => 0xf1, 0x97 => 0xf3, 0x98 => 0xf2,
|
||||
0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xf5, 0x9c => 0xfa, 0x9d => 0xf9,
|
||||
0x9e => 0xfb, 0x9f => 0xfc, 0xa0 => 0x2020, 0xa1 => 0xb0, 0xa4 => 0xa7,
|
||||
0xa5 => 0x2022, 0xa6 => 0xb6, 0xa7 => 0xdf, 0xa8 => 0xae, 0xaa => 0x2122,
|
||||
0xab => 0xb4, 0xac => 0xa8, 0xad => 0x2260, 0xae => 0x0102, 0xaf => 0x0218,
|
||||
0xb0 => 0x221e, 0xb2 => 0x2264, 0xb3 => 0x2265, 0xb4 => 0xa5, 0xb6 => 0x2202,
|
||||
0xb7 => 0x2211, 0xb8 => 0x220f, 0xb9 => 0x03c0, 0xba => 0x222b, 0xbb => 0xaa,
|
||||
0xbc => 0xba, 0xbd => 0x03a9, 0xbe => 0x0103, 0xbf => 0x0219, 0xc0 => 0xbf,
|
||||
0xc1 => 0xa1, 0xc2 => 0xac, 0xc3 => 0x221a, 0xc4 => 0x0192, 0xc5 => 0x2248,
|
||||
0xc6 => 0x2206, 0xc7 => 0xab, 0xc8 => 0xbb, 0xc9 => 0x2026, 0xca => 0xa0,
|
||||
0xcb => 0xc0, 0xcc => 0xc3, 0xcd => 0xd5, 0xce => 0x0152, 0xcf => 0x0153,
|
||||
0xd0 => 0x2013, 0xd1 => 0x2014, 0xd2 => 0x201c, 0xd3 => 0x201d,
|
||||
0xd4 => 0x2018, 0xd5 => 0x2019, 0xd6 => 0xf7, 0xd7 => 0x25ca, 0xd8 => 0xff,
|
||||
0xd9 => 0x0178, 0xda => 0x2044, 0xdb => 0x20ac, 0xdc => 0x2039,
|
||||
0xdd => 0x203a, 0xde => 0x021a, 0xdf => 0x021b, 0xe0 => 0x2021, 0xe1 => 0xb7,
|
||||
0xe2 => 0x201a, 0xe3 => 0x201e, 0xe4 => 0x2030, 0xe5 => 0xc2, 0xe6 => 0xca,
|
||||
0xe7 => 0xc1, 0xe8 => 0xcb, 0xe9 => 0xc8, 0xea => 0xcd, 0xeb => 0xce,
|
||||
0xec => 0xcf, 0xed => 0xcc, 0xee => 0xd3, 0xef => 0xd4, 0xf0 => 0xf8ff,
|
||||
0xf1 => 0xd2, 0xf2 => 0xda, 0xf3 => 0xdb, 0xf4 => 0xd9, 0xf5 => 0x0131,
|
||||
0xf6 => 0x02c6, 0xf7 => 0x02dc, 0xf8 => 0xaf, 0xf9 => 0x02d8, 0xfa => 0x02d9,
|
||||
0xfb => 0x02da, 0xfc => 0xb8, 0xfd => 0x02dd, 0xfe => 0x02db, 0xff => 0x02c7,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,49 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: MacThai.pm
|
||||
#
|
||||
# Description: Mac Thai to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/THAI.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::MacThai = (
|
||||
0x80 => 0xab, 0x81 => 0xbb, 0x82 => 0x2026, 0x83 => [0x0e48,0xf875],
|
||||
0x84 => [0x0e49,0xf875], 0x85 => [0x0e4a,0xf875], 0x86 => [0x0e4b,0xf875],
|
||||
0x87 => [0x0e4c,0xf875], 0x88 => [0x0e48,0xf873], 0x89 => [0x0e49,0xf873],
|
||||
0x8a => [0x0e4a,0xf873], 0x8b => [0x0e4b,0xf873], 0x8c => [0x0e4c,0xf873],
|
||||
0x8d => 0x201c, 0x8e => 0x201d, 0x8f => [0x0e4d,0xf874], 0x91 => 0x2022,
|
||||
0x92 => [0x0e31,0xf874], 0x93 => [0x0e47,0xf874], 0x94 => [0x0e34,0xf874],
|
||||
0x95 => [0x0e35,0xf874], 0x96 => [0x0e36,0xf874], 0x97 => [0x0e37,0xf874],
|
||||
0x98 => [0x0e48,0xf874], 0x99 => [0x0e49,0xf874], 0x9a => [0x0e4a,0xf874],
|
||||
0x9b => [0x0e4b,0xf874], 0x9c => [0x0e4c,0xf874], 0x9d => 0x2018,
|
||||
0x9e => 0x2019, 0xa1 => 0x0e01, 0xa2 => 0x0e02, 0xa3 => 0x0e03,
|
||||
0xa4 => 0x0e04, 0xa5 => 0x0e05, 0xa6 => 0x0e06, 0xa7 => 0x0e07,
|
||||
0xa8 => 0x0e08, 0xa9 => 0x0e09, 0xaa => 0x0e0a, 0xab => 0x0e0b,
|
||||
0xac => 0x0e0c, 0xad => 0x0e0d, 0xae => 0x0e0e, 0xaf => 0x0e0f,
|
||||
0xb0 => 0x0e10, 0xb1 => 0x0e11, 0xb2 => 0x0e12, 0xb3 => 0x0e13,
|
||||
0xb4 => 0x0e14, 0xb5 => 0x0e15, 0xb6 => 0x0e16, 0xb7 => 0x0e17,
|
||||
0xb8 => 0x0e18, 0xb9 => 0x0e19, 0xba => 0x0e1a, 0xbb => 0x0e1b,
|
||||
0xbc => 0x0e1c, 0xbd => 0x0e1d, 0xbe => 0x0e1e, 0xbf => 0x0e1f,
|
||||
0xc0 => 0x0e20, 0xc1 => 0x0e21, 0xc2 => 0x0e22, 0xc3 => 0x0e23,
|
||||
0xc4 => 0x0e24, 0xc5 => 0x0e25, 0xc6 => 0x0e26, 0xc7 => 0x0e27,
|
||||
0xc8 => 0x0e28, 0xc9 => 0x0e29, 0xca => 0x0e2a, 0xcb => 0x0e2b,
|
||||
0xcc => 0x0e2c, 0xcd => 0x0e2d, 0xce => 0x0e2e, 0xcf => 0x0e2f,
|
||||
0xd0 => 0x0e30, 0xd1 => 0x0e31, 0xd2 => 0x0e32, 0xd3 => 0x0e33,
|
||||
0xd4 => 0x0e34, 0xd5 => 0x0e35, 0xd6 => 0x0e36, 0xd7 => 0x0e37,
|
||||
0xd8 => 0x0e38, 0xd9 => 0x0e39, 0xda => 0x0e3a, 0xdb => 0x2060,
|
||||
0xdc => 0x200b, 0xdd => 0x2013, 0xde => 0x2014, 0xdf => 0x0e3f,
|
||||
0xe0 => 0x0e40, 0xe1 => 0x0e41, 0xe2 => 0x0e42, 0xe3 => 0x0e43,
|
||||
0xe4 => 0x0e44, 0xe5 => 0x0e45, 0xe6 => 0x0e46, 0xe7 => 0x0e47,
|
||||
0xe8 => 0x0e48, 0xe9 => 0x0e49, 0xea => 0x0e4a, 0xeb => 0x0e4b,
|
||||
0xec => 0x0e4c, 0xed => 0x0e4d, 0xee => 0x2122, 0xef => 0x0e4f,
|
||||
0xf0 => 0x0e50, 0xf1 => 0x0e51, 0xf2 => 0x0e52, 0xf3 => 0x0e53,
|
||||
0xf4 => 0x0e54, 0xf5 => 0x0e55, 0xf6 => 0x0e56, 0xf7 => 0x0e57,
|
||||
0xf8 => 0x0e58, 0xf9 => 0x0e59, 0xfa => 0xae, 0xfb => 0xa9,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,42 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: MacTurkish.pm
|
||||
#
|
||||
# Description: Mac Turkish to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/APPLE/TURKISH.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::MacTurkish = (
|
||||
0x80 => 0xc4, 0x81 => 0xc5, 0x82 => 0xc7, 0x83 => 0xc9, 0x84 => 0xd1,
|
||||
0x85 => 0xd6, 0x86 => 0xdc, 0x87 => 0xe1, 0x88 => 0xe0, 0x89 => 0xe2,
|
||||
0x8a => 0xe4, 0x8b => 0xe3, 0x8c => 0xe5, 0x8d => 0xe7, 0x8e => 0xe9,
|
||||
0x8f => 0xe8, 0x90 => 0xea, 0x91 => 0xeb, 0x92 => 0xed, 0x93 => 0xec,
|
||||
0x94 => 0xee, 0x95 => 0xef, 0x96 => 0xf1, 0x97 => 0xf3, 0x98 => 0xf2,
|
||||
0x99 => 0xf4, 0x9a => 0xf6, 0x9b => 0xf5, 0x9c => 0xfa, 0x9d => 0xf9,
|
||||
0x9e => 0xfb, 0x9f => 0xfc, 0xa0 => 0x2020, 0xa1 => 0xb0, 0xa4 => 0xa7,
|
||||
0xa5 => 0x2022, 0xa6 => 0xb6, 0xa7 => 0xdf, 0xa8 => 0xae, 0xaa => 0x2122,
|
||||
0xab => 0xb4, 0xac => 0xa8, 0xad => 0x2260, 0xae => 0xc6, 0xaf => 0xd8,
|
||||
0xb0 => 0x221e, 0xb2 => 0x2264, 0xb3 => 0x2265, 0xb4 => 0xa5, 0xb6 => 0x2202,
|
||||
0xb7 => 0x2211, 0xb8 => 0x220f, 0xb9 => 0x03c0, 0xba => 0x222b, 0xbb => 0xaa,
|
||||
0xbc => 0xba, 0xbd => 0x03a9, 0xbe => 0xe6, 0xbf => 0xf8, 0xc0 => 0xbf,
|
||||
0xc1 => 0xa1, 0xc2 => 0xac, 0xc3 => 0x221a, 0xc4 => 0x0192, 0xc5 => 0x2248,
|
||||
0xc6 => 0x2206, 0xc7 => 0xab, 0xc8 => 0xbb, 0xc9 => 0x2026, 0xca => 0xa0,
|
||||
0xcb => 0xc0, 0xcc => 0xc3, 0xcd => 0xd5, 0xce => 0x0152, 0xcf => 0x0153,
|
||||
0xd0 => 0x2013, 0xd1 => 0x2014, 0xd2 => 0x201c, 0xd3 => 0x201d,
|
||||
0xd4 => 0x2018, 0xd5 => 0x2019, 0xd6 => 0xf7, 0xd7 => 0x25ca, 0xd8 => 0xff,
|
||||
0xd9 => 0x0178, 0xda => 0x011e, 0xdb => 0x011f, 0xdc => 0x0130,
|
||||
0xdd => 0x0131, 0xde => 0x015e, 0xdf => 0x015f, 0xe0 => 0x2021, 0xe1 => 0xb7,
|
||||
0xe2 => 0x201a, 0xe3 => 0x201e, 0xe4 => 0x2030, 0xe5 => 0xc2, 0xe6 => 0xca,
|
||||
0xe7 => 0xc1, 0xe8 => 0xcb, 0xe9 => 0xc8, 0xea => 0xcd, 0xeb => 0xce,
|
||||
0xec => 0xcf, 0xed => 0xcc, 0xee => 0xd3, 0xef => 0xd4, 0xf0 => 0xf8ff,
|
||||
0xf1 => 0xd2, 0xf2 => 0xda, 0xf3 => 0xdb, 0xf4 => 0xd9, 0xf5 => 0xf8a0,
|
||||
0xf6 => 0x02c6, 0xf7 => 0x02dc, 0xf8 => 0xaf, 0xf9 => 0x02d8, 0xfa => 0x02d9,
|
||||
0xfb => 0x02da, 0xfc => 0xb8, 0xfd => 0x02dd, 0xfe => 0x02db, 0xff => 0x02c7,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,28 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: PDFDoc.pm
|
||||
#
|
||||
# Description: PDFDocEncoding to Unicode
|
||||
#
|
||||
# Revisions: 2010/10/16 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://www.adobe.com/devnet/pdf/pdf_reference.html
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
# This set re-maps characters with codepoints less than 0x80
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::PDFDoc = (
|
||||
0x18 => 0x02d8, 0x82 => 0x2021, 0x8c => 0x201e, 0x96 => 0x0152,
|
||||
0x19 => 0x02c7, 0x83 => 0x2026, 0x8d => 0x201c, 0x97 => 0x0160,
|
||||
0x1a => 0x02c6, 0x84 => 0x2014, 0x8e => 0x201d, 0x98 => 0x0178,
|
||||
0x1b => 0x02d9, 0x85 => 0x2013, 0x8f => 0x2018, 0x99 => 0x017d,
|
||||
0x1c => 0x02dd, 0x86 => 0x0192, 0x90 => 0x2019, 0x9a => 0x0131,
|
||||
0x1d => 0x02db, 0x87 => 0x2044, 0x91 => 0x201a, 0x9b => 0x0142,
|
||||
0x1e => 0x02da, 0x88 => 0x2039, 0x92 => 0x2122, 0x9c => 0x0153,
|
||||
0x1f => 0x02dc, 0x89 => 0x203a, 0x93 => 0xfb01, 0x9d => 0x0161,
|
||||
0x80 => 0x2022, 0x8a => 0x2212, 0x94 => 0xfb02, 0x9e => 0x017e,
|
||||
0x81 => 0x2020, 0x8b => 0x2030, 0x95 => 0x0141, 0xa0 => 0x20ac,
|
||||
);
|
||||
|
||||
1; # end
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,54 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Symbol.pm
|
||||
#
|
||||
# Description: Symbol to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://blogs.msdn.com/michkap/archive/2005/11/08/490495.aspx
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode.
|
||||
# This set re-maps characters with codepoints less than 0x80
|
||||
# (Although all bytes >= 0x20 should be mapped according to the
|
||||
# reference, I didn't map chars below 0x80 because I have some
|
||||
# samples where these are regular ASCII characters, even though
|
||||
# I think the encoding is probably incorrect for these samples)
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::Symbol = (
|
||||
0x80 => 0xf080, 0x81 => 0xf081, 0x82 => 0xf082, 0x83 => 0xf083,
|
||||
0x84 => 0xf084, 0x85 => 0xf085, 0x86 => 0xf086, 0x87 => 0xf087,
|
||||
0x88 => 0xf088, 0x89 => 0xf089, 0x8a => 0xf08a, 0x8b => 0xf08b,
|
||||
0x8c => 0xf08c, 0x8d => 0xf08d, 0x8e => 0xf08e, 0x8f => 0xf08f,
|
||||
0x90 => 0xf090, 0x91 => 0xf091, 0x92 => 0xf092, 0x93 => 0xf093,
|
||||
0x94 => 0xf094, 0x95 => 0xf095, 0x96 => 0xf096, 0x97 => 0xf097,
|
||||
0x98 => 0xf098, 0x99 => 0xf099, 0x9a => 0xf09a, 0x9b => 0xf09b,
|
||||
0x9c => 0xf09c, 0x9d => 0xf09d, 0x9e => 0xf09e, 0x9f => 0xf09f,
|
||||
0xa0 => 0xf0a0, 0xa1 => 0xf0a1, 0xa2 => 0xf0a2, 0xa3 => 0xf0a3,
|
||||
0xa4 => 0xf0a4, 0xa5 => 0xf0a5, 0xa6 => 0xf0a6, 0xa7 => 0xf0a7,
|
||||
0xa8 => 0xf0a8, 0xa9 => 0xf0a9, 0xaa => 0xf0aa, 0xab => 0xf0ab,
|
||||
0xac => 0xf0ac, 0xad => 0xf0ad, 0xae => 0xf0ae, 0xaf => 0xf0af,
|
||||
0xb0 => 0xf0b0, 0xb1 => 0xf0b1, 0xb2 => 0xf0b2, 0xb3 => 0xf0b3,
|
||||
0xb4 => 0xf0b4, 0xb5 => 0xf0b5, 0xb6 => 0xf0b6, 0xb7 => 0xf0b7,
|
||||
0xb8 => 0xf0b8, 0xb9 => 0xf0b9, 0xba => 0xf0ba, 0xbb => 0xf0bb,
|
||||
0xbc => 0xf0bc, 0xbd => 0xf0bd, 0xbe => 0xf0be, 0xbf => 0xf0bf,
|
||||
0xc0 => 0xf0c0, 0xc1 => 0xf0c1, 0xc2 => 0xf0c2, 0xc3 => 0xf0c3,
|
||||
0xc4 => 0xf0c4, 0xc5 => 0xf0c5, 0xc6 => 0xf0c6, 0xc7 => 0xf0c7,
|
||||
0xc8 => 0xf0c8, 0xc9 => 0xf0c9, 0xca => 0xf0ca, 0xcb => 0xf0cb,
|
||||
0xcc => 0xf0cc, 0xcd => 0xf0cd, 0xce => 0xf0ce, 0xcf => 0xf0cf,
|
||||
0xd0 => 0xf0d0, 0xd1 => 0xf0d1, 0xd2 => 0xf0d2, 0xd3 => 0xf0d3,
|
||||
0xd4 => 0xf0d4, 0xd5 => 0xf0d5, 0xd6 => 0xf0d6, 0xd7 => 0xf0d7,
|
||||
0xd8 => 0xf0d8, 0xd9 => 0xf0d9, 0xda => 0xf0da, 0xdb => 0xf0db,
|
||||
0xdc => 0xf0dc, 0xdd => 0xf0dd, 0xde => 0xf0de, 0xdf => 0xf0df,
|
||||
0xe0 => 0xf0e0, 0xe1 => 0xf0e1, 0xe2 => 0xf0e2, 0xe3 => 0xf0e3,
|
||||
0xe4 => 0xf0e4, 0xe5 => 0xf0e5, 0xe6 => 0xf0e6, 0xe7 => 0xf0e7,
|
||||
0xe8 => 0xf0e8, 0xe9 => 0xf0e9, 0xea => 0xf0ea, 0xeb => 0xf0eb,
|
||||
0xec => 0xf0ec, 0xed => 0xf0ed, 0xee => 0xf0ee, 0xef => 0xf0ef,
|
||||
0xf0 => 0xf0f0, 0xf1 => 0xf0f1, 0xf2 => 0xf0f2, 0xf3 => 0xf0f3,
|
||||
0xf4 => 0xf0f4, 0xf5 => 0xf0f5, 0xf6 => 0xf0f6, 0xf7 => 0xf0f7,
|
||||
0xf8 => 0xf0f8, 0xf9 => 0xf0f9, 0xfa => 0xf0fa, 0xfb => 0xf0fb,
|
||||
0xfc => 0xf0fc, 0xfd => 0xf0fd, 0xfe => 0xf0fe, 0xff => 0xf0ff,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,41 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Thai.pm
|
||||
#
|
||||
# Description: cp874 to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP874.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::Thai = (
|
||||
0x80 => 0x20ac, 0x85 => 0x2026, 0x91 => 0x2018, 0x92 => 0x2019,
|
||||
0x93 => 0x201c, 0x94 => 0x201d, 0x95 => 0x2022, 0x96 => 0x2013,
|
||||
0x97 => 0x2014, 0xa1 => 0x0e01, 0xa2 => 0x0e02, 0xa3 => 0x0e03,
|
||||
0xa4 => 0x0e04, 0xa5 => 0x0e05, 0xa6 => 0x0e06, 0xa7 => 0x0e07,
|
||||
0xa8 => 0x0e08, 0xa9 => 0x0e09, 0xaa => 0x0e0a, 0xab => 0x0e0b,
|
||||
0xac => 0x0e0c, 0xad => 0x0e0d, 0xae => 0x0e0e, 0xaf => 0x0e0f,
|
||||
0xb0 => 0x0e10, 0xb1 => 0x0e11, 0xb2 => 0x0e12, 0xb3 => 0x0e13,
|
||||
0xb4 => 0x0e14, 0xb5 => 0x0e15, 0xb6 => 0x0e16, 0xb7 => 0x0e17,
|
||||
0xb8 => 0x0e18, 0xb9 => 0x0e19, 0xba => 0x0e1a, 0xbb => 0x0e1b,
|
||||
0xbc => 0x0e1c, 0xbd => 0x0e1d, 0xbe => 0x0e1e, 0xbf => 0x0e1f,
|
||||
0xc0 => 0x0e20, 0xc1 => 0x0e21, 0xc2 => 0x0e22, 0xc3 => 0x0e23,
|
||||
0xc4 => 0x0e24, 0xc5 => 0x0e25, 0xc6 => 0x0e26, 0xc7 => 0x0e27,
|
||||
0xc8 => 0x0e28, 0xc9 => 0x0e29, 0xca => 0x0e2a, 0xcb => 0x0e2b,
|
||||
0xcc => 0x0e2c, 0xcd => 0x0e2d, 0xce => 0x0e2e, 0xcf => 0x0e2f,
|
||||
0xd0 => 0x0e30, 0xd1 => 0x0e31, 0xd2 => 0x0e32, 0xd3 => 0x0e33,
|
||||
0xd4 => 0x0e34, 0xd5 => 0x0e35, 0xd6 => 0x0e36, 0xd7 => 0x0e37,
|
||||
0xd8 => 0x0e38, 0xd9 => 0x0e39, 0xda => 0x0e3a, 0xdf => 0x0e3f,
|
||||
0xe0 => 0x0e40, 0xe1 => 0x0e41, 0xe2 => 0x0e42, 0xe3 => 0x0e43,
|
||||
0xe4 => 0x0e44, 0xe5 => 0x0e45, 0xe6 => 0x0e46, 0xe7 => 0x0e47,
|
||||
0xe8 => 0x0e48, 0xe9 => 0x0e49, 0xea => 0x0e4a, 0xeb => 0x0e4b,
|
||||
0xec => 0x0e4c, 0xed => 0x0e4d, 0xee => 0x0e4e, 0xef => 0x0e4f,
|
||||
0xf0 => 0x0e50, 0xf1 => 0x0e51, 0xf2 => 0x0e52, 0xf3 => 0x0e53,
|
||||
0xf4 => 0x0e54, 0xf5 => 0x0e55, 0xf6 => 0x0e56, 0xf7 => 0x0e57,
|
||||
0xf8 => 0x0e58, 0xf9 => 0x0e59, 0xfa => 0x0e5a, 0xfb => 0x0e5b,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,25 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Turkish.pm
|
||||
#
|
||||
# Description: cp1254 to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1254.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::Turkish = (
|
||||
0x80 => 0x20ac, 0x82 => 0x201a, 0x83 => 0x0192, 0x84 => 0x201e,
|
||||
0x85 => 0x2026, 0x86 => 0x2020, 0x87 => 0x2021, 0x88 => 0x02c6,
|
||||
0x89 => 0x2030, 0x8a => 0x0160, 0x8b => 0x2039, 0x8c => 0x0152,
|
||||
0x91 => 0x2018, 0x92 => 0x2019, 0x93 => 0x201c, 0x94 => 0x201d,
|
||||
0x95 => 0x2022, 0x96 => 0x2013, 0x97 => 0x2014, 0x98 => 0x02dc,
|
||||
0x99 => 0x2122, 0x9a => 0x0161, 0x9b => 0x203a, 0x9c => 0x0153,
|
||||
0x9f => 0x0178, 0xd0 => 0x011e, 0xdd => 0x0130, 0xde => 0x015e,
|
||||
0xf0 => 0x011f, 0xfd => 0x0131, 0xfe => 0x015f,
|
||||
);
|
||||
|
||||
1; # end
|
||||
@@ -0,0 +1,27 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Vietnam.pm
|
||||
#
|
||||
# Description: cp1258 to Unicode
|
||||
#
|
||||
# Revisions: 2010/01/20 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1258.TXT
|
||||
#
|
||||
# Notes: The table omits 1-byte characters with the same values as Unicode
|
||||
#------------------------------------------------------------------------------
|
||||
use strict;
|
||||
|
||||
%Image::ExifTool::Charset::Vietnam = (
|
||||
0x80 => 0x20ac, 0x82 => 0x201a, 0x83 => 0x0192, 0x84 => 0x201e,
|
||||
0x85 => 0x2026, 0x86 => 0x2020, 0x87 => 0x2021, 0x88 => 0x02c6,
|
||||
0x89 => 0x2030, 0x8b => 0x2039, 0x8c => 0x0152, 0x91 => 0x2018,
|
||||
0x92 => 0x2019, 0x93 => 0x201c, 0x94 => 0x201d, 0x95 => 0x2022,
|
||||
0x96 => 0x2013, 0x97 => 0x2014, 0x98 => 0x02dc, 0x99 => 0x2122,
|
||||
0x9b => 0x203a, 0x9c => 0x0153, 0x9f => 0x0178, 0xc3 => 0x0102,
|
||||
0xcc => 0x0300, 0xd0 => 0x0110, 0xd2 => 0x0309, 0xd5 => 0x01a0,
|
||||
0xdd => 0x01af, 0xde => 0x0303, 0xe3 => 0x0103, 0xec => 0x0301,
|
||||
0xf0 => 0x0111, 0xf2 => 0x0323, 0xf5 => 0x01a1, 0xfd => 0x01b0,
|
||||
0xfe => 0x20ab,
|
||||
);
|
||||
|
||||
1; # end
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,90 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: DJI.pm
|
||||
#
|
||||
# Description: DJI Phantom maker notes tags
|
||||
#
|
||||
# Revisions: 2016-07-25 - P. Harvey Created
|
||||
# 2017-06-23 - PH Added XMP tags
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::DJI;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool::Exif;
|
||||
use Image::ExifTool::XMP;
|
||||
|
||||
$VERSION = '1.01';
|
||||
|
||||
my %convFloat2 = (
|
||||
PrintConv => 'sprintf("%+.2f", $val)',
|
||||
PrintConvInv => '$val',
|
||||
);
|
||||
|
||||
# DJI maker notes (ref PH, mostly educated guesses based on DJI QuickTime::UserData tags)
|
||||
%Image::ExifTool::DJI::Main = (
|
||||
WRITE_PROC => \&Image::ExifTool::Exif::WriteExif,
|
||||
CHECK_PROC => \&Image::ExifTool::Exif::CheckExif,
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
|
||||
NOTES => q{
|
||||
This table lists tags found in the maker notes of images from some DJI
|
||||
Phantom drones.
|
||||
},
|
||||
0x01 => { Name => 'Make', Writable => 'string' },
|
||||
# 0x02 - int8u[4]: "1 0 0 0", "1 1 0 0"
|
||||
0x03 => { Name => 'SpeedX', Writable => 'float', %convFloat2 }, # (guess)
|
||||
0x04 => { Name => 'SpeedY', Writable => 'float', %convFloat2 }, # (guess)
|
||||
0x05 => { Name => 'SpeedZ', Writable => 'float', %convFloat2 }, # (guess)
|
||||
0x06 => { Name => 'Pitch', Writable => 'float', %convFloat2 },
|
||||
0x07 => { Name => 'Yaw', Writable => 'float', %convFloat2 },
|
||||
0x08 => { Name => 'Roll', Writable => 'float', %convFloat2 },
|
||||
0x09 => { Name => 'CameraPitch',Writable => 'float', %convFloat2 },
|
||||
0x0a => { Name => 'CameraYaw', Writable => 'float', %convFloat2 },
|
||||
0x0b => { Name => 'CameraRoll', Writable => 'float', %convFloat2 },
|
||||
);
|
||||
|
||||
%Image::ExifTool::DJI::XMP = (
|
||||
%Image::ExifTool::XMP::xmpTableDefaults,
|
||||
GROUPS => { 0 => 'XMP', 1 => 'XMP-drone-dji', 2 => 'Image' },
|
||||
NAMESPACE => 'drone-dji',
|
||||
TABLE_DESC => 'XMP DJI',
|
||||
VARS => { NO_ID => 1 },
|
||||
NOTES => 'XMP tags used by DJI for images from drones.',
|
||||
AbsoluteAltitude => { Writable => 'real' },
|
||||
RelativeAltitude => { Writable => 'real' },
|
||||
GimbalRollDegree => { Writable => 'real' },
|
||||
GimbalYawDegree => { Writable => 'real' },
|
||||
GimbalPitchDegree => { Writable => 'real' },
|
||||
FlightRollDegree => { Writable => 'real' },
|
||||
FlightYawDegree => { Writable => 'real' },
|
||||
FlightPitchDegree => { Writable => 'real' },
|
||||
);
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::DJI - DJI Phantom maker notes tags
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is loaded automatically by Image::ExifTool when required.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to interpret
|
||||
the maker notes in images from some DJI Phantom drones.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/DJI Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,835 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: DNG.pm
|
||||
#
|
||||
# Description: Read DNG-specific information
|
||||
#
|
||||
# Revisions: 01/09/2006 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://www.adobe.com/products/dng/
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::DNG;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
use Image::ExifTool::Exif;
|
||||
use Image::ExifTool::MakerNotes;
|
||||
use Image::ExifTool::CanonRaw;
|
||||
|
||||
$VERSION = '1.23';
|
||||
|
||||
sub ProcessOriginalRaw($$$);
|
||||
sub ProcessAdobeData($$$);
|
||||
sub ProcessAdobeMakN($$$);
|
||||
sub ProcessAdobeCRW($$$);
|
||||
sub ProcessAdobeRAF($$$);
|
||||
sub ProcessAdobeMRW($$$);
|
||||
sub ProcessAdobeSR2($$$);
|
||||
sub ProcessAdobeIFD($$$);
|
||||
sub WriteAdobeStuff($$$);
|
||||
|
||||
# data in OriginalRawFileData
|
||||
%Image::ExifTool::DNG::OriginalRaw = (
|
||||
GROUPS => { 2 => 'Image' },
|
||||
PROCESS_PROC => \&ProcessOriginalRaw,
|
||||
NOTES => q{
|
||||
This table defines tags extracted from the DNG OriginalRawFileData
|
||||
information.
|
||||
},
|
||||
0 => { Name => 'OriginalRawImage', Binary => 1 },
|
||||
1 => { Name => 'OriginalRawResource', Binary => 1 },
|
||||
2 => 'OriginalRawFileType',
|
||||
3 => 'OriginalRawCreator',
|
||||
4 => { Name => 'OriginalTHMImage', Binary => 1 },
|
||||
5 => { Name => 'OriginalTHMResource', Binary => 1 },
|
||||
6 => 'OriginalTHMFileType',
|
||||
7 => 'OriginalTHMCreator',
|
||||
);
|
||||
|
||||
%Image::ExifTool::DNG::AdobeData = ( #PH
|
||||
GROUPS => { 0 => 'MakerNotes', 1 => 'AdobeDNG', 2 => 'Image' },
|
||||
PROCESS_PROC => \&ProcessAdobeData,
|
||||
WRITE_PROC => \&WriteAdobeStuff,
|
||||
NOTES => q{
|
||||
This information is found in the "Adobe" DNGPrivateData.
|
||||
|
||||
The maker notes ('MakN') are processed by ExifTool, but some information may
|
||||
have been lost by the Adobe DNG Converter. This is because the Adobe DNG
|
||||
Converter (as of version 6.3) doesn't properly handle information referenced
|
||||
from inside the maker notes that lies outside the original maker notes
|
||||
block. This information is lost when only the maker note block is copied to
|
||||
the DNG image. While this doesn't effect all makes of cameras, it is a
|
||||
problem for some major brands such as Olympus and Sony.
|
||||
|
||||
Other entries in this table represent proprietary information that is
|
||||
extracted from the original RAW image and restructured to a different (but
|
||||
still proprietary) Adobe format.
|
||||
},
|
||||
MakN => [ ], # (filled in later)
|
||||
'CRW ' => {
|
||||
Name => 'AdobeCRW',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::CanonRaw::Main',
|
||||
ProcessProc => \&ProcessAdobeCRW,
|
||||
WriteProc => \&WriteAdobeStuff,
|
||||
},
|
||||
},
|
||||
'MRW ' => {
|
||||
Name => 'AdobeMRW',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::MinoltaRaw::Main',
|
||||
ProcessProc => \&ProcessAdobeMRW,
|
||||
WriteProc => \&WriteAdobeStuff,
|
||||
},
|
||||
},
|
||||
'SR2 ' => {
|
||||
Name => 'AdobeSR2',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::Sony::SR2Private',
|
||||
ProcessProc => \&ProcessAdobeSR2,
|
||||
},
|
||||
},
|
||||
'RAF ' => {
|
||||
Name => 'AdobeRAF',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::FujiFilm::RAF',
|
||||
ProcessProc => \&ProcessAdobeRAF,
|
||||
},
|
||||
},
|
||||
'Pano' => {
|
||||
Name => 'AdobePano',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::PanasonicRaw::Main',
|
||||
ProcessProc => \&ProcessAdobeIFD,
|
||||
},
|
||||
},
|
||||
'Koda' => {
|
||||
Name => 'AdobeKoda',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::Kodak::IFD',
|
||||
ProcessProc => \&ProcessAdobeIFD,
|
||||
},
|
||||
},
|
||||
'Leaf' => {
|
||||
Name => 'AdobeLeaf',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::Leaf::SubIFD',
|
||||
ProcessProc => \&ProcessAdobeIFD,
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
# fill in maker notes
|
||||
{
|
||||
my $tagInfo;
|
||||
my $list = $Image::ExifTool::DNG::AdobeData{MakN};
|
||||
foreach $tagInfo (@Image::ExifTool::MakerNotes::Main) {
|
||||
unless (ref $tagInfo eq 'HASH') {
|
||||
push @$list, $tagInfo;
|
||||
next;
|
||||
}
|
||||
my %copy = %$tagInfo;
|
||||
delete $copy{Groups};
|
||||
delete $copy{GotGroups};
|
||||
delete $copy{Table};
|
||||
push @$list, \%copy;
|
||||
}
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process DNG OriginalRawFileData information
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: 1 on success, otherwise returns 0 and sets a Warning
|
||||
sub ProcessOriginalRaw($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $start = $$dirInfo{DirStart};
|
||||
my $end = $start + $$dirInfo{DirLen};
|
||||
my $pos = $start;
|
||||
my ($index, $err);
|
||||
|
||||
SetByteOrder('MM'); # pointers are always big-endian in this structure
|
||||
for ($index=0; $index<8; ++$index) {
|
||||
last if $pos + 4 > $end;
|
||||
my $val = Get32u($dataPt, $pos);
|
||||
$val or $pos += 4, next; # ignore zero values
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, $index);
|
||||
$tagInfo or $err = "Missing DNG tag $index", last;
|
||||
if ($index & 0x02) {
|
||||
# extract a simple file type (tags 2, 3, 6 and 7)
|
||||
$val = substr($$dataPt, $pos, 4);
|
||||
$pos += 4;
|
||||
} else {
|
||||
# extract a compressed data block (tags 0, 1, 4 and 5)
|
||||
my $n = int(($val + 65535) / 65536);
|
||||
my $hdrLen = 4 * ($n + 2);
|
||||
$pos + $hdrLen > $end and $err = '', last;
|
||||
my $tag = $$tagInfo{Name};
|
||||
# only extract this information if requested (because it takes time)
|
||||
my $lcTag = lc $tag;
|
||||
if (($$et{OPTIONS}{Binary} and not $$et{EXCL_TAG_LOOKUP}{$lcTag}) or
|
||||
$$et{REQ_TAG_LOOKUP}{$lcTag})
|
||||
{
|
||||
unless (eval { require Compress::Zlib }) {
|
||||
$err = 'Install Compress::Zlib to extract compressed images';
|
||||
last;
|
||||
}
|
||||
my $i;
|
||||
$val = '';
|
||||
my $p2 = $pos + Get32u($dataPt, $pos + 4);
|
||||
for ($i=0; $i<$n; ++$i) {
|
||||
# inflate this compressed block
|
||||
my $p1 = $p2;
|
||||
$p2 = $pos + Get32u($dataPt, $pos + ($i + 2) * 4);
|
||||
if ($p1 >= $p2 or $p2 > $end) {
|
||||
$err = 'Bad compressed RAW image';
|
||||
last;
|
||||
}
|
||||
my $buff = substr($$dataPt, $p1, $p2 - $p1);
|
||||
my ($v2, $stat);
|
||||
my $inflate = Compress::Zlib::inflateInit();
|
||||
$inflate and ($v2, $stat) = $inflate->inflate($buff);
|
||||
if ($inflate and $stat == Compress::Zlib::Z_STREAM_END()) {
|
||||
$val .= $v2;
|
||||
} else {
|
||||
$err = 'Error inflating compressed RAW image';
|
||||
last;
|
||||
}
|
||||
}
|
||||
$pos = $p2;
|
||||
} else {
|
||||
$pos + $hdrLen > $end and $err = '', last;
|
||||
my $len = Get32u($dataPt, $pos + $hdrLen - 4);
|
||||
$pos + $len > $end and $err = '', last;
|
||||
$val = substr($$dataPt, $pos + $hdrLen, $len - $hdrLen);
|
||||
$val = "Binary data $len bytes";
|
||||
$pos += $len; # skip over this block
|
||||
}
|
||||
}
|
||||
$et->FoundTag($tagInfo, $val);
|
||||
}
|
||||
$et->Warn($err || 'Bad OriginalRawFileData') if defined $err;
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process Adobe DNGPrivateData directory
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: 1 on success
|
||||
sub ProcessAdobeData($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dataPos = $$dirInfo{DataPos};
|
||||
my $pos = $$dirInfo{DirStart};
|
||||
my $end = $$dirInfo{DirLen} + $pos;
|
||||
my $outfile = $$dirInfo{OutFile};
|
||||
my $verbose = $et->Options('Verbose');
|
||||
my $htmlDump = $et->Options('HtmlDump');
|
||||
|
||||
return 0 unless $$dataPt =~ /^Adobe\0/;
|
||||
unless ($outfile) {
|
||||
$et->VerboseDir($dirInfo);
|
||||
# don't parse makernotes if FastScan > 1
|
||||
my $fast = $et->Options('FastScan');
|
||||
return 1 if $fast and $fast > 1;
|
||||
}
|
||||
$htmlDump and $et->HDump($dataPos, 6, 'Adobe DNGPrivateData header');
|
||||
SetByteOrder('MM'); # always big endian
|
||||
$pos += 6;
|
||||
while ($pos + 8 <= $end) {
|
||||
my ($tag, $size) = unpack("x${pos}a4N", $$dataPt);
|
||||
$pos += 8;
|
||||
last if $pos + $size > $end;
|
||||
my $tagInfo = $$tagTablePtr{$tag};
|
||||
if ($htmlDump) {
|
||||
my $name = "Adobe$tag";
|
||||
$name =~ tr/ //d;
|
||||
$et->HDump($dataPos + $pos - 8, 8, "$name header", "Data Size: $size bytes");
|
||||
# dump non-EXIF format data
|
||||
unless ($tag =~ /^(MakN|SR2 )$/) {
|
||||
$et->HDump($dataPos + $pos, $size, "$name data");
|
||||
}
|
||||
}
|
||||
if ($verbose and not $outfile) {
|
||||
$tagInfo or $et->VPrint(0, "$$et{INDENT}Unsupported DNGAdobeData record: ($tag)\n");
|
||||
$et->VerboseInfo($tag,
|
||||
ref $tagInfo eq 'HASH' ? $tagInfo : undef,
|
||||
DataPt => $dataPt,
|
||||
DataPos => $dataPos,
|
||||
Start => $pos,
|
||||
Size => $size,
|
||||
);
|
||||
}
|
||||
my $value;
|
||||
while ($tagInfo) {
|
||||
my ($subTable, $subName, $processProc);
|
||||
if (ref $tagInfo eq 'HASH') {
|
||||
unless ($$tagInfo{SubDirectory}) {
|
||||
if ($outfile) {
|
||||
# copy value across to outfile
|
||||
$value = substr($$dataPt, $pos, $size);
|
||||
} else {
|
||||
$et->HandleTag($tagTablePtr, $tag, substr($$dataPt, $pos, $size));
|
||||
}
|
||||
last;
|
||||
}
|
||||
$subTable = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
|
||||
$subName = $$tagInfo{Name};
|
||||
$processProc = $tagInfo->{SubDirectory}->{ProcessProc};
|
||||
} else {
|
||||
$subTable = $tagTablePtr;
|
||||
$subName = 'AdobeMakN';
|
||||
$processProc = \&ProcessAdobeMakN;
|
||||
}
|
||||
my %dirInfo = (
|
||||
Base => $$dirInfo{Base},
|
||||
DataPt => $dataPt,
|
||||
DataPos => $dataPos,
|
||||
DataLen => $$dirInfo{DataLen},
|
||||
DirStart => $pos,
|
||||
DirLen => $size,
|
||||
DirName => $subName,
|
||||
);
|
||||
if ($outfile) {
|
||||
$dirInfo{Proc} = $processProc; # WriteAdobeStuff() calls this to do the actual writing
|
||||
$value = $et->WriteDirectory(\%dirInfo, $subTable, \&WriteAdobeStuff);
|
||||
# use old directory if an error occurred
|
||||
defined $value or $value = substr($$dataPt, $pos, $size);
|
||||
} else {
|
||||
# override process proc for MakN
|
||||
$et->ProcessDirectory(\%dirInfo, $subTable, $processProc);
|
||||
}
|
||||
last;
|
||||
}
|
||||
if (defined $value and length $value) {
|
||||
# add "Adobe" header if necessary
|
||||
$$outfile = "Adobe\0" unless $$outfile and length $$outfile;
|
||||
$$outfile .= $tag . pack('N', length $value) . $value;
|
||||
$$outfile .= "\0" if length($value) & 0x01; # pad if necessary
|
||||
}
|
||||
$pos += $size;
|
||||
++$pos if $size & 0x01; # (darn padding)
|
||||
}
|
||||
$pos == $end or $et->Warn("$pos $end Adobe private data is corrupt");
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process Adobe CRW directory
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: 1 on success, otherwise returns 0 and sets a Warning
|
||||
# Notes: data has 4 byte header (2 for byte order and 2 for entry count)
|
||||
# - this routine would be as simple as ProcessAdobeMRW() below if Adobe hadn't
|
||||
# pulled the bonehead move of reformatting the CRW information
|
||||
sub ProcessAdobeCRW($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $start = $$dirInfo{DirStart};
|
||||
my $end = $start + $$dirInfo{DirLen};
|
||||
my $verbose = $et->Options('Verbose');
|
||||
my $buildMakerNotes = $et->Options('MakerNotes');
|
||||
my $outfile = $$dirInfo{OutFile};
|
||||
my ($newTags, $oldChanged);
|
||||
|
||||
SetByteOrder('MM'); # always big endian
|
||||
return 0 if $$dirInfo{DirLen} < 4;
|
||||
my $byteOrder = substr($$dataPt, $start, 2);
|
||||
return 0 unless $byteOrder =~ /^(II|MM)$/;
|
||||
|
||||
# initialize maker note data if building maker notes
|
||||
$buildMakerNotes and Image::ExifTool::CanonRaw::InitMakerNotes($et);
|
||||
|
||||
my $entries = Get16u($dataPt, $start + 2);
|
||||
my $pos = $start + 4;
|
||||
$et->VerboseDir($dirInfo, $entries) unless $outfile;
|
||||
if ($outfile) {
|
||||
# get hash of new tags
|
||||
$newTags = $et->GetNewTagInfoHash($tagTablePtr);
|
||||
$$outfile = substr($$dataPt, $start, 4);
|
||||
$oldChanged = $$et{CHANGED};
|
||||
}
|
||||
# loop through entries in Adobe CRW information
|
||||
my $index;
|
||||
for ($index=0; $index<$entries; ++$index) {
|
||||
last if $pos + 6 > $end;
|
||||
my $tag = Get16u($dataPt, $pos);
|
||||
my $size = Get32u($dataPt, $pos + 2);
|
||||
$pos += 6;
|
||||
last if $pos + $size > $end;
|
||||
my $value = substr($$dataPt, $pos, $size);
|
||||
my $tagID = $tag & 0x3fff;
|
||||
my $tagType = ($tag >> 8) & 0x38; # get tag type
|
||||
my $format = $Image::ExifTool::CanonRaw::crwTagFormat{$tagType};
|
||||
my $count;
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tagID, \$value);
|
||||
if ($tagInfo) {
|
||||
$format = $$tagInfo{Format} if $$tagInfo{Format};
|
||||
$count = $$tagInfo{Count};
|
||||
}
|
||||
# set count to 1 by default for values that were in the directory entry
|
||||
if (not defined $count and $tag & 0x4000 and $format and $format ne 'string') {
|
||||
$count = 1;
|
||||
}
|
||||
# set count from tagInfo count if necessary
|
||||
if ($format and not $count) {
|
||||
# set count according to format and size
|
||||
my $fnum = $Image::ExifTool::Exif::formatNumber{$format};
|
||||
my $fsiz = $Image::ExifTool::Exif::formatSize[$fnum];
|
||||
$count = int($size / $fsiz);
|
||||
}
|
||||
$format or $format = 'undef';
|
||||
SetByteOrder($byteOrder);
|
||||
my $val = ReadValue(\$value, 0, $format, $count, $size);
|
||||
if ($outfile) {
|
||||
if ($tagInfo) {
|
||||
my $subdir = $$tagInfo{SubDirectory};
|
||||
if ($subdir and $$subdir{TagTable}) {
|
||||
my $name = $$tagInfo{Name};
|
||||
my $newTagTable = GetTagTable($$subdir{TagTable});
|
||||
return 0 unless $newTagTable;
|
||||
my $subdirStart = 0;
|
||||
#### eval Start ()
|
||||
$subdirStart = eval $$subdir{Start} if $$subdir{Start};
|
||||
my $dirData = \$value;
|
||||
my %subdirInfo = (
|
||||
Name => $name,
|
||||
DataPt => $dirData,
|
||||
DataLen => $size,
|
||||
DirStart => $subdirStart,
|
||||
DirLen => $size - $subdirStart,
|
||||
Parent => $$dirInfo{DirName},
|
||||
);
|
||||
#### eval Validate ($dirData, $subdirStart, $size)
|
||||
if (defined $$subdir{Validate} and not eval $$subdir{Validate}) {
|
||||
$et->Warn("Invalid $name data");
|
||||
} else {
|
||||
$subdir = $et->WriteDirectory(\%subdirInfo, $newTagTable);
|
||||
if (defined $subdir and length $subdir) {
|
||||
if ($subdirStart) {
|
||||
# add header before data directory
|
||||
$value = substr($value, 0, $subdirStart) . $subdir;
|
||||
} else {
|
||||
$value = $subdir;
|
||||
}
|
||||
}
|
||||
}
|
||||
} elsif ($$newTags{$tagID}) {
|
||||
my $nvHash = $et->GetNewValueHash($tagInfo);
|
||||
if ($et->IsOverwriting($nvHash, $val)) {
|
||||
my $newVal = $et->GetNewValue($nvHash);
|
||||
my $verboseVal;
|
||||
$verboseVal = $newVal if $verbose > 1;
|
||||
# convert to specified format if necessary
|
||||
if (defined $newVal and $format) {
|
||||
$newVal = WriteValue($newVal, $format, $count);
|
||||
}
|
||||
if (defined $newVal) {
|
||||
$et->VerboseValue("- CanonRaw:$$tagInfo{Name}", $value);
|
||||
$et->VerboseValue("+ CanonRaw:$$tagInfo{Name}", $verboseVal);
|
||||
$value = $newVal;
|
||||
++$$et{CHANGED};
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
# write out new value (always big-endian)
|
||||
SetByteOrder('MM');
|
||||
# (verified that there is no padding here)
|
||||
$$outfile .= Set16u($tag) . Set32u(length($value)) . $value;
|
||||
} else {
|
||||
$et->HandleTag($tagTablePtr, $tagID, $val,
|
||||
Index => $index,
|
||||
DataPt => $dataPt,
|
||||
DataPos => $$dirInfo{DataPos},
|
||||
Start => $pos,
|
||||
Size => $size,
|
||||
TagInfo => $tagInfo,
|
||||
);
|
||||
if ($buildMakerNotes) {
|
||||
# build maker notes information if requested
|
||||
Image::ExifTool::CanonRaw::BuildMakerNotes($et, $tagID, $tagInfo,
|
||||
\$value, $format, $count);
|
||||
}
|
||||
}
|
||||
# (we lost the directory structure, but the second tag 0x0805
|
||||
# should be in the ImageDescription directory)
|
||||
$$et{DIR_NAME} = 'ImageDescription' if $tagID == 0x0805;
|
||||
SetByteOrder('MM');
|
||||
$pos += $size;
|
||||
}
|
||||
if ($outfile and (not defined $$outfile or $index != $entries or
|
||||
$$et{CHANGED} == $oldChanged))
|
||||
{
|
||||
$$et{CHANGED} = $oldChanged; # nothing changed
|
||||
undef $$outfile; # rewrite old directory
|
||||
}
|
||||
if ($index != $entries) {
|
||||
$et->Warn('Truncated CRW notes');
|
||||
} elsif ($pos < $end) {
|
||||
$et->Warn($end-$pos . ' extra bytes at end of CRW notes');
|
||||
}
|
||||
# finish building maker notes if necessary
|
||||
if ($buildMakerNotes) {
|
||||
SetByteOrder($byteOrder);
|
||||
Image::ExifTool::CanonRaw::SaveMakerNotes($et);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process Adobe MRW directory
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: 1 on success, otherwise returns 0 and sets a Warning
|
||||
# Notes: data has 4 byte header (2 for byte order and 2 for entry count)
|
||||
sub ProcessAdobeMRW($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dirLen = $$dirInfo{DirLen};
|
||||
my $dirStart = $$dirInfo{DirStart};
|
||||
my $outfile = $$dirInfo{OutFile};
|
||||
|
||||
# construct fake MRW file
|
||||
my $buff = "\0MRM" . pack('N', $dirLen - 4);
|
||||
# ignore leading byte order and directory count words
|
||||
$buff .= substr($$dataPt, $dirStart + 4, $dirLen - 4);
|
||||
my $raf = new File::RandomAccess(\$buff);
|
||||
my %dirInfo = ( RAF => $raf, OutFile => $outfile );
|
||||
my $rtnVal = Image::ExifTool::MinoltaRaw::ProcessMRW($et, \%dirInfo);
|
||||
if ($outfile and defined $$outfile and length $$outfile) {
|
||||
# remove MRW header and add Adobe header
|
||||
$$outfile = substr($$dataPt, $dirStart, 4) . substr($$outfile, 8);
|
||||
}
|
||||
return $rtnVal;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process Adobe RAF directory
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: 1 on success, otherwise returns 0 and sets a Warning
|
||||
sub ProcessAdobeRAF($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
return 0 if $$dirInfo{OutFile}; # (can't write this yet)
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $pos = $$dirInfo{DirStart};
|
||||
my $dirEnd = $$dirInfo{DirLen} + $pos;
|
||||
my ($readIt, $warn);
|
||||
|
||||
# set byte order according to first 2 bytes of Adobe RAF data
|
||||
if ($pos + 2 <= $dirEnd and SetByteOrder(substr($$dataPt, $pos, 2))) {
|
||||
$pos += 2;
|
||||
} else {
|
||||
$et->Warn('Invalid DNG RAF data');
|
||||
return 0;
|
||||
}
|
||||
$et->VerboseDir($dirInfo);
|
||||
# make fake RAF object for processing (same acronym, different meaning)
|
||||
my $raf = new File::RandomAccess($dataPt);
|
||||
my $num = '';
|
||||
# loop through all records in Adobe RAF data:
|
||||
# 0 - RAF table (not processed)
|
||||
# 1 - first RAF directory
|
||||
# 2 - second RAF directory (if available)
|
||||
for (;;) {
|
||||
last if $pos + 4 > $dirEnd;
|
||||
my $len = Get32u($dataPt, $pos);
|
||||
$pos += 4 + $len; # step to next entry in Adobe RAF record
|
||||
$len or last; # ends with an empty entry
|
||||
$readIt or $readIt = 1, next; # ignore first entry (RAF table)
|
||||
my %dirInfo = (
|
||||
RAF => $raf,
|
||||
DirStart => $pos - $len,
|
||||
);
|
||||
$$et{SET_GROUP1} = "RAF$num";
|
||||
$et->ProcessDirectory(\%dirInfo, $tagTablePtr) or $warn = 1;
|
||||
delete $$et{SET_GROUP1};
|
||||
$num = ($num || 1) + 1;
|
||||
}
|
||||
$warn and $et->Warn('Possibly corrupt RAF information');
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process Adobe SR2 directory
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: 1 on success, otherwise returns 0 and sets a Warning
|
||||
# Notes: data has 6 byte header (2 for byte order and 4 for original offset)
|
||||
sub ProcessAdobeSR2($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
return 0 if $$dirInfo{OutFile}; # (can't write this yet)
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $start = $$dirInfo{DirStart};
|
||||
my $len = $$dirInfo{DirLen};
|
||||
|
||||
return 0 if $len < 6;
|
||||
SetByteOrder('MM');
|
||||
my $originalPos = Get32u($dataPt, $start + 2);
|
||||
return 0 unless SetByteOrder(substr($$dataPt, $start, 2));
|
||||
|
||||
$et->VerboseDir($dirInfo);
|
||||
my $dataPos = $$dirInfo{DataPos};
|
||||
my $dirStart = $start + 6; # pointer to maker note directory
|
||||
my $dirLen = $len - 6;
|
||||
|
||||
# initialize subdirectory information
|
||||
my $fix = $dataPos + $dirStart - $originalPos;
|
||||
my %subdirInfo = (
|
||||
DirName => 'AdobeSR2',
|
||||
Base => $$dirInfo{Base} + $fix,
|
||||
DataPt => $dataPt,
|
||||
DataPos => $dataPos - $fix,
|
||||
DataLen => $$dirInfo{DataLen},
|
||||
DirStart => $dirStart,
|
||||
DirLen => $dirLen,
|
||||
Parent => $$dirInfo{DirName},
|
||||
);
|
||||
if ($et->Options('HtmlDump')) {
|
||||
$et->HDump($dataPos + $start, 6, 'Adobe SR2 data');
|
||||
}
|
||||
# parse the SR2 directory
|
||||
$et->ProcessDirectory(\%subdirInfo, $tagTablePtr);
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process Adobe-mutilated IFD directory
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: 1 on success, otherwise returns 0 and sets a Warning
|
||||
# Notes: data has 2 byte header (byte order of the data)
|
||||
sub ProcessAdobeIFD($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
return 0 if $$dirInfo{OutFile}; # (can't write this yet)
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $pos = $$dirInfo{DirStart};
|
||||
my $dataPos = $$dirInfo{DataPos};
|
||||
|
||||
return 0 if $$dirInfo{DirLen} < 4;
|
||||
my $dataOrder = substr($$dataPt, $pos, 2);
|
||||
return 0 unless SetByteOrder($dataOrder); # validate byte order of data
|
||||
|
||||
# parse the mutilated IFD. This is similar to a TIFF IFD, except:
|
||||
# - data follows directly after Count entry in IFD
|
||||
# - byte order of IFD entires is always big-endian, but byte order of data changes
|
||||
SetByteOrder('MM'); # IFD structure is always big-endian
|
||||
my $entries = Get16u($dataPt, $pos + 2);
|
||||
$et->VerboseDir($dirInfo, $entries);
|
||||
$pos += 4;
|
||||
|
||||
my $end = $pos + $$dirInfo{DirLen};
|
||||
my $index;
|
||||
for ($index=0; $index<$entries; ++$index) {
|
||||
last if $pos + 8 > $end;
|
||||
SetByteOrder('MM'); # directory entries always big-endian (doh!)
|
||||
my $tagID = Get16u($dataPt, $pos);
|
||||
my $format = Get16u($dataPt, $pos+2);
|
||||
my $count = Get32u($dataPt, $pos+4);
|
||||
if ($format < 1 or $format > 13) {
|
||||
# warn unless the IFD was just padded with zeros
|
||||
$format and $et->Warn(
|
||||
sprintf("Unknown format ($format) for $$dirInfo{DirName} tag 0x%x",$tagID));
|
||||
return 0; # must be corrupted
|
||||
}
|
||||
my $size = $Image::ExifTool::Exif::formatSize[$format] * $count;
|
||||
last if $pos + 8 + $size > $end;
|
||||
my $formatStr = $Image::ExifTool::Exif::formatName[$format];
|
||||
SetByteOrder($dataOrder); # data stored in native order
|
||||
my $val = ReadValue($dataPt, $pos + 8, $formatStr, $count, $size);
|
||||
$et->HandleTag($tagTablePtr, $tagID, $val,
|
||||
Index => $index,
|
||||
DataPt => $dataPt,
|
||||
DataPos => $dataPos,
|
||||
Start => $pos + 8,
|
||||
Size => $size
|
||||
);
|
||||
$pos += 8 + $size;
|
||||
}
|
||||
if ($index < $entries) {
|
||||
$et->Warn("Truncated $$dirInfo{DirName} directory");
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process Adobe MakerNotes directory
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: 1 on success, otherwise returns 0 and sets a Warning
|
||||
# Notes: data has 6 byte header (2 for byte order and 4 for original offset)
|
||||
sub ProcessAdobeMakN($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $start = $$dirInfo{DirStart};
|
||||
my $len = $$dirInfo{DirLen};
|
||||
my $outfile = $$dirInfo{OutFile};
|
||||
|
||||
return 0 if $len < 6;
|
||||
SetByteOrder('MM');
|
||||
my $originalPos = Get32u($dataPt, $start + 2);
|
||||
return 0 unless SetByteOrder(substr($$dataPt, $start, 2));
|
||||
|
||||
$et->VerboseDir($dirInfo) unless $outfile;
|
||||
my $dataPos = $$dirInfo{DataPos};
|
||||
my $dirStart = $start + 6; # pointer to maker note directory
|
||||
my $dirLen = $len - 6;
|
||||
|
||||
my $hdr = substr($$dataPt, $dirStart, $dirLen < 48 ? $dirLen : 48);
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, 'MakN', \$hdr);
|
||||
return 0 unless $tagInfo and $$tagInfo{SubDirectory};
|
||||
my $subdir = $$tagInfo{SubDirectory};
|
||||
my $subTable = GetTagTable($$subdir{TagTable});
|
||||
# initialize subdirectory information
|
||||
my %subdirInfo = (
|
||||
DirName => 'MakerNotes',
|
||||
Name => $$tagInfo{Name}, # needed for maker notes verbose dump
|
||||
Base => $$dirInfo{Base},
|
||||
DataPt => $dataPt,
|
||||
DataPos => $dataPos,
|
||||
DataLen => $$dirInfo{DataLen},
|
||||
DirStart => $dirStart,
|
||||
DirLen => $dirLen,
|
||||
TagInfo => $tagInfo,
|
||||
FixBase => $$subdir{FixBase},
|
||||
EntryBased=> $$subdir{EntryBased},
|
||||
Parent => $$dirInfo{DirName},
|
||||
);
|
||||
# look for start of maker notes IFD
|
||||
my $loc = Image::ExifTool::MakerNotes::LocateIFD($et,\%subdirInfo);
|
||||
unless (defined $loc) {
|
||||
$et->Warn('Maker notes could not be parsed');
|
||||
return 0;
|
||||
}
|
||||
if ($et->Options('HtmlDump')) {
|
||||
$et->HDump($dataPos + $start, 6, 'Adobe MakN data');
|
||||
$et->HDump($dataPos + $dirStart, $loc, "$$tagInfo{Name} header") if $loc;
|
||||
}
|
||||
|
||||
my $fix = 0;
|
||||
unless ($$subdir{Base}) {
|
||||
# adjust base offset for current maker note position
|
||||
$fix = $dataPos + $dirStart - $originalPos;
|
||||
$subdirInfo{Base} += $fix;
|
||||
$subdirInfo{DataPos} -= $fix;
|
||||
}
|
||||
if ($outfile) {
|
||||
# rewrite the maker notes directory
|
||||
my $fixup = $subdirInfo{Fixup} = new Image::ExifTool::Fixup;
|
||||
my $oldChanged = $$et{CHANGED};
|
||||
my $buff = $et->WriteDirectory(\%subdirInfo, $subTable);
|
||||
# nothing to do if error writing directory or nothing changed
|
||||
unless (defined $buff and $$et{CHANGED} != $oldChanged) {
|
||||
$$et{CHANGED} = $oldChanged;
|
||||
return 1;
|
||||
}
|
||||
# deleting maker notes if directory is empty
|
||||
unless (length $buff) {
|
||||
$$outfile = '';
|
||||
return 1;
|
||||
}
|
||||
# apply a one-time fixup to offsets
|
||||
if ($subdirInfo{Relative}) {
|
||||
# shift all offsets to be relative to new base
|
||||
my $baseShift = $dataPos + $dirStart + $$dirInfo{Base} - $subdirInfo{Base};
|
||||
$fixup->{Shift} += $baseShift;
|
||||
} else {
|
||||
# shift offsets to position of original maker notes
|
||||
$fixup->{Shift} += $originalPos;
|
||||
}
|
||||
# if we wrote the directory as a block the header is already included
|
||||
$loc = 0 if $subdirInfo{BlockWrite};
|
||||
$fixup->{Shift} += $loc; # adjust for makernotes header
|
||||
$fixup->ApplyFixup(\$buff); # fix up pointer offsets
|
||||
# get copy of original Adobe header (6) and makernotes header ($loc)
|
||||
my $header = substr($$dataPt, $start, 6 + $loc);
|
||||
# add Adobe and makernotes headers to new directory
|
||||
$$outfile = $header . $buff;
|
||||
} else {
|
||||
# parse the maker notes directory
|
||||
$et->ProcessDirectory(\%subdirInfo, $subTable, $$subdir{ProcessProc});
|
||||
# extract maker notes as a block if specified
|
||||
if ($et->Options('MakerNotes') or
|
||||
$$et{REQ_TAG_LOOKUP}{lc($$tagInfo{Name})})
|
||||
{
|
||||
my $val;
|
||||
if ($$tagInfo{MakerNotes}) {
|
||||
$subdirInfo{Base} = $$dirInfo{Base} + $fix;
|
||||
$subdirInfo{DataPos} = $dataPos - $fix;
|
||||
$subdirInfo{DirStart} = $dirStart;
|
||||
$subdirInfo{DirLen} = $dirLen;
|
||||
# rebuild the maker notes to identify all offsets that require fixing up
|
||||
$val = Image::ExifTool::Exif::RebuildMakerNotes($et, \%subdirInfo, $subTable);
|
||||
if (not defined $val and $dirLen > 4) {
|
||||
$et->Warn('Error rebuilding maker notes (may be corrupt)');
|
||||
}
|
||||
} else {
|
||||
# extract this directory as a block if specified
|
||||
return 1 unless $$tagInfo{Writable};
|
||||
}
|
||||
$val = substr($$dataPt, 20) unless defined $val;
|
||||
$et->FoundTag($tagInfo, $val);
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Write Adobe information (calls appropriate ProcessProc to do the actual work)
|
||||
# Inputs: 0) ExifTool object ref, 1) source dirInfo ref, 2) tag table ref
|
||||
# Returns: new data block (may be empty if directory is deleted) or undef on error
|
||||
sub WriteAdobeStuff($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
$et or return 1; # allow dummy access
|
||||
my $proc = $$dirInfo{Proc} || \&ProcessAdobeData;
|
||||
my $buff;
|
||||
$$dirInfo{OutFile} = \$buff;
|
||||
&$proc($et, $dirInfo, $tagTablePtr) or undef $buff;
|
||||
return $buff;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::DNG.pm - Read DNG-specific information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains routines required by Image::ExifTool to process
|
||||
information in DNG (Digital Negative) images.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://www.adobe.com/products/dng/>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/DNG Tags>,
|
||||
L<Image::ExifTool::TagNames/EXIF Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,182 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: DPX.pm
|
||||
#
|
||||
# Description: Read DPX meta information
|
||||
#
|
||||
# Revisions: 2013-09-19 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://www.cineon.com/ff_draft.php
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::DPX;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.03';
|
||||
|
||||
# DPX tags
|
||||
%Image::ExifTool::DPX::Main = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
|
||||
NOTES => 'Tags extracted from DPX (Digital Picture Exchange) images.',
|
||||
0 => { Name => 'ByteOrder', Format => 'undef[4]', PrintConv => { SDPX => 'Big-endian', XPDS => 'Little-endian' } },
|
||||
8 => { Name => 'HeaderVersion', Format => 'string[8]' },
|
||||
# 24 => { Name => 'GenericHeaderSize', Format => 'int32u' }, # = 1664
|
||||
# 28 => { Name => 'IndustryStandardHeaderSize', Format => 'int32u' }, # = 384
|
||||
16 => { Name => 'DPXFileSize', Format => 'int32u' },
|
||||
20 => { Name => 'DittoKey', Format => 'int32u', PrintConv => { 0 => 'Same', 1 => 'New' } },
|
||||
36 => { Name => 'ImageFileName', Format => 'string[100]' },
|
||||
136 => {
|
||||
Name => 'CreateDate',
|
||||
Format => 'string[24]',
|
||||
Groups => { 2 => 'Time' },
|
||||
ValueConv => '$val =~ s/(\d{4}:\d{2}:\d{2}):/$1 /; $val',
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
160 => { Name => 'Creator', Format => 'string[100]', Groups => { 2 => 'Author' } },
|
||||
260 => { Name => 'Project', Format => 'string[200]' },
|
||||
460 => { Name => 'Copyright', Format => 'string[200]', Groups => { 2 => 'Author' } },
|
||||
660 => { Name => 'EncryptionKey', Format => 'int32u', PrintConv => 'sprintf("%.8x",$val)' },
|
||||
768 => {
|
||||
Name => 'Orientation',
|
||||
Format => 'int16u',
|
||||
PrintConv => {
|
||||
0 => 'Horizontal (normal)',
|
||||
1 => 'Mirror vertical',
|
||||
2 => 'Mirror horizontal',
|
||||
3 => 'Rotate 180',
|
||||
4 => 'Mirror horizontal and rotate 270 CW',
|
||||
5 => 'Rotate 90 CW',
|
||||
6 => 'Rotate 270 CW',
|
||||
7 => 'Mirror horizontal and rotate 90 CW',
|
||||
},
|
||||
},
|
||||
770 => { Name => 'ImageElements', Format => 'int16u' },
|
||||
772 => { Name => 'ImageWidth', Format => 'int32u' },
|
||||
776 => { Name => 'ImageHeight', Format => 'int32u' },
|
||||
780 => { Name => 'DataSign', Format => 'int32u', PrintConv => { 0 => 'Unsigned', 1 => 'Signed' } },
|
||||
800 => {
|
||||
Name => 'ComponentsConfiguration',
|
||||
Format => 'int8u',
|
||||
PrintConv => {
|
||||
0 => 'User-defined single component',
|
||||
1 => 'Red (R)',
|
||||
2 => 'Green (G)',
|
||||
3 => 'Blue (B)',
|
||||
4 => 'Alpha (matte)',
|
||||
6 => 'Luminance (Y)',
|
||||
7 => 'Chrominance (Cb, Cr, subsampled by two)',
|
||||
8 => 'Depth (Z)',
|
||||
9 => 'Composite video',
|
||||
50 => 'R, G, B',
|
||||
51 => 'R, G, B, Alpha',
|
||||
52 => 'Alpha, B, G, R',
|
||||
100 => 'Cb, Y, Cr, Y (4:2:2)',
|
||||
101 => 'Cb, Y, A, Cr, Y, A (4:2:2:4)',
|
||||
102 => 'Cb, Y, Cr (4:4:4)',
|
||||
103 => 'Cb, Y, Cr, A (4:4:4:4)',
|
||||
150 => 'User-defined 2 component element',
|
||||
151 => 'User-defined 3 component element',
|
||||
152 => 'User-defined 4 component element',
|
||||
153 => 'User-defined 5 component element',
|
||||
154 => 'User-defined 6 component element',
|
||||
155 => 'User-defined 7 component element',
|
||||
156 => 'User-defined 8 component element',
|
||||
},
|
||||
},
|
||||
803 => { Name => 'BitDepth', Format => 'int8u' },
|
||||
820 => { Name => 'ImageDescription', Format => 'string[32]' },
|
||||
892 => { Name => 'Image2Description', Format => 'string[32]', RawConv => '$val=~/[^\xff]/ ? $val : undef' },
|
||||
964 => { Name => 'Image3Description', Format => 'string[32]', RawConv => '$val=~/[^\xff]/ ? $val : undef' },
|
||||
1036=> { Name => 'Image4Description', Format => 'string[32]', RawConv => '$val=~/[^\xff]/ ? $val : undef' },
|
||||
1108=> { Name => 'Image5Description', Format => 'string[32]', RawConv => '$val=~/[^\xff]/ ? $val : undef' },
|
||||
1180=> { Name => 'Image6Description', Format => 'string[32]', RawConv => '$val=~/[^\xff]/ ? $val : undef' },
|
||||
1252=> { Name => 'Image7Description', Format => 'string[32]', RawConv => '$val=~/[^\xff]/ ? $val : undef' },
|
||||
1324=> { Name => 'Image8Description', Format => 'string[32]', RawConv => '$val=~/[^\xff]/ ? $val : undef' },
|
||||
# 1408=> { Name => 'XOffset', Format => 'int32u' },
|
||||
# 1412=> { Name => 'YOffset', Format => 'int32u' },
|
||||
# 1416=> { Name => 'XCenter', Format => 'float' },
|
||||
# 1420=> { Name => 'YCenter', Format => 'float' },
|
||||
# 1424=> { Name => 'XOriginalSize', Format => 'int32u' },
|
||||
# 1428=> { Name => 'YOriginalSize', Format => 'int32u' },
|
||||
1432=> { Name => 'SourceFileName', Format => 'string[100]' },
|
||||
1532=> { Name => 'SourceCreateDate', Format => 'string[24]' },
|
||||
1556=> { Name => 'InputDeviceName', Format => 'string[32]' },
|
||||
1588=> { Name => 'InputDeviceSerialNumber', Format => 'string[32]' },
|
||||
# 1620=> { Name => 'AspectRatio', Format => 'int32u' },
|
||||
1724 => { Name => 'FrameRate', Format => 'float' },
|
||||
1732 => { Name => 'FrameID', Format => 'string[32]' },
|
||||
1764 => { Name => 'SlateInformation', Format => 'string[100]' },
|
||||
1972 => { Name => 'Reserved5', Format => 'string[76]', Unknown => 1 },
|
||||
2048 => { Name => 'UserID', Format => 'string[32]' },
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Extract EXIF information from a DPX image
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
||||
# Returns: 1 on success, 0 if this wasn't a valid DPX file
|
||||
sub ProcessDPX($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $buff;
|
||||
|
||||
# verify this is a valid DPX file
|
||||
return 0 unless $raf->Read($buff, 2080) == 2080;
|
||||
return 0 unless $buff =~ /^(SDPX|XPDS)/;
|
||||
SetByteOrder($1 eq 'SDPX' ? 'MM' : 'II');
|
||||
$et->SetFileType(); # set the FileType tag
|
||||
my $hdrLen = Get32u(\$buff,24) + Get32u(\$buff,28);
|
||||
$hdrLen == 2048 or $et->Warn("Unexpected DPX header length ($hdrLen)");
|
||||
my %dirInfo = (
|
||||
DataPt => \$buff,
|
||||
DirStart => 0,
|
||||
DirLen => length($buff),
|
||||
);
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::DPX::Main');
|
||||
$et->ProcessDirectory(\%dirInfo, $tagTablePtr);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::DPX - Read DPX meta information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to read
|
||||
metadata from DPX (Digital Picture Exchange) images.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://www.cineon.com/ff_draft.php>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/DPX Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,319 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: DV.pm
|
||||
#
|
||||
# Description: Read DV meta information
|
||||
#
|
||||
# Revisions: 2010/12/24 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://www.ffmpeg.org/
|
||||
# 2) http://dvswitch.alioth.debian.org/wiki/DV_format/
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::DV;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.01';
|
||||
|
||||
# DV profiles (ref 1)
|
||||
my @dvProfiles = (
|
||||
{
|
||||
DSF => 0,
|
||||
VideoSType => 0x0,
|
||||
FrameSize => 120000,
|
||||
VideoFormat => 'IEC 61834, SMPTE-314M - 525/60 (NTSC)',
|
||||
VideoScanType => 'Progressive',
|
||||
Colorimetry => '4:1:1',
|
||||
FrameRate => 30000/1001,
|
||||
ImageHeight => 480,
|
||||
ImageWidth => 720,
|
||||
},{
|
||||
DSF => 1,
|
||||
VideoSType => 0x0,
|
||||
FrameSize => 144000,
|
||||
VideoFormat => 'IEC 61834 - 625/50 (PAL)',
|
||||
VideoScanType => 'Progressive',
|
||||
Colorimetry => '4:2:0',
|
||||
FrameRate => 25/1,
|
||||
ImageHeight => 576,
|
||||
ImageWidth => 720,
|
||||
},{
|
||||
DSF => 1,
|
||||
VideoSType => 0x0,
|
||||
FrameSize => 144000,
|
||||
VideoFormat => 'SMPTE-314M - 625/50 (PAL)',
|
||||
VideoScanType => 'Progressive',
|
||||
Colorimetry => '4:1:1',
|
||||
FrameRate => 25/1,
|
||||
ImageHeight => 576,
|
||||
ImageWidth => 720,
|
||||
},{
|
||||
DSF => 0,
|
||||
VideoSType => 0x4,
|
||||
FrameSize => 240000,
|
||||
VideoFormat => 'DVCPRO50: SMPTE-314M - 525/60 (NTSC) 50 Mbps',
|
||||
VideoScanType => 'Progressive',
|
||||
Colorimetry => '4:2:2',
|
||||
FrameRate => 30000/1001,
|
||||
ImageHeight => 480,
|
||||
ImageWidth => 720,
|
||||
},{
|
||||
DSF => 1,
|
||||
VideoSType => 0x4,
|
||||
FrameSize => 288000,
|
||||
VideoFormat => 'DVCPRO50: SMPTE-314M - 625/50 (PAL) 50 Mbps',
|
||||
VideoScanType => 'Progressive',
|
||||
Colorimetry => '4:2:2',
|
||||
FrameRate => 25/1,
|
||||
ImageHeight => 576,
|
||||
ImageWidth => 720,
|
||||
},{
|
||||
DSF => 0,
|
||||
VideoSType => 0x14,
|
||||
FrameSize => 480000,
|
||||
VideoFormat => 'DVCPRO HD: SMPTE-370M - 1080i60 100 Mbps',
|
||||
VideoScanType => 'Interlaced',
|
||||
Colorimetry => '4:2:2',
|
||||
FrameRate => 30000/1001,
|
||||
ImageHeight => 1080,
|
||||
ImageWidth => 1280,
|
||||
},{
|
||||
DSF => 1,
|
||||
VideoSType => 0x14,
|
||||
FrameSize => 576000,
|
||||
VideoFormat => 'DVCPRO HD: SMPTE-370M - 1080i50 100 Mbps',
|
||||
VideoScanType => 'Interlaced',
|
||||
Colorimetry => '4:2:2',
|
||||
FrameRate => 25/1,
|
||||
ImageHeight => 1080,
|
||||
ImageWidth => 1440,
|
||||
},{
|
||||
DSF => 0,
|
||||
VideoSType => 0x18,
|
||||
FrameSize => 240000,
|
||||
VideoFormat => 'DVCPRO HD: SMPTE-370M - 720p60 100 Mbps',
|
||||
VideoScanType => 'Progressive',
|
||||
Colorimetry => '4:2:2',
|
||||
FrameRate => 60000/1001,
|
||||
ImageHeight => 720,
|
||||
ImageWidth => 960,
|
||||
},{
|
||||
DSF => 1,
|
||||
VideoSType => 0x18,
|
||||
FrameSize => 288000,
|
||||
VideoFormat => 'DVCPRO HD: SMPTE-370M - 720p50 100 Mbps',
|
||||
VideoScanType => 'Progressive',
|
||||
Colorimetry => '4:2:2',
|
||||
FrameRate => 50/1,
|
||||
ImageHeight => 720,
|
||||
ImageWidth => 960,
|
||||
},{
|
||||
DSF => 1,
|
||||
VideoSType => 0x1,
|
||||
FrameSize => 144000,
|
||||
VideoFormat => 'IEC 61883-5 - 625/50 (PAL)',
|
||||
VideoScanType => 'Progressive',
|
||||
Colorimetry => '4:2:0',
|
||||
FrameRate => 25/1,
|
||||
ImageHeight => 576,
|
||||
ImageWidth => 720,
|
||||
},
|
||||
);
|
||||
|
||||
# tags to extract, in the order we want to extract them
|
||||
my @dvTags = (
|
||||
'DateTimeOriginal', 'ImageWidth', 'ImageHeight', 'Duration',
|
||||
'TotalBitrate', 'VideoFormat', 'VideoScanType', 'FrameRate',
|
||||
'AspectRatio', 'Colorimetry', 'AudioChannels', 'AudioSampleRate',
|
||||
'AudioBitsPerSample',
|
||||
);
|
||||
|
||||
# DV tags
|
||||
%Image::ExifTool::DV::Main = (
|
||||
GROUPS => { 2 => 'Video' },
|
||||
VARS => { NO_ID => 1 },
|
||||
NOTES => 'The following tags are extracted from DV videos.',
|
||||
DateTimeOriginal => {
|
||||
Groups => { 2 => 'Time' },
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
ImageWidth => { },
|
||||
ImageHeight => { },
|
||||
Duration => { PrintConv => 'ConvertDuration($val)' },
|
||||
TotalBitrate => { PrintConv => 'ConvertBitrate($val)' },
|
||||
VideoFormat => { },
|
||||
VideoScanType => { },
|
||||
FrameRate => { PrintConv => 'int($val * 1000 + 0.5) / 1000' },
|
||||
AspectRatio => { },
|
||||
Colorimetry => { },
|
||||
AudioChannels => { Groups => { 2 => 'Audio' } },
|
||||
AudioSampleRate => { Groups => { 2 => 'Audio' } },
|
||||
AudioBitsPerSample => { Groups => { 2 => 'Audio' } },
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read information in a DV file (ref 1)
|
||||
# Inputs: 0) ExifTool ref, 1) dirInfo ref
|
||||
# Returns: 1 on success, 0 if this wasn't a valid DV file
|
||||
sub ProcessDV($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
local $_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my ($buff, $start, $profile, $tag, $i, $j);
|
||||
|
||||
$raf->Read($buff, 12000) or return 0;
|
||||
if ($buff =~ /\x1f\x07\0[\x3f\xbf]/sg) {
|
||||
$start = pos($buff) - 4;
|
||||
} else {
|
||||
while ($buff =~ /[\0\xff]\x3f\x07\0.{76}\xff\x3f\x07\x01/sg) {
|
||||
next if pos($buff) - 163 < 0;
|
||||
$start = pos($buff) - 163;
|
||||
last;
|
||||
}
|
||||
return 0 unless defined $start;
|
||||
}
|
||||
my $len = length $buff;
|
||||
# must at least have a full DIF header
|
||||
return 0 if $start + 80 * 6 > $len;
|
||||
|
||||
$et->SetFileType();
|
||||
|
||||
my $pos = $start;
|
||||
my $dsf = Get8u(\$buff, $pos + 3) & 0x80 >> 7;
|
||||
my $stype = Get8u(\$buff, $pos + 80*5 + 48 + 3) & 0x1f;
|
||||
|
||||
# 576i50 25Mbps 4:1:1 is a special case
|
||||
if ($dsf == 1 && $stype == 0 && Get8u(\$buff, 4) & 0x07) {
|
||||
$profile = $dvProfiles[2];
|
||||
} else {
|
||||
foreach (@dvProfiles) {
|
||||
next unless $dsf == $$_{DSF} and $stype == $$_{VideoSType};
|
||||
$profile = $_;
|
||||
last;
|
||||
}
|
||||
$profile or $et->Warn("Unrecognized DV profile"), return 1;
|
||||
}
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::DV::Main');
|
||||
|
||||
# calculate total bit rate and duration
|
||||
my $byteRate = $$profile{FrameSize} * $$profile{FrameRate};
|
||||
my $fileSize = $$et{VALUE}{FileSize};
|
||||
$$profile{TotalBitrate} = 8 * $byteRate;
|
||||
$$profile{Duration} = $fileSize / $byteRate if defined $fileSize;
|
||||
|
||||
# read DVPack metadata from the VAUX DIF's to extract video tags
|
||||
delete $$profile{DateTimeOriginal};
|
||||
delete $$profile{AspectRatio};
|
||||
my ($date, $time, $is16_9);
|
||||
for ($i=1; $i<6; ++$i) {
|
||||
$pos += 80;
|
||||
my $type = Get8u(\$buff, $pos);
|
||||
next unless ($type & 0xf0) == 0x50; # look for VAUX types
|
||||
for ($j=0; $j<15; ++$j) {
|
||||
my $p = $pos + $j * 5 + 3;
|
||||
$type = Get8u(\$buff, $p);
|
||||
if ($type == 0x61) { # video control
|
||||
my $apt = Get8u(\$buff, $start + 4) & 0x07;
|
||||
my $t = Get8u(\$buff, $p + 2);
|
||||
$is16_9 = (($t & 0x07) == 0x02 or (not $apt and ($t & 0x07) == 0x07));
|
||||
} elsif ($type == 0x62) { # date
|
||||
# mask off unused bits
|
||||
my @d = unpack('C*', substr($buff, $p + 1, 4));
|
||||
# (ignore timezone in byte 0 until we can test this properly - see ref 2)
|
||||
$date = sprintf('%.2x:%.2x:%.2x', $d[3], $d[2] & 0x1f, $d[1] & 0x3f);
|
||||
if ($date =~ /[a-f]/) {
|
||||
undef $date; # invalid date
|
||||
} else {
|
||||
# add century (this will work until 2089)
|
||||
$date = ($date lt '9' ? '20' : '19') . $date;
|
||||
}
|
||||
undef $time;
|
||||
} elsif ($type == 0x63 and $date) { # time
|
||||
# (ignore frames past second in byte 0 for now - see ref 2)
|
||||
my $val = Get32u(\$buff, $p + 1) & 0x007f7f3f;
|
||||
my @t = unpack('C*', substr($buff, $p + 1, 4));
|
||||
$time = sprintf('%.2x:%.2x:%.2x', $t[3] & 0x3f, $t[2] & 0x7f, $t[1] & 0x7f);
|
||||
last;
|
||||
} else {
|
||||
undef $time; # must be consecutive
|
||||
}
|
||||
}
|
||||
}
|
||||
if ($date and $time) {
|
||||
$$profile{DateTimeOriginal} = "$date $time";
|
||||
$$profile{AspectRatio} = $is16_9 ? '16:9' : '5:4' if defined $is16_9;
|
||||
}
|
||||
|
||||
# read audio tags if available
|
||||
delete $$profile{AudioSampleRate};
|
||||
delete $$profile{AudioBitsPerSample};
|
||||
delete $$profile{AudioChannels};
|
||||
$pos = $start + 80*6 + 80*16*3 + 3;
|
||||
if ($pos + 4 < $len and Get8u(\$buff, $pos) == 0x50) {
|
||||
my $smpls = Get8u(\$buff, $pos + 1);
|
||||
my $freq = (Get8u(\$buff, $pos + 4) >> 3) & 0x07;
|
||||
my $stype = Get8u(\$buff, $pos + 3) & 0x1f;
|
||||
my $quant = Get8u(\$buff, $pos + 4) & 0x07;
|
||||
if ($freq < 3) {
|
||||
$$profile{AudioSampleRate} = {0=>48000, 1=>44100, 2=>32000}->{$freq};
|
||||
}
|
||||
if ($stype < 3) {
|
||||
$stype = 2 if $stype == 0 and $quant and $freq == 2;
|
||||
$$profile{AudioChannels} = {0=>2, 1=>0, 2=>4, 3=>8}->{$stype};
|
||||
}
|
||||
$$profile{AudioBitsPerSample} = $quant ? 12 : 16;
|
||||
}
|
||||
|
||||
# save our metadata
|
||||
foreach $tag (@dvTags) {
|
||||
next unless defined $$profile{$tag};
|
||||
$et->HandleTag($tagTablePtr, $tag, $$profile{$tag});
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::DV - Read DV meta information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to read meta
|
||||
information from DV (raw Digital Video) files.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://ffmpeg.org/>
|
||||
|
||||
=item L<http://dvswitch.alioth.debian.org/wiki/DV_format/>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/DV Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,362 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: DarwinCore.pm
|
||||
#
|
||||
# Description: Darwin Core XMP tags
|
||||
#
|
||||
# Revisions: 2013-01-28 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://rs.tdwg.org/dwc/index.htm
|
||||
# 2) http://u88.n24.queensu.ca/exiftool/forum/index.php/topic,4442.0/all.html
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::DarwinCore;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool::XMP;
|
||||
|
||||
$VERSION = '1.02';
|
||||
|
||||
my %dateTimeInfo = (
|
||||
# NOTE: Do NOT put "Groups" here because Groups hash must not be common!
|
||||
Writable => 'date',
|
||||
Shift => 'Time',
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
PrintConvInv => '$self->InverseDateTime($val,undef,1)',
|
||||
);
|
||||
|
||||
my %materialSample = (
|
||||
STRUCT_NAME => 'DarwinCore MaterialSample',
|
||||
NAMESPACE => 'dwc',
|
||||
materialSampleID => { },
|
||||
);
|
||||
|
||||
my %event = (
|
||||
STRUCT_NAME => 'DarwinCore Event',
|
||||
NAMESPACE => 'dwc',
|
||||
day => { Writable => 'integer', Groups => { 2 => 'Time' } },
|
||||
earliestDate => { %dateTimeInfo, Groups => { 2 => 'Time' } },
|
||||
endDayOfYear => { Writable => 'integer', Groups => { 2 => 'Time' } },
|
||||
eventDate => { %dateTimeInfo, Groups => { 2 => 'Time' } },
|
||||
eventID => { },
|
||||
eventRemarks => { Writable => 'lang-alt' },
|
||||
eventTime => { %dateTimeInfo, Groups => { 2 => 'Time' } },
|
||||
fieldNotes => { },
|
||||
fieldNumber => { },
|
||||
habitat => { },
|
||||
latestDate => { %dateTimeInfo, Groups => { 2 => 'Time' } },
|
||||
month => { Writable => 'integer', Groups => { 2 => 'Time' } },
|
||||
parentEventID => { },
|
||||
samplingEffort => { },
|
||||
samplingProtocol => { },
|
||||
sampleSizeValue => { },
|
||||
sampleSizeUnit => { },
|
||||
startDayOfYear => { Writable => 'integer', Groups => { 2 => 'Time' } },
|
||||
verbatimEventDate => { Groups => { 2 => 'Time' } },
|
||||
year => { Writable => 'integer', Groups => { 2 => 'Time' } },
|
||||
);
|
||||
|
||||
# Darwin Core tags
|
||||
%Image::ExifTool::DarwinCore::Main = (
|
||||
GROUPS => { 0 => 'XMP', 1 => 'XMP-dwc', 2 => 'Other' },
|
||||
NAMESPACE => 'dwc',
|
||||
WRITABLE => 'string',
|
||||
NOTES => q{
|
||||
Tags defined in the Darwin Core (dwc) XMP namespace. See
|
||||
L<http://rs.tdwg.org/dwc/index.htm> for the official specification.
|
||||
},
|
||||
Event => {
|
||||
Name => 'DCEvent', # (avoid conflict with XMP-iptcExt:Event)
|
||||
FlatName => 'Event',
|
||||
Struct => \%event,
|
||||
},
|
||||
# tweak a few of the flattened tag names
|
||||
EventEventDate => { Name => 'EventDate', Flat => 1 },
|
||||
EventEventID => { Name => 'EventID', Flat => 1 },
|
||||
EventEventRemarks => { Name => 'EventRemarks', Flat => 1 },
|
||||
EventEventTime => { Name => 'EventTime', Flat => 1 },
|
||||
FossilSpecimen => { Struct => \%materialSample },
|
||||
GeologicalContext => {
|
||||
FlatName => '', # ('GeologicalContext' is too long)
|
||||
Struct => {
|
||||
STRUCT_NAME => 'DarwinCore GeologicalContext',
|
||||
NAMESPACE => 'dwc',
|
||||
bed => { },
|
||||
earliestAgeOrLowestStage => { },
|
||||
earliestEonOrLowestEonothem => { },
|
||||
earliestEpochOrLowestSeries => { },
|
||||
earliestEraOrLowestErathem => { },
|
||||
earliestPeriodOrLowestSystem=> { },
|
||||
formation => { },
|
||||
geologicalContextID => { },
|
||||
group => { },
|
||||
highestBiostratigraphicZone => { },
|
||||
latestAgeOrHighestStage => { },
|
||||
latestEonOrHighestEonothem => { },
|
||||
latestEpochOrHighestSeries => { },
|
||||
latestEraOrHighestErathem => { },
|
||||
latestPeriodOrHighestSystem => { },
|
||||
lithostratigraphicTerms => { },
|
||||
lowestBiostratigraphicZone => { },
|
||||
member => { },
|
||||
},
|
||||
},
|
||||
GeologicalContextBed => { Name => 'GeologicalContextBed', Flat => 1 },
|
||||
GeologicalContextFormation => { Name => 'GeologicalContextFormation', Flat => 1 },
|
||||
GeologicalContextGroup => { Name => 'GeologicalContextGroup', Flat => 1 },
|
||||
GeologicalContextMember => { Name => 'GeologicalContextMember', Flat => 1 },
|
||||
HumanObservation => { Struct => \%event },
|
||||
Identification => {
|
||||
FlatName => '', # ('Identification' is redundant)
|
||||
Struct => {
|
||||
STRUCT_NAME => 'DarwinCore Identification',
|
||||
NAMESPACE => 'dwc',
|
||||
dateIdentified => { %dateTimeInfo, Groups => { 2 => 'Time' } },
|
||||
identificationID => { },
|
||||
identificationQualifier => { },
|
||||
identificationReferences => { },
|
||||
identificationRemarks => { },
|
||||
identificationVerificationStatus => { },
|
||||
identifiedBy => { },
|
||||
typeStatus => { },
|
||||
},
|
||||
},
|
||||
LivingSpecimen => { Struct => \%materialSample },
|
||||
MachineObservation => { Struct => \%event },
|
||||
MaterialSample => { Struct => \%materialSample },
|
||||
MaterialSampleMaterialSampleID => { Name => 'MaterialSampleID', Flat => 1 },
|
||||
MeasurementOrFact => {
|
||||
FlatName => '', # ('MeasurementOrFact' is redundant and too long)
|
||||
Struct => {
|
||||
STRUCT_NAME => 'DarwinCore MeasurementOrFact',
|
||||
NAMESPACE => 'dwc',
|
||||
measurementAccuracy => { Format => 'real' },
|
||||
measurementDeterminedBy => { },
|
||||
measurementDeterminedDate => { %dateTimeInfo, Groups => { 2 => 'Time' } },
|
||||
measurementID => { },
|
||||
measurementMethod => { },
|
||||
measurementRemarks => { },
|
||||
measurementType => { },
|
||||
measurementUnit => { },
|
||||
measurementValue => { },
|
||||
},
|
||||
},
|
||||
Occurrence => {
|
||||
Struct => {
|
||||
STRUCT_NAME => 'DarwinCore Occurrence',
|
||||
NAMESPACE => 'dwc',
|
||||
associatedMedia => { },
|
||||
associatedOccurrences => { },
|
||||
associatedReferences => { },
|
||||
associatedSequences => { },
|
||||
associatedTaxa => { },
|
||||
behavior => { },
|
||||
catalogNumber => { },
|
||||
disposition => { },
|
||||
establishmentMeans => { },
|
||||
individualCount => { },
|
||||
individualID => { },
|
||||
lifeStage => { },
|
||||
occurrenceDetails => { },
|
||||
occurrenceID => { },
|
||||
occurrenceRemarks => { },
|
||||
occurrenceStatus => { },
|
||||
organismQuantity => { },
|
||||
organismQuantityType => { },
|
||||
otherCatalogNumbers => { },
|
||||
preparations => { },
|
||||
previousIdentifications => { },
|
||||
recordedBy => { },
|
||||
recordNumber => { },
|
||||
reproductiveCondition => { },
|
||||
sex => { },
|
||||
},
|
||||
},
|
||||
OccurrenceOccurrenceDetails => { Name => 'OccurrenceDetails', Flat => 1 },
|
||||
OccurrenceOccurrenceID => { Name => 'OccurrenceID', Flat => 1 },
|
||||
OccurrenceOccurrenceRemarks => { Name => 'OccurrenceRemarks', Flat => 1 },
|
||||
OccurrenceOccurrenceStatus => { Name => 'OccurrenceStatus', Flat => 1 },
|
||||
Organism => {
|
||||
Struct => {
|
||||
STRUCT_NAME => 'DarwinCore Organism',
|
||||
NAMESPACE => 'dwc',
|
||||
associatedOccurrences => { },
|
||||
associatedOrganisms => { },
|
||||
organismID => { },
|
||||
organismName => { },
|
||||
organismRemarks => { },
|
||||
organismScope => { },
|
||||
previousIdentifications => { },
|
||||
},
|
||||
},
|
||||
OrganismOrganismID => { Name => 'OrganismID', Flat => 1 },
|
||||
OrganismOrganismName => { Name => 'OrganismName', Flat => 1 },
|
||||
OrganismOrganismRemarks => { Name => 'OrganismRemarks', Flat => 1 },
|
||||
OrganismOrganismScope => { Name => 'OrganismScope', Flat => 1 },
|
||||
PreservedSpecimen => { Struct => \%materialSample },
|
||||
Record => {
|
||||
Struct => {
|
||||
STRUCT_NAME => 'DarwinCore Record',
|
||||
NAMESPACE => 'dwc',
|
||||
basisOfRecord => { },
|
||||
collectionCode => { },
|
||||
collectionID => { },
|
||||
dataGeneralizations => { },
|
||||
datasetID => { },
|
||||
datasetName => { },
|
||||
dynamicProperties => { },
|
||||
informationWithheld => { },
|
||||
institutionCode => { },
|
||||
institutionID => { },
|
||||
ownerInstitutionCode => { },
|
||||
},
|
||||
},
|
||||
ResourceRelationship => {
|
||||
FlatName => '', # ('ResourceRelationship' is redundant and too long)
|
||||
Struct => {
|
||||
STRUCT_NAME => 'DarwinCore ResourceRelationship',
|
||||
NAMESPACE => 'dwc',
|
||||
relatedResourceID => { },
|
||||
relationshipAccordingTo => { },
|
||||
relationshipEstablishedDate => { %dateTimeInfo, Groups => { 2 => 'Time' } },
|
||||
relationshipOfResource => { },
|
||||
relationshipRemarks => { },
|
||||
resourceID => { },
|
||||
resourceRelationshipID => { },
|
||||
},
|
||||
},
|
||||
Taxon => {
|
||||
Struct => {
|
||||
STRUCT_NAME => 'DarwinCore Taxon',
|
||||
NAMESPACE => 'dwc',
|
||||
acceptedNameUsage => { },
|
||||
acceptedNameUsageID => { },
|
||||
class => { },
|
||||
family => { },
|
||||
genus => { },
|
||||
higherClassification => { },
|
||||
infraspecificEpithet => { },
|
||||
kingdom => { },
|
||||
nameAccordingTo => { },
|
||||
nameAccordingToID => { },
|
||||
namePublishedIn => { },
|
||||
namePublishedInID => { },
|
||||
namePublishedInYear => { },
|
||||
nomenclaturalCode => { },
|
||||
nomenclaturalStatus => { },
|
||||
order => { },
|
||||
originalNameUsage => { },
|
||||
originalNameUsageID => { },
|
||||
parentNameUsage => { },
|
||||
parentNameUsageID => { },
|
||||
phylum => { },
|
||||
scientificName => { },
|
||||
scientificNameAuthorship => { },
|
||||
scientificNameID => { },
|
||||
specificEpithet => { },
|
||||
subgenus => { },
|
||||
taxonConceptID => { },
|
||||
taxonID => { },
|
||||
taxonRank => { },
|
||||
taxonRemarks => { },
|
||||
taxonomicStatus => { },
|
||||
verbatimTaxonRank => { },
|
||||
vernacularName => { Writable => 'lang-alt' },
|
||||
},
|
||||
},
|
||||
TaxonTaxonConceptID => { Name => 'TaxonConceptID', Flat => 1 },
|
||||
TaxonTaxonID => { Name => 'TaxonID', Flat => 1 },
|
||||
TaxonTaxonRank => { Name => 'TaxonRank', Flat => 1 },
|
||||
TaxonTaxonRemarks => { Name => 'TaxonRemarks', Flat => 1 },
|
||||
dctermsLocation => {
|
||||
Name => 'DCTermsLocation',
|
||||
Groups => { 2 => 'Location' },
|
||||
FlatName => 'DC', # ('dctermsLocation' is too long)
|
||||
Struct => {
|
||||
STRUCT_NAME => 'DarwinCore DCTermsLocation',
|
||||
NAMESPACE => 'dwc',
|
||||
continent => { },
|
||||
coordinatePrecision => { },
|
||||
coordinateUncertaintyInMeters => { },
|
||||
country => { },
|
||||
countryCode => { },
|
||||
county => { },
|
||||
decimalLatitude => { },
|
||||
decimalLongitude => { },
|
||||
footprintSpatialFit => { },
|
||||
footprintSRS => { },
|
||||
footprintWKT => { },
|
||||
geodeticDatum => { },
|
||||
georeferencedBy => { },
|
||||
georeferencedDate => { },
|
||||
georeferenceProtocol => { },
|
||||
georeferenceRemarks => { },
|
||||
georeferenceSources => { },
|
||||
georeferenceVerificationStatus => { },
|
||||
higherGeography => { },
|
||||
higherGeographyID => { },
|
||||
island => { },
|
||||
islandGroup => { },
|
||||
locality => { },
|
||||
locationAccordingTo => { },
|
||||
locationID => { },
|
||||
locationRemarks => { },
|
||||
maximumDepthInMeters => { },
|
||||
maximumDistanceAboveSurfaceInMeters => { },
|
||||
maximumElevationInMeters => { },
|
||||
minimumDepthInMeters => { },
|
||||
minimumDistanceAboveSurfaceInMeters => { },
|
||||
minimumElevationInMeters => { },
|
||||
municipality => { },
|
||||
pointRadiusSpatialFit => { },
|
||||
stateProvince => { },
|
||||
verbatimCoordinates => { },
|
||||
verbatimCoordinateSystem => { },
|
||||
verbatimDepth => { },
|
||||
verbatimElevation => { },
|
||||
verbatimLatitude => { },
|
||||
verbatimLocality => { },
|
||||
verbatimLongitude => { },
|
||||
verbatimSRS => { },
|
||||
waterBody => { },
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
1; #end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::DarwinCore - Darwin Core XMP tags
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This file contains tag definitions for the Darwin Core XMP namespace.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://rs.tdwg.org/dwc/index.htm>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/XMP Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,378 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: DjVu.pm
|
||||
#
|
||||
# Description: Read DjVu archive meta information
|
||||
#
|
||||
# Revisions: 09/25/2008 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://djvu.sourceforge.net/ (DjVu v3 specification, Nov 2005)
|
||||
# 2) http://www.djvu.org/
|
||||
#
|
||||
# Notes: DjVu files are recognized and the IFF structure is processed
|
||||
# by Image::ExifTool::AIFF
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::DjVu;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.06';
|
||||
|
||||
sub ParseAnt($);
|
||||
sub ProcessAnt($$$);
|
||||
sub ProcessMeta($$$);
|
||||
sub ProcessBZZ($$$);
|
||||
|
||||
# DjVu chunks that we parse (ref 4)
|
||||
%Image::ExifTool::DjVu::Main = (
|
||||
GROUPS => { 2 => 'Image' },
|
||||
NOTES => q{
|
||||
Information is extracted from the following chunks in DjVu images. See
|
||||
L<http://www.djvu.org/> for the DjVu specification.
|
||||
},
|
||||
INFO => {
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::DjVu::Info' },
|
||||
},
|
||||
FORM => {
|
||||
TypeOnly => 1, # extract chunk type only, then descend into chunk
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::DjVu::Form' },
|
||||
},
|
||||
ANTa => {
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::DjVu::Ant' },
|
||||
},
|
||||
ANTz => {
|
||||
Name => 'CompressedAnnotation',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::DjVu::Ant',
|
||||
ProcessProc => \&ProcessBZZ,
|
||||
}
|
||||
},
|
||||
INCL => 'IncludedFileID',
|
||||
);
|
||||
|
||||
# information in the DjVu INFO chunk
|
||||
%Image::ExifTool::DjVu::Info = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 2 => 'Image' },
|
||||
FORMAT => 'int8u',
|
||||
PRIORITY => 0, # first INFO block takes priority
|
||||
0 => {
|
||||
Name => 'ImageWidth',
|
||||
Format => 'int16u',
|
||||
},
|
||||
2 => {
|
||||
Name => 'ImageHeight',
|
||||
Format => 'int16u',
|
||||
},
|
||||
4 => {
|
||||
Name => 'DjVuVersion',
|
||||
Description => 'DjVu Version',
|
||||
Format => 'int8u[2]',
|
||||
# (this may be just one byte as with version 0.16)
|
||||
ValueConv => '$val=~/(\d+) (\d+)/ ? "$2.$1" : "0.$val"',
|
||||
},
|
||||
6 => {
|
||||
Name => 'SpatialResolution',
|
||||
Format => 'int16u',
|
||||
ValueConv => '(($val & 0xff)<<8) + ($val>>8)', # (little-endian!)
|
||||
},
|
||||
8 => {
|
||||
Name => 'Gamma',
|
||||
ValueConv => '$val / 10',
|
||||
},
|
||||
9 => {
|
||||
Name => 'Orientation',
|
||||
Mask => 0x07, # (upper 5 bits reserved)
|
||||
PrintConv => {
|
||||
1 => 'Horizontal (normal)',
|
||||
2 => 'Rotate 180',
|
||||
5 => 'Rotate 90 CW',
|
||||
6 => 'Rotate 270 CW',
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
# information in the DjVu FORM chunk
|
||||
%Image::ExifTool::DjVu::Form = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 2 => 'Image' },
|
||||
0 => {
|
||||
Name => 'SubfileType',
|
||||
Format => 'undef[4]',
|
||||
Priority => 0,
|
||||
PrintConv => {
|
||||
DJVU => 'Single-page image',
|
||||
DJVM => 'Multi-page document',
|
||||
PM44 => 'Color IW44',
|
||||
BM44 => 'Grayscale IW44',
|
||||
DJVI => 'Shared component',
|
||||
THUM => 'Thumbnail image',
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
# tags found in the DjVu annotation chunk (ANTz or ANTa)
|
||||
%Image::ExifTool::DjVu::Ant = (
|
||||
PROCESS_PROC => \&Image::ExifTool::DjVu::ProcessAnt,
|
||||
GROUPS => { 2 => 'Image' },
|
||||
NOTES => 'Information extracted from annotation chunks.',
|
||||
# Note: For speed, ProcessAnt() pre-scans for known tag ID's, so if any
|
||||
# new tags are added here they must also be added to the pre-scan check
|
||||
metadata => {
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::DjVu::Meta' }
|
||||
},
|
||||
xmp => {
|
||||
Name => 'XMP',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' }
|
||||
},
|
||||
);
|
||||
|
||||
# tags found in the DjVu annotation metadata
|
||||
%Image::ExifTool::DjVu::Meta = (
|
||||
PROCESS_PROC => \&Image::ExifTool::DjVu::ProcessMeta,
|
||||
GROUPS => { 1 => 'DjVu-Meta', 2 => 'Image' },
|
||||
NOTES => q{
|
||||
This table lists the standard DjVu metadata tags, but ExifTool will extract
|
||||
any tags that exist even if they don't appear here. The DjVu v3
|
||||
documentation endorses tags borrowed from two standards: 1) BibTeX
|
||||
bibliography system tags (all lowercase Tag ID's in the table below), and 2)
|
||||
PDF DocInfo tags (capitalized Tag ID's).
|
||||
},
|
||||
# BibTeX tags (ref http://en.wikipedia.org/wiki/BibTeX)
|
||||
address => { Groups => { 2 => 'Location' } },
|
||||
annote => { Name => 'Annotation' },
|
||||
author => { Groups => { 2 => 'Author' } },
|
||||
booktitle => { Name => 'BookTitle' },
|
||||
chapter => { },
|
||||
crossref => { Name => 'CrossRef' },
|
||||
edition => { },
|
||||
eprint => { Name => 'EPrint' },
|
||||
howpublished=> { Name => 'HowPublished' },
|
||||
institution => { },
|
||||
journal => { },
|
||||
key => { },
|
||||
month => { Groups => { 2 => 'Time' } },
|
||||
note => { },
|
||||
number => { },
|
||||
organization=> { },
|
||||
pages => { },
|
||||
publisher => { },
|
||||
school => { },
|
||||
series => { },
|
||||
title => { },
|
||||
type => { },
|
||||
url => { Name => 'URL' },
|
||||
volume => { },
|
||||
year => { Groups => { 2 => 'Time' } },
|
||||
# PDF tags (same as Image::ExifTool::PDF::Info)
|
||||
Title => { },
|
||||
Author => { Groups => { 2 => 'Author' } },
|
||||
Subject => { },
|
||||
Keywords => { },
|
||||
Creator => { },
|
||||
Producer => { },
|
||||
CreationDate => {
|
||||
Name => 'CreateDate',
|
||||
Groups => { 2 => 'Time' },
|
||||
# RFC 3339 date/time format
|
||||
ValueConv => 'require Image::ExifTool::XMP; Image::ExifTool::XMP::ConvertXMPDate($val)',
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
ModDate => {
|
||||
Name => 'ModifyDate',
|
||||
Groups => { 2 => 'Time' },
|
||||
ValueConv => 'require Image::ExifTool::XMP; Image::ExifTool::XMP::ConvertXMPDate($val)',
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
Trapped => {
|
||||
# remove leading '/' from '/True' or '/False'
|
||||
ValueConv => '$val=~s{^/}{}; $val',
|
||||
},
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Parse DjVu annotation "s-expression" syntax (recursively)
|
||||
# Inputs: 0) data ref (with pos($$dataPt) set to start of annotation)
|
||||
# Returns: reference to list of tokens/references, or undef if no tokens,
|
||||
# and the position in $$dataPt is set to end of last token
|
||||
# Notes: The DjVu annotation syntax is not well documented, so I make
|
||||
# a number of assumptions here!
|
||||
sub ParseAnt($)
|
||||
{
|
||||
my $dataPt = shift;
|
||||
my (@toks, $tok, $more);
|
||||
# (the DjVu annotation syntax really sucks, and requires that every
|
||||
# single token be parsed in order to properly scan through the items)
|
||||
Tok: for (;;) {
|
||||
# find the next token
|
||||
last unless $$dataPt =~ /(\S)/sg; # get next non-space character
|
||||
if ($1 eq '(') { # start of list
|
||||
$tok = ParseAnt($dataPt);
|
||||
} elsif ($1 eq ')') { # end of list
|
||||
$more = 1;
|
||||
last;
|
||||
} elsif ($1 eq '"') { # quoted string
|
||||
$tok = '';
|
||||
for (;;) {
|
||||
# get string up to the next quotation mark
|
||||
# this doesn't work in perl 5.6.2! grrrr
|
||||
# last Tok unless $$dataPt =~ /(.*?)"/sg;
|
||||
# $tok .= $1;
|
||||
my $pos = pos($$dataPt);
|
||||
last Tok unless $$dataPt =~ /"/sg;
|
||||
$tok .= substr($$dataPt, $pos, pos($$dataPt)-1-$pos);
|
||||
# we're good unless quote was escaped by odd number of backslashes
|
||||
last unless $tok =~ /(\\+)$/ and length($1) & 0x01;
|
||||
$tok .= '"'; # quote is part of the string
|
||||
}
|
||||
# must protect unescaped "$" and "@" symbols, and "\" at end of string
|
||||
$tok =~ s{\\(.)|([\$\@]|\\$)}{'\\'.($2 || $1)}sge;
|
||||
# convert C escape sequences (allowed in quoted text)
|
||||
$tok = eval qq{"$tok"};
|
||||
} else { # key name
|
||||
pos($$dataPt) = pos($$dataPt) - 1;
|
||||
# allow anything in key but whitespace, braces and double quotes
|
||||
# (this is one of those assumptions I mentioned)
|
||||
$$dataPt =~ /([^\s()"]+)/sg;
|
||||
$tok = $1;
|
||||
}
|
||||
push @toks, $tok if defined $tok;
|
||||
}
|
||||
# prevent further parsing unless more after this
|
||||
pos($$dataPt) = length $$dataPt unless $more;
|
||||
return @toks ? \@toks : undef;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process DjVu annotation chunk (ANTa or decoded ANTz)
|
||||
# Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) tag table ref
|
||||
# Returns: 1 on success
|
||||
sub ProcessAnt($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
|
||||
# quick pre-scan to check for metadata or XMP
|
||||
return 1 unless $$dataPt =~ /\(\s*(metadata|xmp)[\s("]/s;
|
||||
|
||||
# parse annotations into a tree structure
|
||||
pos($$dataPt) = 0;
|
||||
my $toks = ParseAnt($dataPt) or return 0;
|
||||
|
||||
# process annotations individually
|
||||
my $ant;
|
||||
foreach $ant (@$toks) {
|
||||
next unless ref $ant eq 'ARRAY' and @$ant >= 2;
|
||||
my $tag = shift @$ant;
|
||||
next if ref $tag or not defined $$tagTablePtr{$tag};
|
||||
if ($tag eq 'metadata') {
|
||||
# ProcessMeta() takes array reference
|
||||
$et->HandleTag($tagTablePtr, $tag, $ant);
|
||||
} else {
|
||||
next if ref $$ant[0]; # only process simple values
|
||||
$et->HandleTag($tagTablePtr, $tag, $$ant[0]);
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process DjVu metadata
|
||||
# Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) tag table ref
|
||||
# Returns: 1 on success
|
||||
# Notes: input dirInfo DataPt is a reference to a list of pre-parsed metadata entries
|
||||
sub ProcessMeta($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
return 0 unless ref $$dataPt eq 'ARRAY';
|
||||
$et->VerboseDir('Metadata', scalar @$$dataPt);
|
||||
my ($item, $err);
|
||||
foreach $item (@$$dataPt) {
|
||||
# make sure item is a simple tag/value pair
|
||||
$err=1, next unless ref $item eq 'ARRAY' and @$item >= 2 and
|
||||
not ref $$item[0] and not ref $$item[1];
|
||||
# add any new tags to the table
|
||||
unless ($$tagTablePtr{$$item[0]}) {
|
||||
my $name = $$item[0];
|
||||
$name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters
|
||||
length $name or $err = 1, next;
|
||||
AddTagToTable($tagTablePtr, $$item[0], { Name => ucfirst($name) });
|
||||
}
|
||||
$et->HandleTag($tagTablePtr, $$item[0], $$item[1]);
|
||||
}
|
||||
$err and $et->Warn('Ignored invalid metadata entry(s)');
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process BZZ-compressed data (in DjVu images)
|
||||
# Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) tag table ref
|
||||
# Returns: 1 on success
|
||||
sub ProcessBZZ($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
require Image::ExifTool::BZZ;
|
||||
my $buff = Image::ExifTool::BZZ::Decode($$dirInfo{DataPt});
|
||||
unless (defined $buff) {
|
||||
$et->Warn("Error decoding $$dirInfo{DirName}");
|
||||
return 0;
|
||||
}
|
||||
my $verbose = $et->Options('Verbose');
|
||||
if ($verbose >= 3) {
|
||||
# dump the decoded data in very verbose mode
|
||||
$et->VerboseDir("Decoded $$dirInfo{DirName}", 0, length $buff);
|
||||
$et->VerboseDump(\$buff);
|
||||
}
|
||||
$$dirInfo{DataPt} = \$buff;
|
||||
$$dirInfo{DataLen} = $$dirInfo{DirLen} = length $buff;
|
||||
# process the data using the default process proc for this table
|
||||
my $processProc = $$tagTablePtr{PROCESS_PROC} or return 0;
|
||||
return &$processProc($et, $dirInfo, $tagTablePtr);
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::DjVu - Read DjVu meta information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to extract meta
|
||||
information from DjVu images. Parsing of the DjVu IFF structure is done by
|
||||
Image::ExifTool::AIFF.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://djvu.sourceforge.net/>
|
||||
|
||||
=item L<http://www.djvu.org/>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/DjVu Tags>,
|
||||
L<Image::ExifTool::AIFF(3pm)|Image::ExifTool::AIFF>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,307 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: FLAC.pm
|
||||
#
|
||||
# Description: Read Free Lossless Audio Codec information
|
||||
#
|
||||
# Revisions: 11/13/2006 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://flac.sourceforge.net/
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::FLAC;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.08';
|
||||
|
||||
sub ProcessBitStream($$$);
|
||||
|
||||
# FLAC metadata blocks
|
||||
%Image::ExifTool::FLAC::Main = (
|
||||
NOTES => q{
|
||||
Free Lossless Audio Codec (FLAC) meta information. ExifTool also extracts
|
||||
ID3 information from these files.
|
||||
},
|
||||
0 => {
|
||||
Name => 'StreamInfo',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::FLAC::StreamInfo' },
|
||||
},
|
||||
1 => { Name => 'Padding', Binary => 1, Unknown => 1 },
|
||||
2 => { Name => 'Application', Binary => 1, Unknown => 1 },
|
||||
3 => { Name => 'SeekTable', Binary => 1, Unknown => 1 },
|
||||
4 => {
|
||||
Name => 'VorbisComment',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Vorbis::Comments' },
|
||||
},
|
||||
5 => { Name => 'CueSheet', Binary => 1, Unknown => 1 },
|
||||
6 => {
|
||||
Name => 'Picture',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::FLAC::Picture' },
|
||||
},
|
||||
# 7-126 - Reserved
|
||||
# 127 - Invalid
|
||||
);
|
||||
|
||||
%Image::ExifTool::FLAC::StreamInfo = (
|
||||
PROCESS_PROC => \&ProcessBitStream,
|
||||
NOTES => 'FLAC is big-endian, so bit 0 is the high-order bit in this table.',
|
||||
GROUPS => { 2 => 'Audio' },
|
||||
'Bit000-015' => 'BlockSizeMin',
|
||||
'Bit016-031' => 'BlockSizeMax',
|
||||
'Bit032-055' => 'FrameSizeMin',
|
||||
'Bit056-079' => 'FrameSizeMax',
|
||||
'Bit080-099' => 'SampleRate',
|
||||
'Bit100-102' => {
|
||||
Name => 'Channels',
|
||||
ValueConv => '$val + 1',
|
||||
},
|
||||
'Bit103-107' => {
|
||||
Name => 'BitsPerSample',
|
||||
ValueConv => '$val + 1',
|
||||
},
|
||||
'Bit108-143' => 'TotalSamples',
|
||||
'Bit144-271' => { #Tim Eliseo
|
||||
Name => 'MD5Signature',
|
||||
Format => 'undef',
|
||||
ValueConv => 'unpack("H*",$val)',
|
||||
},
|
||||
);
|
||||
|
||||
%Image::ExifTool::FLAC::Picture = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 2 => 'Image' },
|
||||
FORMAT => 'int32u',
|
||||
0 => {
|
||||
Name => 'PictureType',
|
||||
PrintConv => { # (Note: Duplicated in ID3, ASF and FLAC modules!)
|
||||
0 => 'Other',
|
||||
1 => '32x32 PNG Icon',
|
||||
2 => 'Other Icon',
|
||||
3 => 'Front Cover',
|
||||
4 => 'Back Cover',
|
||||
5 => 'Leaflet',
|
||||
6 => 'Media',
|
||||
7 => 'Lead Artist',
|
||||
8 => 'Artist',
|
||||
9 => 'Conductor',
|
||||
10 => 'Band',
|
||||
11 => 'Composer',
|
||||
12 => 'Lyricist',
|
||||
13 => 'Recording Studio or Location',
|
||||
14 => 'Recording Session',
|
||||
15 => 'Performance',
|
||||
16 => 'Capture from Movie or Video',
|
||||
17 => 'Bright(ly) Colored Fish',
|
||||
18 => 'Illustration',
|
||||
19 => 'Band Logo',
|
||||
20 => 'Publisher Logo',
|
||||
},
|
||||
},
|
||||
1 => {
|
||||
Name => 'PictureMIMEType',
|
||||
Format => 'var_pstr32',
|
||||
},
|
||||
2 => {
|
||||
Name => 'PictureDescription',
|
||||
Format => 'var_pstr32',
|
||||
ValueConv => '$self->Decode($val, "UTF8")',
|
||||
},
|
||||
3 => 'PictureWidth',
|
||||
4 => 'PictureHeight',
|
||||
5 => 'PictureBitsPerPixel',
|
||||
6 => 'PictureIndexedColors',
|
||||
7 => 'PictureLength',
|
||||
8 => {
|
||||
Name => 'Picture',
|
||||
Groups => { 2 => 'Preview' },
|
||||
Format => 'undef[$val{7}]',
|
||||
Binary => 1,
|
||||
},
|
||||
);
|
||||
|
||||
# FLAC composite tags
|
||||
%Image::ExifTool::FLAC::Composite = (
|
||||
Duration => {
|
||||
Require => {
|
||||
0 => 'FLAC:SampleRate',
|
||||
1 => 'FLAC:TotalSamples',
|
||||
},
|
||||
ValueConv => '($val[0] and $val[1]) ? $val[1] / $val[0] : undef',
|
||||
PrintConv => 'ConvertDuration($val)',
|
||||
},
|
||||
);
|
||||
|
||||
# add our composite tags
|
||||
Image::ExifTool::AddCompositeTags('Image::ExifTool::FLAC');
|
||||
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process information in a bit stream
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Notes: Byte order is used to determine the ordering of bits in the stream:
|
||||
# 'MM' = bit 0 is most significant, 'II' = bit 0 is least significant
|
||||
# - can handle arbitrarily wide values (eg. 8-byte or larger integers)
|
||||
sub ProcessBitStream($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dataPos = $$dirInfo{DataPos};
|
||||
my $dirStart = $$dirInfo{DirStart} || 0;
|
||||
my $dirLen = $$dirInfo{DirLen} || (length($$dataPt) - $dirStart);
|
||||
my $verbose = $et->Options('Verbose');
|
||||
my $byteOrder = GetByteOrder();
|
||||
my $tag;
|
||||
|
||||
if ($verbose) {
|
||||
$et->VPrint(0, " + [BitStream directory, $dirLen bytes, '${byteOrder}' order]\n");
|
||||
}
|
||||
foreach $tag (sort keys %$tagTablePtr) {
|
||||
next unless $tag =~ /^Bit(\d+)-?(\d+)?/;
|
||||
my ($b1, $b2) = ($1, $2 || $1); # start/end bit numbers in stream
|
||||
my ($i1, $i2) = (int($b1 / 8), int($b2 / 8)); # start/end byte numbers
|
||||
my ($f1, $f2) = ($b1 % 8, $b2 % 8); # start/end bit numbers within each byte
|
||||
last if $i2 >= $dirLen;
|
||||
my ($val, $extra);
|
||||
# if Format is unspecified, convert the specified number of bits to an unsigned integer,
|
||||
# otherwise allow HandleTag to convert whole bytes the normal way (via undefined $val)
|
||||
if (ref $$tagTablePtr{$tag} ne 'HASH' or not $$tagTablePtr{$tag}{Format}) {
|
||||
my ($i, $mask);
|
||||
$val = 0;
|
||||
$extra = ', Mask=0x' if $verbose and ($f1 != 0 or $f2 != 7);
|
||||
if ($byteOrder eq 'MM') {
|
||||
# loop from high byte to low byte
|
||||
for ($i=$i1; $i<=$i2; ++$i) {
|
||||
$mask = 0xff;
|
||||
if ($i == $i1 and $f1) {
|
||||
# mask off high bits in first word (0 is high bit)
|
||||
foreach ((8-$f1) .. 7) { $mask ^= (1 << $_) }
|
||||
}
|
||||
if ($i == $i2 and $f2 < 7) {
|
||||
# mask off low bits in last word (7 is low bit)
|
||||
foreach (0 .. (6-$f2)) { $mask ^= (1 << $_) }
|
||||
}
|
||||
$val = $val * 256 + ($mask & Get8u($dataPt, $i + $dirStart));
|
||||
$extra .= sprintf('%.2x', $mask) if $extra;
|
||||
}
|
||||
} else {
|
||||
# (FLAC is big-endian, but support little-endian bit streams
|
||||
# so this routine can be used by other modules)
|
||||
# loop from high byte to low byte
|
||||
for ($i=$i2; $i>=$i1; --$i) {
|
||||
$mask = 0xff;
|
||||
if ($i == $i1 and $f1) {
|
||||
# mask off low bits in first word (0 is low bit)
|
||||
foreach (0 .. ($f1-1)) { $mask ^= (1 << $_) }
|
||||
}
|
||||
if ($i == $i2 and $f2 < 7) {
|
||||
# mask off high bits in last word (7 is high bit)
|
||||
foreach (($f2+1) .. 7) { $mask ^= (1 << $_) }
|
||||
}
|
||||
$val = $val * 256 + ($mask & Get8u($dataPt, $i + $dirStart));
|
||||
$extra .= sprintf('%.2x', $mask) if $extra;
|
||||
}
|
||||
}
|
||||
# shift word down until low bit is in position 0
|
||||
until ($mask & 0x01) {
|
||||
$val /= 2;
|
||||
$mask >>= 1;
|
||||
}
|
||||
}
|
||||
$et->HandleTag($tagTablePtr, $tag, $val,
|
||||
DataPt => $dataPt,
|
||||
DataPos => $dataPos,
|
||||
Start => $dirStart + $i1,
|
||||
Size => $i2 - $i1 + 1,
|
||||
Extra => $extra,
|
||||
);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Extract information from an Ogg FLAC file
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
||||
# Returns: 1 on success, 0 if this wasn't a valid Ogg FLAC file
|
||||
sub ProcessFLAC($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
|
||||
# must first check for leading/trailing ID3 information
|
||||
unless ($$et{DoneID3}) {
|
||||
require Image::ExifTool::ID3;
|
||||
Image::ExifTool::ID3::ProcessID3($et, $dirInfo) and return 1;
|
||||
}
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $verbose = $et->Options('Verbose');
|
||||
my $out = $et->Options('TextOut');
|
||||
my ($buff, $err);
|
||||
|
||||
# check FLAC signature
|
||||
$raf->Read($buff, 4) == 4 and $buff eq 'fLaC' or return 0;
|
||||
$et->SetFileType();
|
||||
SetByteOrder('MM');
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::FLAC::Main');
|
||||
for (;;) {
|
||||
# read next metadata block header
|
||||
$raf->Read($buff, 4) == 4 or last;
|
||||
my $flag = unpack('C', $buff);
|
||||
my $size = unpack('N', $buff) & 0x00ffffff;
|
||||
$raf->Read($buff, $size) == $size or $err = 1, last;
|
||||
my $last = $flag & 0x80; # last-metadata-block flag
|
||||
my $tag = $flag & 0x7f; # tag bits
|
||||
if ($verbose) {
|
||||
print $out "FLAC metadata block, type $tag:\n";
|
||||
$et->VerboseDump(\$buff, DataPos => $raf->Tell() - $size);
|
||||
}
|
||||
$et->HandleTag($tagTablePtr, $tag, undef,
|
||||
DataPt => \$buff,
|
||||
DataPos => $raf->Tell() - $size,
|
||||
);
|
||||
last if $last; # all done if is set
|
||||
}
|
||||
$err and $et->Warn('Format error in FLAC file');
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::FLAC - Read Free Lossless Audio Codec information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to extract meta
|
||||
information from Free Lossless Audio Codec (FLAC) audio files.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://flac.sourceforge.net/>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/FLAC Tags>,
|
||||
L<Image::ExifTool::TagNames/Ogg Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,353 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: FLIF.pm
|
||||
#
|
||||
# Description: Read/write FLIF meta information
|
||||
#
|
||||
# Revisions: 2016/10/11 - P. Harvey Created
|
||||
# 2016/10/14 - PH Added write support
|
||||
#
|
||||
# References: 1) http://flif.info/
|
||||
# 2) https://github.com/FLIF-hub/FLIF/blob/master/doc/metadata
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::FLIF;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.02';
|
||||
|
||||
my %flifMap = (
|
||||
EXIF => 'FLIF',
|
||||
XMP => 'FLIF',
|
||||
ICC_Profile => 'FLIF',
|
||||
IFD0 => 'EXIF',
|
||||
IFD1 => 'IFD0',
|
||||
ExifIFD => 'IFD0',
|
||||
GPS => 'IFD0',
|
||||
SubIFD => 'IFD0',
|
||||
GlobParamIFD => 'IFD0',
|
||||
PrintIM => 'IFD0',
|
||||
InteropIFD => 'ExifIFD',
|
||||
MakerNotes => 'ExifIFD',
|
||||
);
|
||||
|
||||
# FLIF tags
|
||||
%Image::ExifTool::FLIF::Main = (
|
||||
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
|
||||
VARS => { HEX_ID => 0 },
|
||||
NOTES => q{
|
||||
Information extracted from Free Lossless Image Format files. See
|
||||
L<http://flif.info/> for more information.
|
||||
},
|
||||
#
|
||||
# header information
|
||||
#
|
||||
0 => {
|
||||
Name => 'ImageType',
|
||||
PrintConv => {
|
||||
'1' => 'Grayscale (non-interlaced)',
|
||||
'3' => 'RGB (non-interlaced)',
|
||||
'4' => 'RGBA (non-interlaced)',
|
||||
'A' => 'Grayscale (interlaced)',
|
||||
'C' => 'RGB (interlaced)',
|
||||
'D' => 'RGBA (interlaced)',
|
||||
'Q' => 'Grayscale Animation (non-interlaced)',
|
||||
'S' => 'RGB Animation (non-interlaced)',
|
||||
'T' => 'RGBA Animation (non-interlaced)',
|
||||
'a' => 'Grayscale Animation (interlaced)',
|
||||
'c' => 'RGB Animation (interlaced)',
|
||||
'd' => 'RGBA Animation (interlaced)',
|
||||
},
|
||||
},
|
||||
1 => {
|
||||
Name => 'BitDepth',
|
||||
PrintConv => {
|
||||
'0' => 'Custom',
|
||||
'1' => 8,
|
||||
'2' => 16,
|
||||
},
|
||||
},
|
||||
2 => 'ImageWidth',
|
||||
3 => 'ImageHeight',
|
||||
4 => 'AnimationFrames',
|
||||
5 => {
|
||||
Name => 'Encoding',
|
||||
PrintConv => {
|
||||
0 => 'FLIF16',
|
||||
},
|
||||
},
|
||||
#
|
||||
# metadata chunks
|
||||
#
|
||||
iCCP => {
|
||||
Name => 'ICC_Profile',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::ICC_Profile::Main',
|
||||
},
|
||||
},
|
||||
eXif => {
|
||||
Name => 'EXIF',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::Exif::Main',
|
||||
ProcessProc => \&Image::ExifTool::ProcessTIFF,
|
||||
WriteProc => \&Image::ExifTool::WriteTIFF,
|
||||
Start => 6, # (skip "Exif\0\0" header)
|
||||
Header => "Exif\0\0",
|
||||
},
|
||||
},
|
||||
eXmp => {
|
||||
Name => 'XMP',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::XMP::Main',
|
||||
},
|
||||
},
|
||||
# tRko - list of truncation offsets
|
||||
# \0 - FLIF16-format image data
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read variable-length FLIF integer
|
||||
# Inputs: 0) raf reference, 1) number to add to returned value
|
||||
# Returns: integer, or undef on EOF
|
||||
sub GetVarInt($;$)
|
||||
{
|
||||
my ($raf, $add) = @_;
|
||||
my ($val, $buff);
|
||||
for ($val=0; ; $val<<=7) {
|
||||
$raf->Read($buff, 1) or return undef;
|
||||
my $byte = ord($buff);
|
||||
$val |= ($byte & 0x7f);
|
||||
last unless $byte & 0x80;
|
||||
}
|
||||
return $val + ($add || 0);
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Construct variable-length FLIF integer
|
||||
# Inputs: 0) integer
|
||||
# Returns: FLIF variable-length integer byte stream
|
||||
sub SetVarInt($)
|
||||
{
|
||||
my $val = shift;
|
||||
my $buff = '';
|
||||
my $high = 0;
|
||||
for (;;) {
|
||||
$buff = chr(($val & 0x7f) | $high) . $buff;
|
||||
last unless $val >>= 7;
|
||||
$high = 0x80;
|
||||
}
|
||||
return $buff;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read FLIF header
|
||||
# Inputs: 0) RAF ref
|
||||
# Returns: Scalar context: binary header block
|
||||
# List context: header values (4 or 5 elements: type,depth,width,height[,frames])
|
||||
# or undef if this isn't a valid FLIF file header
|
||||
sub ReadFLIFHeader($)
|
||||
{
|
||||
my $raf = shift;
|
||||
my ($buff, @vals);
|
||||
|
||||
# verify this is a valid FLIF file
|
||||
return () unless $raf->Read($buff, 6) == 6 and $buff =~ /^FLIF([0-\x6f])([0-2])/;
|
||||
|
||||
# decode header information ("FLIF" chunk)
|
||||
push @vals, $1, $2; # type, depth
|
||||
push @vals, GetVarInt($raf,+1), GetVarInt($raf,+1); # width, height (+1 each)
|
||||
push @vals, GetVarInt($raf,+2) if $vals[0] gt 'H'; # frames (+2)
|
||||
|
||||
return () unless defined $vals[-1];
|
||||
return @vals if wantarray; # return the decoded header values
|
||||
|
||||
# return the binary header block
|
||||
my $hdrLen = $raf->Tell();
|
||||
return () unless $raf->Seek(0,0) and $raf->Read($buff, $hdrLen) == $hdrLen;
|
||||
return $buff;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# WriteFLIF : Write FLIF image
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
||||
# Returns: 1 on success, 0 if this wasn't a valid FLIF file, or -1 if
|
||||
# an output file was specified and a write error occurred
|
||||
sub WriteFLIF($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my ($buff, $soi, @addTags, %doneTag);
|
||||
|
||||
# verify FLIF header and copy it to the output file
|
||||
$buff = ReadFLIFHeader($raf) or return 0;
|
||||
my $outfile = $$dirInfo{OutFile};
|
||||
Write($outfile, $buff) or return -1;
|
||||
|
||||
$et->InitWriteDirs(\%flifMap);
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::FLIF::Main');
|
||||
|
||||
# loop through the FLIF chunks
|
||||
for (;;) {
|
||||
my ($tag, $size, $inflated);
|
||||
# read new tag (or soi) unless we already hit the soi (start of image)
|
||||
if (not defined $soi) {
|
||||
$raf->Read($buff, 4) == 4 or $et->Error('Unexpected EOF'), last;
|
||||
if ($buff lt ' ') {
|
||||
$soi = $buff; # we have hit the start of image (no more metadata)
|
||||
# make list of new tags to add
|
||||
foreach $tag ('eXif', 'eXmp', 'iCCP') {
|
||||
push @addTags, $tag if $$et{ADD_DIRS}{$$tagTablePtr{$tag}{Name}} and not $doneTag{$tag};
|
||||
}
|
||||
}
|
||||
}
|
||||
if (not defined $soi) {
|
||||
$tag = $buff;
|
||||
$size = GetVarInt($raf); # read the data size
|
||||
} elsif (@addTags) {
|
||||
$tag = shift @addTags;
|
||||
($buff, $size) = ('', 0); # create metadata from scratch
|
||||
} else {
|
||||
# finish copying file (no more metadata to add)
|
||||
Write($outfile, $soi) or return -1;
|
||||
Write($outfile, $buff) or return -1 while $raf->Read($buff, 65536);
|
||||
last; # all done!
|
||||
}
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
|
||||
if ($tagInfo and $$tagInfo{SubDirectory} and $$et{EDIT_DIRS}{$$tagInfo{Name}}) {
|
||||
$doneTag{$tag} = 1; # prevent adding this back again later
|
||||
unless (defined $soi) {
|
||||
$raf->Read($buff, $size) == $size or $et->Error("Truncated FLIF $tag chunk"), last;
|
||||
}
|
||||
# rewrite the compressed data
|
||||
if (eval { require IO::Uncompress::RawInflate } and eval { require IO::Compress::RawDeflate } ) {
|
||||
if (length $buff == 0) {
|
||||
$inflated = $buff; # (creating from scratch, so no need to inflate)
|
||||
} elsif (not IO::Uncompress::RawInflate::rawinflate(\$buff => \$inflated)) {
|
||||
$et->Error("Error inflating FLIF $tag chunk"), last;
|
||||
}
|
||||
my $subdir = $$tagInfo{SubDirectory};
|
||||
my %subdirInfo = (
|
||||
DirName => $$tagInfo{Name},
|
||||
DataPt => \$inflated,
|
||||
DirStart => length($inflated) ? $$subdir{Start} : undef,
|
||||
ReadOnly => 1, # (used only by WriteXMP)
|
||||
);
|
||||
my $subTable = GetTagTable($$subdir{TagTable});
|
||||
$inflated = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
|
||||
if (defined $inflated) {
|
||||
next unless length $inflated; # (delete directory if length is zero)
|
||||
$inflated = $$subdir{Header} . $inflated if $$subdir{Header}; # (add back header if necessary)
|
||||
unless (IO::Compress::RawDeflate::rawdeflate(\$inflated => \$buff)) {
|
||||
$et->Error("Error deflating FLIF $tag chunk"), last;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
$et->WarnOnce('Install IO::Compress::RawDeflate to write FLIF metadata');
|
||||
}
|
||||
Write($outfile, $tag, SetVarInt(length $buff), $buff) or return -1;
|
||||
} elsif (not defined $soi) {
|
||||
Write($outfile, $tag, SetVarInt($size)) or return -1;
|
||||
Image::ExifTool::CopyBlock($raf, $outfile, $size) or return -1;
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Extract information from an FLIF file
|
||||
# Inputs: 0) ExifTool object reference, 1) DirInfo reference
|
||||
# Returns: 1 on success, 0 if this wasn't a valid FLIF file
|
||||
sub ProcessFLIF($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my ($buff, $tag, $inflated);
|
||||
|
||||
# verify this is a valid FLIF file and read the header
|
||||
my @vals = ReadFLIFHeader($raf) or return 0;
|
||||
|
||||
$et->SetFileType();
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::FLIF::Main');
|
||||
my $verbose = $et->Options('Verbose');
|
||||
|
||||
# save the header information
|
||||
$et->VPrint(0, "FLIF header:\n") if $verbose;
|
||||
for ($tag=0; defined $vals[$tag]; ++$tag) {
|
||||
$et->HandleTag($tagTablePtr, $tag, $vals[$tag]);
|
||||
}
|
||||
|
||||
# loop through the FLIF chunks
|
||||
for (;;) {
|
||||
$raf->Read($tag, 4) == 4 or $et->Warn('Unexpected EOF'), last;
|
||||
my $byte = ord substr($tag, 0, 1);
|
||||
# all done if we arrived at the image chunk
|
||||
$byte < 32 and $et->HandleTag($tagTablePtr, 5, $byte), last;
|
||||
my $size = GetVarInt($raf);
|
||||
$et->VPrint(0, "FLIF $tag ($size bytes):\n") if $verbose;
|
||||
if ($$tagTablePtr{$tag}) {
|
||||
$raf->Read($buff, $size) == $size or $et->Warn("Truncated FLIF $tag chunk"), last;
|
||||
$et->VerboseDump(\$buff, Addr => $raf->Tell() - $size) if $verbose > 2;
|
||||
# inflate the compressed data
|
||||
if (eval { require IO::Uncompress::RawInflate }) {
|
||||
if (IO::Uncompress::RawInflate::rawinflate(\$buff => \$inflated)) {
|
||||
$et->HandleTag($tagTablePtr, $tag, $inflated,
|
||||
DataPt => \$inflated,
|
||||
Size => length $inflated,
|
||||
Extra => ' inflated',
|
||||
);
|
||||
} else {
|
||||
$et->Warn("Error inflating FLIF $tag chunk");
|
||||
}
|
||||
} else {
|
||||
$et->WarnOnce('Install IO::Uncompress::RawInflate to decode FLIF metadata');
|
||||
}
|
||||
} else {
|
||||
$raf->Seek($size, 1) or $et->Warn('Seek error'), last;
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::FLIF - Read/write FLIF meta information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains routines required by Image::ExifTool to read and write
|
||||
meta information in FLIF (Free Lossless Image Format) images.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://flif.info/>
|
||||
|
||||
=item L<https://github.com/FLIF-hub/FLIF/blob/master/doc/metadata>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/FLIF Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,366 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Fixup.pm
|
||||
#
|
||||
# Description: Utility to handle pointer fixups
|
||||
#
|
||||
# Revisions: 01/19/2005 - P. Harvey Created
|
||||
# 04/11/2005 - P. Harvey Allow fixups to be tagged with a marker,
|
||||
# and add new marker-related routines
|
||||
# 06/21/2006 - P. Harvey Patch to work with negative offsets
|
||||
# 07/07/2006 - P. Harvey Added support for 16-bit pointers
|
||||
# 02/19/2013 - P. Harvey Added IsEmpty()
|
||||
#
|
||||
# Data Members:
|
||||
#
|
||||
# Start - Position in data where a zero pointer points to.
|
||||
# Shift - Amount to shift offsets (relative to Start).
|
||||
# Fixups - List of Fixup object references to to shift relative to this Fixup.
|
||||
# Pointers - Hash of references to fixup pointer arrays, keyed by ByteOrder
|
||||
# string (with "2" added if pointer is 16-bit [default is 32-bit],
|
||||
# plus "_$marker" suffix if tagged with a marker name).
|
||||
#
|
||||
# Procedure:
|
||||
#
|
||||
# 1. Create a Fixup object for each data block containing pointers
|
||||
# 2. Call AddFixup with the offset of each pointer in the block
|
||||
# - pointer is assumed int32u with the current byte order
|
||||
# - may also be called with a fixup reference for contained blocks
|
||||
# 3. Add the necessary pointer offset to $$fixup{Shift}
|
||||
# 4. Add data size to $$fixup{Start} if data is added before the block
|
||||
# - automatically also shifts pointers by this amount
|
||||
# 5. Call ApplyFixup to apply the fixup to all pointers
|
||||
# - resets Shift and Start to 0 after applying fixup
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::Fixup;
|
||||
|
||||
use strict;
|
||||
use Image::ExifTool qw(GetByteOrder SetByteOrder Get32u Get32s Set32u
|
||||
Get16u Get16s Set16u);
|
||||
use vars qw($VERSION);
|
||||
|
||||
$VERSION = '1.05';
|
||||
|
||||
sub AddFixup($$;$$);
|
||||
sub ApplyFixup($$);
|
||||
sub Dump($;$);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# New - create new Fixup object
|
||||
# Inputs: 0) reference to Fixup object or Fixup class name
|
||||
sub new
|
||||
{
|
||||
local $_;
|
||||
my $that = shift;
|
||||
my $class = ref($that) || $that || 'Image::ExifTool::Fixup';
|
||||
my $self = bless {}, $class;
|
||||
|
||||
# initialize required members
|
||||
$self->{Start} = 0;
|
||||
$self->{Shift} = 0;
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Clone this object
|
||||
# Inputs: 0) reference to Fixup object or Fixup class name
|
||||
# Returns: reference to new Fixup object
|
||||
sub Clone($)
|
||||
{
|
||||
my $self = shift;
|
||||
my $clone = new Image::ExifTool::Fixup;
|
||||
$clone->{Start} = $self->{Start};
|
||||
$clone->{Shift} = $self->{Shift};
|
||||
my $phash = $self->{Pointers};
|
||||
if ($phash) {
|
||||
$clone->{Pointers} = { };
|
||||
my $byteOrder;
|
||||
foreach $byteOrder (keys %$phash) {
|
||||
my @pointers = @{$phash->{$byteOrder}};
|
||||
$clone->{Pointers}->{$byteOrder} = \@pointers;
|
||||
}
|
||||
}
|
||||
if ($self->{Fixups}) {
|
||||
$clone->{Fixups} = [ ];
|
||||
my $subFixup;
|
||||
foreach $subFixup (@{$self->{Fixups}}) {
|
||||
push @{$clone->{Fixups}}, $subFixup->Clone();
|
||||
}
|
||||
}
|
||||
return $clone;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Add fixup pointer or another fixup object below this one
|
||||
# Inputs: 0) Fixup object reference
|
||||
# 1) Scalar for pointer offset, or reference to Fixup object
|
||||
# 2) Optional marker name for the pointer
|
||||
# 3) Optional pointer format ('int16u' or 'int32u', defaults to 'int32u')
|
||||
# Notes: Byte ordering must be set properly for the pointer being added (must keep
|
||||
# track of the byte order of each offset since MakerNotes may have different byte order!)
|
||||
sub AddFixup($$;$$)
|
||||
{
|
||||
my ($self, $pointer, $marker, $format) = @_;
|
||||
if (ref $pointer) {
|
||||
$self->{Fixups} or $self->{Fixups} = [ ];
|
||||
push @{$self->{Fixups}}, $pointer;
|
||||
} else {
|
||||
my $byteOrder = GetByteOrder();
|
||||
if (defined $format) {
|
||||
if ($format eq 'int16u') {
|
||||
$byteOrder .= '2';
|
||||
} elsif ($format ne 'int32u') {
|
||||
warn "Bad Fixup pointer format $format\n";
|
||||
}
|
||||
}
|
||||
$byteOrder .= "_$marker" if defined $marker;
|
||||
my $phash = $self->{Pointers};
|
||||
$phash or $phash = $self->{Pointers} = { };
|
||||
$phash->{$byteOrder} or $phash->{$byteOrder} = [ ];
|
||||
push @{$phash->{$byteOrder}}, $pointer;
|
||||
}
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# fix up pointer offsets
|
||||
# Inputs: 0) Fixup object reference, 1) data reference
|
||||
# Outputs: Collapses fixup hierarchy into linear lists of fixup pointers
|
||||
sub ApplyFixup($$)
|
||||
{
|
||||
my ($self, $dataPt) = @_;
|
||||
|
||||
my $start = $self->{Start};
|
||||
my $shift = $self->{Shift} + $start; # make shift relative to start
|
||||
my $phash = $self->{Pointers};
|
||||
|
||||
# fix up pointers in this fixup
|
||||
if ($phash and ($start or $shift)) {
|
||||
my $saveOrder = GetByteOrder(); # save original byte ordering
|
||||
my ($byteOrder, $ptr);
|
||||
foreach $byteOrder (keys %$phash) {
|
||||
SetByteOrder(substr($byteOrder,0,2));
|
||||
# apply the fixup offset shift (must get as signed integer
|
||||
# to avoid overflow in case it was negative before)
|
||||
my ($get, $set) = ($byteOrder =~ /^(II2|MM2)/) ?
|
||||
(\&Get16s, \&Set16u) : (\&Get32s, \&Set32u);
|
||||
foreach $ptr (@{$phash->{$byteOrder}}) {
|
||||
$ptr += $start; # update pointer to new start location
|
||||
next unless $shift;
|
||||
&$set(&$get($dataPt, $ptr) + $shift, $dataPt, $ptr);
|
||||
}
|
||||
}
|
||||
SetByteOrder($saveOrder); # restore original byte ordering
|
||||
}
|
||||
# recurse into contained fixups
|
||||
if ($self->{Fixups}) {
|
||||
# create our pointer hash if it doesn't exist
|
||||
$phash or $phash = $self->{Pointers} = { };
|
||||
# loop through all contained fixups
|
||||
my $subFixup;
|
||||
foreach $subFixup (@{$self->{Fixups}}) {
|
||||
# adjust the subfixup start and shift
|
||||
$subFixup->{Start} += $start;
|
||||
$subFixup->{Shift} += $shift - $start;
|
||||
# recursively apply contained fixups
|
||||
ApplyFixup($subFixup, $dataPt);
|
||||
my $shash = $subFixup->{Pointers} or next;
|
||||
# add all pointers to our collapsed lists
|
||||
my $byteOrder;
|
||||
foreach $byteOrder (keys %$shash) {
|
||||
$phash->{$byteOrder} or $phash->{$byteOrder} = [ ];
|
||||
push @{$phash->{$byteOrder}}, @{$shash->{$byteOrder}};
|
||||
delete $shash->{$byteOrder};
|
||||
}
|
||||
delete $subFixup->{Pointers};
|
||||
}
|
||||
delete $self->{Fixups}; # remove our contained fixups
|
||||
}
|
||||
# reset our Start/Shift for the collapsed fixup
|
||||
$self->{Start} = $self->{Shift} = 0;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Is this Fixup empty?
|
||||
# Inputs: 0) Fixup object ref
|
||||
# Returns: True if there are no offsets to fix
|
||||
sub IsEmpty($)
|
||||
{
|
||||
my $self = shift;
|
||||
my $phash = $self->{Pointers};
|
||||
if ($phash) {
|
||||
my $key;
|
||||
foreach $key (keys %$phash) {
|
||||
next unless ref $$phash{$key} eq 'ARRAY';
|
||||
return 0 if @{$$phash{$key}};
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Does specified marker exist?
|
||||
# Inputs: 0) Fixup object reference, 1) marker name
|
||||
# Returns: True if fixup contains specified marker name
|
||||
sub HasMarker($$)
|
||||
{
|
||||
my ($self, $marker) = @_;
|
||||
my $phash = $self->{Pointers};
|
||||
return 0 unless $phash;
|
||||
return 1 if grep /_$marker$/, keys %$phash;
|
||||
return 0 unless $self->{Fixups};
|
||||
my $subFixup;
|
||||
foreach $subFixup (@{$self->{Fixups}}) {
|
||||
return 1 if $subFixup->HasMarker($marker);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Set all marker pointers to specified value
|
||||
# Inputs: 0) Fixup object reference, 1) data reference
|
||||
# 2) marker name, 3) pointer value, 4) offset to start of data
|
||||
sub SetMarkerPointers($$$$;$)
|
||||
{
|
||||
my ($self, $dataPt, $marker, $value, $startOffset) = @_;
|
||||
my $start = $self->{Start} + ($startOffset || 0);
|
||||
my $phash = $self->{Pointers};
|
||||
|
||||
if ($phash) {
|
||||
my $saveOrder = GetByteOrder(); # save original byte ordering
|
||||
my ($byteOrder, $ptr);
|
||||
foreach $byteOrder (keys %$phash) {
|
||||
next unless $byteOrder =~ /^(II|MM)(2?)_$marker$/;
|
||||
SetByteOrder($1);
|
||||
my $set = $2 ? \&Set16u : \&Set32u;
|
||||
foreach $ptr (@{$phash->{$byteOrder}}) {
|
||||
&$set($value, $dataPt, $ptr + $start);
|
||||
}
|
||||
}
|
||||
SetByteOrder($saveOrder); # restore original byte ordering
|
||||
}
|
||||
if ($self->{Fixups}) {
|
||||
my $subFixup;
|
||||
foreach $subFixup (@{$self->{Fixups}}) {
|
||||
$subFixup->SetMarkerPointers($dataPt, $marker, $value, $start);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Get pointer values for specified marker
|
||||
# Inputs: 0) Fixup object reference, 1) data reference,
|
||||
# 2) marker name, 3) offset to start of data
|
||||
# Returns: List of marker pointers in list context, or first marker pointer otherwise
|
||||
sub GetMarkerPointers($$$;$)
|
||||
{
|
||||
my ($self, $dataPt, $marker, $startOffset) = @_;
|
||||
my $start = $self->{Start} + ($startOffset || 0);
|
||||
my $phash = $self->{Pointers};
|
||||
my @pointers;
|
||||
|
||||
if ($phash) {
|
||||
my $saveOrder = GetByteOrder();
|
||||
my ($byteOrder, $ptr);
|
||||
foreach $byteOrder (grep /_$marker$/, keys %$phash) {
|
||||
SetByteOrder(substr($byteOrder,0,2));
|
||||
my $get = ($byteOrder =~ /^(II2|MM2)/) ? \&Get16u : \&Get32u;
|
||||
foreach $ptr (@{$phash->{$byteOrder}}) {
|
||||
push @pointers, &$get($dataPt, $ptr + $start);
|
||||
}
|
||||
}
|
||||
SetByteOrder($saveOrder); # restore original byte ordering
|
||||
}
|
||||
if ($self->{Fixups}) {
|
||||
my $subFixup;
|
||||
foreach $subFixup (@{$self->{Fixups}}) {
|
||||
push @pointers, $subFixup->GetMarkerPointers($dataPt, $marker, $start);
|
||||
}
|
||||
}
|
||||
return @pointers if wantarray;
|
||||
return $pointers[0];
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Dump fixup to console for debugging
|
||||
# Inputs: 0) Fixup object reference, 1) optional initial indent string
|
||||
sub Dump($;$)
|
||||
{
|
||||
my ($self, $indent) = @_;
|
||||
$indent or $indent = '';
|
||||
printf "${indent}Fixup start=0x%x shift=0x%x\n", $self->{Start}, $self->{Shift};
|
||||
my $phash = $self->{Pointers};
|
||||
if ($phash) {
|
||||
my $byteOrder;
|
||||
foreach $byteOrder (sort keys %$phash) {
|
||||
print "$indent $byteOrder: ", join(' ',@{$phash->{$byteOrder}}),"\n";
|
||||
}
|
||||
}
|
||||
if ($self->{Fixups}) {
|
||||
my $subFixup;
|
||||
foreach $subFixup (@{$self->{Fixups}}) {
|
||||
Dump($subFixup, $indent . ' ');
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::Fixup - Utility to handle pointer fixups
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Image::ExifTool::Fixup;
|
||||
|
||||
$fixup = new Image::ExifTool::Fixup;
|
||||
|
||||
# add a new fixup to a pointer at the specified offset in data
|
||||
$fixup->AddFixup($offset);
|
||||
|
||||
# add a new Fixup object to the tree
|
||||
$fixup->AddFixup($subFixup);
|
||||
|
||||
$fixup->{Start} += $shift1; # shift pointer offsets and values
|
||||
|
||||
$fixup->{Shift} += $shift2; # shift pointer values only
|
||||
|
||||
# recursively apply fixups to the specified data
|
||||
$fixup->ApplyFixups(\$data);
|
||||
|
||||
$fixup->Dump(); # dump debugging information
|
||||
|
||||
$fixup->IsEmpty(); # return true if no offsets to fix
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains the code to keep track of pointers in memory and to
|
||||
shift these pointers as required. It is used by ExifTool to maintain the
|
||||
pointers in image file directories (IFD's).
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
Keeps track of pointers with different byte ordering, and relies on
|
||||
Image::ExifTool::GetByteOrder() to determine the current byte ordering
|
||||
when adding new pointers to a fixup.
|
||||
|
||||
Maintains a hierarchical list of fixups so that the whole hierarchy can
|
||||
be shifted by a simple shift at the base. Hierarchy is collapsed to a
|
||||
linear list when ApplyFixups() is called.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,755 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Flash.pm
|
||||
#
|
||||
# Description: Read Shockwave Flash meta information
|
||||
#
|
||||
# Revisions: 05/16/2006 - P. Harvey Created
|
||||
# 06/07/2007 - PH Added support for FLV (Flash Video) files
|
||||
# 10/23/2008 - PH Added support for XMP in FLV and SWF
|
||||
#
|
||||
# References: 1) http://www.the-labs.com/MacromediaFlash/SWF-Spec/SWFfileformat.html
|
||||
# 2) http://sswf.sourceforge.net/SWFalexref.html
|
||||
# 3) http://osflash.org/flv/
|
||||
# 4) http://www.irisa.fr/texmex/people/dufouil/ffmpegdoxy/flv_8h.html
|
||||
# 5) http://www.adobe.com/devnet/xmp/pdfs/XMPSpecificationPart3.pdf (Oct 2008)
|
||||
# 6) http://www.adobe.com/devnet/swf/pdf/swf_file_format_spec_v9.pdf
|
||||
# 7) http://help.adobe.com/en_US/FlashMediaServer/3.5_Deving/WS5b3ccc516d4fbf351e63e3d11a0773d56e-7ff6.html
|
||||
# 8) http://www.adobe.com/devnet/flv/pdf/video_file_format_spec_v10.pdf
|
||||
#
|
||||
# Notes: I'll add AMF3 support if someone sends me a FLV with AMF3 data
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::Flash;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
use Image::ExifTool::FLAC;
|
||||
|
||||
$VERSION = '1.12';
|
||||
|
||||
sub ProcessMeta($$$;$);
|
||||
|
||||
# Meta packets that we process
|
||||
my %processMetaPacket = ( onMetaData => 1, onXMPData => 1 );
|
||||
|
||||
# information extracted from SWF header
|
||||
%Image::ExifTool::Flash::Main = (
|
||||
GROUPS => { 2 => 'Video' },
|
||||
VARS => { ALPHA_FIRST => 1 },
|
||||
NOTES => q{
|
||||
The information below is extracted from SWF (Shockwave Flash) files. Tags
|
||||
with string ID's represent information extracted from the file header.
|
||||
},
|
||||
FlashVersion => { },
|
||||
Compressed => { PrintConv => { 0 => 'False', 1 => 'True' } },
|
||||
ImageWidth => { },
|
||||
ImageHeight => { },
|
||||
FrameRate => { },
|
||||
FrameCount => { },
|
||||
Duration => {
|
||||
Notes => 'calculated from FrameRate and FrameCount',
|
||||
PrintConv => 'ConvertDuration($val)',
|
||||
},
|
||||
69 => {
|
||||
Name => 'FlashAttributes',
|
||||
PrintConv => { BITMASK => {
|
||||
0 => 'UseNetwork',
|
||||
3 => 'ActionScript3',
|
||||
4 => 'HasMetadata',
|
||||
} },
|
||||
},
|
||||
77 => {
|
||||
Name => 'XMP',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
|
||||
},
|
||||
);
|
||||
|
||||
# packets in Flash Video files
|
||||
%Image::ExifTool::Flash::FLV = (
|
||||
NOTES => q{
|
||||
Information is extracted from the following packets in FLV (Flash Video)
|
||||
files.
|
||||
},
|
||||
0x08 => {
|
||||
Name => 'Audio',
|
||||
BitMask => 0x04,
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Flash::Audio' },
|
||||
},
|
||||
0x09 => {
|
||||
Name => 'Video',
|
||||
BitMask => 0x01,
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Flash::Video' },
|
||||
},
|
||||
0x12 => {
|
||||
Name => 'Meta',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Flash::Meta' },
|
||||
},
|
||||
);
|
||||
|
||||
# tags in Flash Video packet header
|
||||
%Image::ExifTool::Flash::Audio = (
|
||||
PROCESS_PROC => \&Image::ExifTool::FLAC::ProcessBitStream,
|
||||
GROUPS => { 2 => 'Audio' },
|
||||
NOTES => 'Information extracted from the Flash Audio header.',
|
||||
'Bit0-3' => {
|
||||
Name => 'AudioEncoding',
|
||||
PrintConv => {
|
||||
0 => 'PCM-BE (uncompressed)', # PCM-BE according to ref 4
|
||||
1 => 'ADPCM',
|
||||
2 => 'MP3',
|
||||
3 => 'PCM-LE (uncompressed)', #4
|
||||
4 => 'Nellymoser 16kHz Mono', #8
|
||||
5 => 'Nellymoser 8kHz Mono',
|
||||
6 => 'Nellymoser',
|
||||
7 => 'G.711 A-law logarithmic PCM', #8
|
||||
8 => 'G.711 mu-law logarithmic PCM', #8
|
||||
# (9 is reserved, ref 8)
|
||||
10 => 'AAC', #8
|
||||
11 => 'Speex', #8
|
||||
13 => 'MP3 8-Khz', #8
|
||||
15 => 'Device-specific sound', #8
|
||||
},
|
||||
},
|
||||
'Bit4-5' => {
|
||||
Name => 'AudioSampleRate',
|
||||
ValueConv => {
|
||||
0 => 5512,
|
||||
1 => 11025,
|
||||
2 => 22050,
|
||||
3 => 44100,
|
||||
},
|
||||
},
|
||||
'Bit6' => {
|
||||
Name => 'AudioBitsPerSample',
|
||||
ValueConv => '8 * ($val + 1)',
|
||||
},
|
||||
'Bit7' => {
|
||||
Name => 'AudioChannels',
|
||||
ValueConv => '$val + 1',
|
||||
PrintConv => {
|
||||
1 => '1 (mono)',
|
||||
2 => '2 (stereo)',
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
# tags in Flash Video packet header
|
||||
%Image::ExifTool::Flash::Video = (
|
||||
PROCESS_PROC => \&Image::ExifTool::FLAC::ProcessBitStream,
|
||||
GROUPS => { 2 => 'Video' },
|
||||
NOTES => 'Information extracted from the Flash Video header.',
|
||||
'Bit4-7' => {
|
||||
Name => 'VideoEncoding',
|
||||
PrintConv => {
|
||||
1 => 'JPEG', #8
|
||||
2 => 'Sorensen H.263',
|
||||
3 => 'Screen Video',
|
||||
4 => 'On2 VP6',
|
||||
5 => 'On2 VP6 Alpha', #3
|
||||
6 => 'Screen Video 2', #3
|
||||
7 => 'H.264', #7 (called "AVC" by ref 8)
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
# tags in Flash META packet (in ActionScript Message Format)
|
||||
%Image::ExifTool::Flash::Meta = (
|
||||
PROCESS_PROC => \&ProcessMeta,
|
||||
GROUPS => { 2 => 'Video' },
|
||||
NOTES => q{
|
||||
Below are a few observed FLV Meta tags, but ExifTool will attempt to extract
|
||||
information from any tag found.
|
||||
},
|
||||
'audiocodecid' => { Name => 'AudioCodecID', Groups => { 2 => 'Audio' } },
|
||||
'audiodatarate' => {
|
||||
Name => 'AudioBitrate',
|
||||
Groups => { 2 => 'Audio' },
|
||||
ValueConv => '$val * 1000',
|
||||
PrintConv => 'ConvertBitrate($val)',
|
||||
},
|
||||
'audiodelay' => { Name => 'AudioDelay', Groups => { 2 => 'Audio' } },
|
||||
'audiosamplerate'=>{ Name => 'AudioSampleRate', Groups => { 2 => 'Audio' } },
|
||||
'audiosamplesize'=>{ Name => 'AudioSampleSize', Groups => { 2 => 'Audio' } },
|
||||
'audiosize' => { Name => 'AudioSize', Groups => { 2 => 'Audio' } },
|
||||
'bytelength' => 'ByteLength', # (youtube)
|
||||
'canseekontime' => 'CanSeekOnTime', # (youtube)
|
||||
'canSeekToEnd' => 'CanSeekToEnd',
|
||||
'creationdate' => {
|
||||
# (not an AMF date type in my sample)
|
||||
Name => 'CreateDate',
|
||||
Groups => { 2 => 'Time' },
|
||||
ValueConv => '$val=~s/\s+$//; $val', # trim trailing whitespace
|
||||
},
|
||||
'createdby' => 'CreatedBy', #7
|
||||
'cuePoints' => {
|
||||
Name => 'CuePoint',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Flash::CuePoint' },
|
||||
},
|
||||
'datasize' => 'DataSize',
|
||||
'duration' => {
|
||||
Name => 'Duration',
|
||||
PrintConv => 'ConvertDuration($val)',
|
||||
},
|
||||
'filesize' => 'FileSizeBytes',
|
||||
'framerate' => {
|
||||
Name => 'FrameRate',
|
||||
PrintConv => 'int($val * 1000 + 0.5) / 1000',
|
||||
},
|
||||
'hasAudio' => { Name => 'HasAudio', Groups => { 2 => 'Audio' } },
|
||||
'hasCuePoints' => 'HasCuePoints',
|
||||
'hasKeyframes' => 'HasKeyFrames',
|
||||
'hasMetadata' => 'HasMetadata',
|
||||
'hasVideo' => 'HasVideo',
|
||||
'height' => 'ImageHeight',
|
||||
'httphostheader'=> 'HTTPHostHeader', # (youtube)
|
||||
'keyframesTimes'=> 'KeyFramesTimes',
|
||||
'keyframesFilepositions' => 'KeyFramePositions',
|
||||
'lasttimestamp' => 'LastTimeStamp',
|
||||
'lastkeyframetimestamp' => 'LastKeyFrameTime',
|
||||
'metadatacreator'=>'MetadataCreator',
|
||||
'metadatadate' => {
|
||||
Name => 'MetadataDate',
|
||||
Groups => { 2 => 'Time' },
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
'purl' => 'URL', # (youtube) (what does P mean?)
|
||||
'pmsg' => 'Message', # (youtube) (what does P mean?)
|
||||
'sourcedata' => 'SourceData', # (youtube)
|
||||
'starttime' => { # (youtube)
|
||||
Name => 'StartTime',
|
||||
PrintConv => 'ConvertDuration($val)',
|
||||
},
|
||||
'stereo' => { Name => 'Stereo', Groups => { 2 => 'Audio' } },
|
||||
'totalduration' => { # (youtube)
|
||||
Name => 'TotalDuration',
|
||||
PrintConv => 'ConvertDuration($val)',
|
||||
},
|
||||
'totaldatarate' => { # (youtube)
|
||||
Name => 'TotalDataRate',
|
||||
ValueConv => '$val * 1000',
|
||||
PrintConv => 'int($val + 0.5)',
|
||||
},
|
||||
'totalduration' => 'TotalDuration',
|
||||
'videocodecid' => 'VideoCodecID',
|
||||
'videodatarate' => {
|
||||
Name => 'VideoBitrate',
|
||||
ValueConv => '$val * 1000',
|
||||
PrintConv => 'ConvertBitrate($val)',
|
||||
},
|
||||
'videosize' => 'VideoSize',
|
||||
'width' => 'ImageWidth',
|
||||
# tags in 'onXMPData' packets
|
||||
'liveXML' => { #5
|
||||
Name => 'XMP',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
|
||||
},
|
||||
);
|
||||
|
||||
# tags in Flash META CuePoint structure
|
||||
%Image::ExifTool::Flash::CuePoint = (
|
||||
PROCESS_PROC => \&ProcessMeta,
|
||||
GROUPS => { 2 => 'Video' },
|
||||
NOTES => q{
|
||||
These tag names are added to the CuePoint name to generate complete tag
|
||||
names like "CuePoint0Name".
|
||||
},
|
||||
'name' => 'Name',
|
||||
'type' => 'Type',
|
||||
'time' => 'Time',
|
||||
'parameters' => {
|
||||
Name => 'Parameter',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Flash::Parameter' },
|
||||
},
|
||||
);
|
||||
|
||||
# tags in Flash META CuePoint Parameter structure
|
||||
%Image::ExifTool::Flash::Parameter = (
|
||||
PROCESS_PROC => \&ProcessMeta,
|
||||
GROUPS => { 2 => 'Video' },
|
||||
NOTES => q{
|
||||
There are no pre-defined parameter tags, but ExifTool will extract any
|
||||
existing parameters, with tag names like "CuePoint0ParameterXxx".
|
||||
},
|
||||
);
|
||||
|
||||
# name lookup for known AMF data types
|
||||
my @amfType = qw(double boolean string object movieClip null undefined reference
|
||||
mixedArray objectEnd array date longString unsupported recordSet
|
||||
XML typedObject AMF3data);
|
||||
|
||||
# test for AMF structure types (object, mixed array or typed object)
|
||||
my %isStruct = ( 0x03 => 1, 0x08 => 1, 0x10 => 1 );
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process Flash Video AMF Meta packet (ref 3)
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# 3) Set to extract single type/value only
|
||||
# Returns: 1 on success, (or type/value if extracting single value)
|
||||
# Notes: Updates DataPos in dirInfo if extracting single value
|
||||
sub ProcessMeta($$$;$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr, $single) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dataPos = $$dirInfo{DataPos};
|
||||
my $dirLen = $$dirInfo{DirLen} || length($$dataPt);
|
||||
my $pos = $$dirInfo{Pos} || 0;
|
||||
my ($type, $val, $rec);
|
||||
|
||||
$et->VerboseDir('Meta') unless $single;
|
||||
|
||||
Record: for ($rec=0; ; ++$rec) {
|
||||
last if $pos >= $dirLen;
|
||||
$type = ord(substr($$dataPt, $pos));
|
||||
++$pos;
|
||||
if ($type == 0x00 or $type == 0x0b) { # double or date
|
||||
last if $pos + 8 > $dirLen;
|
||||
$val = GetDouble($dataPt, $pos);
|
||||
$pos += 8;
|
||||
if ($type == 0x0b) { # date
|
||||
$val /= 1000; # convert to seconds
|
||||
my $frac = $val - int($val); # fractional seconds
|
||||
# get time zone
|
||||
last if $pos + 2 > $dirLen;
|
||||
my $tz = Get16s($dataPt, $pos);
|
||||
$pos += 2;
|
||||
# construct date/time string
|
||||
$val = Image::ExifTool::ConvertUnixTime(int($val));
|
||||
if ($frac) {
|
||||
$frac = sprintf('%.6f', $frac);
|
||||
$frac =~ s/(^0|0+$)//g;
|
||||
$val .= $frac;
|
||||
}
|
||||
# add timezone
|
||||
if ($tz < 0) {
|
||||
$val .= '-';
|
||||
$tz *= -1;
|
||||
} else {
|
||||
$val .= '+';
|
||||
}
|
||||
$val .= sprintf('%.2d:%.2d', int($tz/60), $tz%60);
|
||||
}
|
||||
} elsif ($type == 0x01) { # boolean
|
||||
last if $pos + 1 > $dirLen;
|
||||
$val = Get8u($dataPt, $pos);
|
||||
$val = { 0 => 'No', 1 => 'Yes' }->{$val} if $val < 2;
|
||||
++$pos;
|
||||
} elsif ($type == 0x02) { # string
|
||||
last if $pos + 2 > $dirLen;
|
||||
my $len = Get16u($dataPt, $pos);
|
||||
last if $pos + 2 + $len > $dirLen;
|
||||
$val = substr($$dataPt, $pos + 2, $len);
|
||||
$pos += 2 + $len;
|
||||
} elsif ($isStruct{$type}) { # object, mixed array or typed object
|
||||
$et->VPrint(1, " + [$amfType[$type]]\n");
|
||||
my $getName;
|
||||
$val = ''; # dummy value
|
||||
if ($type == 0x08) { # mixed array
|
||||
# skip last array index for mixed array
|
||||
last if $pos + 4 > $dirLen;
|
||||
$pos += 4;
|
||||
} elsif ($type == 0x10) { # typed object
|
||||
$getName = 1;
|
||||
}
|
||||
for (;;) {
|
||||
# get tag ID (or typed object name)
|
||||
last Record if $pos + 2 > $dirLen;
|
||||
my $len = Get16u($dataPt, $pos);
|
||||
if ($pos + 2 + $len > $dirLen) {
|
||||
$et->Warn("Truncated $amfType[$type] record");
|
||||
last Record;
|
||||
}
|
||||
my $tag = substr($$dataPt, $pos + 2, $len);
|
||||
$pos += 2 + $len;
|
||||
# first string of a typed object is the object name
|
||||
if ($getName) {
|
||||
$et->VPrint(1," | (object name '${tag}')\n");
|
||||
undef $getName;
|
||||
next; # (ignore name for now)
|
||||
}
|
||||
my $subTablePtr = $tagTablePtr;
|
||||
my $tagInfo = $$subTablePtr{$tag};
|
||||
# switch to subdirectory table if necessary
|
||||
if ($tagInfo and $$tagInfo{SubDirectory}) {
|
||||
my $subTable = $tagInfo->{SubDirectory}->{TagTable};
|
||||
# descend into Flash SubDirectory
|
||||
if ($subTable =~ /^Image::ExifTool::Flash::/) {
|
||||
$tag = $$tagInfo{Name}; # use our name for the tag
|
||||
$subTablePtr = GetTagTable($subTable);
|
||||
}
|
||||
}
|
||||
# get object value
|
||||
my $valPos = $pos + 1;
|
||||
$$dirInfo{Pos} = $pos;
|
||||
my $structName = $$dirInfo{StructName};
|
||||
# add structure name to start of tag name
|
||||
$tag = $structName . ucfirst($tag) if defined $structName;
|
||||
$$dirInfo{StructName} = $tag; # set new structure name
|
||||
my ($t, $v) = ProcessMeta($et, $dirInfo, $subTablePtr, 1);
|
||||
$$dirInfo{StructName} = $structName;# restore original structure name
|
||||
$pos = $$dirInfo{Pos}; # update to new position in packet
|
||||
# all done if this value contained tags
|
||||
last Record unless defined $t and defined $v;
|
||||
next if $isStruct{$t}; # already handled tags in sub-structures
|
||||
next if ref($v) eq 'ARRAY' and not @$v; # ignore empty arrays
|
||||
last if $t == 0x09; # (end of object)
|
||||
if (not $$subTablePtr{$tag} and $tag =~ /^\w+$/) {
|
||||
AddTagToTable($subTablePtr, $tag, { Name => ucfirst($tag) });
|
||||
$et->VPrint(1, " | (adding $tag)\n");
|
||||
}
|
||||
$et->HandleTag($subTablePtr, $tag, $v,
|
||||
DataPt => $dataPt,
|
||||
DataPos => $dataPos,
|
||||
Start => $valPos,
|
||||
Size => $pos - $valPos,
|
||||
Format => $amfType[$t] || sprintf('0x%x',$t),
|
||||
);
|
||||
}
|
||||
# } elsif ($type == 0x04) { # movie clip (not supported)
|
||||
} elsif ($type == 0x05 or $type == 0x06 or $type == 0x09 or $type == 0x0d) {
|
||||
# null, undefined, dirLen of object, or unsupported
|
||||
$val = '';
|
||||
} elsif ($type == 0x07) { # reference
|
||||
last if $pos + 2 > $dirLen;
|
||||
$val = Get16u($dataPt, $pos);
|
||||
$pos += 2;
|
||||
} elsif ($type == 0x0a) { # array
|
||||
last if $pos + 4 > $dirLen;
|
||||
my $num = Get32u($dataPt, $pos);
|
||||
$$dirInfo{Pos} = $pos + 4;
|
||||
my ($i, @vals);
|
||||
# add array index to compount tag name
|
||||
my $structName = $$dirInfo{StructName};
|
||||
for ($i=0; $i<$num; ++$i) {
|
||||
$$dirInfo{StructName} = $structName . $i if defined $structName;
|
||||
my ($t, $v) = ProcessMeta($et, $dirInfo, $tagTablePtr, 1);
|
||||
last Record unless defined $v;
|
||||
# save value unless contained in a sub-structure
|
||||
push @vals, $v unless $isStruct{$t};
|
||||
}
|
||||
$$dirInfo{StructName} = $structName;
|
||||
$pos = $$dirInfo{Pos};
|
||||
$val = \@vals;
|
||||
} elsif ($type == 0x0c or $type == 0x0f) { # long string or XML
|
||||
last if $pos + 4 > $dirLen;
|
||||
my $len = Get32u($dataPt, $pos);
|
||||
last if $pos + 4 + $len > $dirLen;
|
||||
$val = substr($$dataPt, $pos + 4, $len);
|
||||
$pos += 4 + $len;
|
||||
# } elsif ($type == 0x0e) { # record set (not supported)
|
||||
# } elsif ($type == 0x11) { # AMF3 data (can't add support for this without a test sample)
|
||||
} else {
|
||||
my $t = $amfType[$type] || sprintf('type 0x%x',$type);
|
||||
$et->Warn("AMF $t record not yet supported");
|
||||
undef $type; # (so we don't print another warning)
|
||||
last; # can't continue
|
||||
}
|
||||
last if $single; # all done if extracting single value
|
||||
unless ($isStruct{$type}) {
|
||||
# only process certain Meta packets
|
||||
if ($type == 0x02 and not $rec) {
|
||||
my $verb = $processMetaPacket{$val} ? 'processing' : 'ignoring';
|
||||
$et->VPrint(0, " | ($verb $val information)\n");
|
||||
last unless $processMetaPacket{$val};
|
||||
} else {
|
||||
# give verbose indication if we ignore a lone value
|
||||
my $t = $amfType[$type] || sprintf('type 0x%x',$type);
|
||||
$et->VPrint(1, " | (ignored lone $t value '${val}')\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
if (not defined $val and defined $type) {
|
||||
$et->Warn(sprintf("Truncated AMF record 0x%x",$type));
|
||||
}
|
||||
return 1 unless $single; # all done
|
||||
$$dirInfo{Pos} = $pos; # update position
|
||||
return($type,$val); # return single type/value pair
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read information frame a Flash Video file
|
||||
# Inputs: 0) ExifTool object reference, 1) Directory information reference
|
||||
# Returns: 1 on success, 0 if this wasn't a valid Flash Video file
|
||||
sub ProcessFLV($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $verbose = $et->Options('Verbose');
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $buff;
|
||||
|
||||
$raf->Read($buff, 9) == 9 or return 0;
|
||||
$buff =~ /^FLV\x01/ or return 0;
|
||||
SetByteOrder('MM');
|
||||
$et->SetFileType();
|
||||
my ($flags, $offset) = unpack('x4CN', $buff);
|
||||
$raf->Seek($offset-9, 1) or return 1 if $offset > 9;
|
||||
$flags &= 0x05; # only look for audio/video
|
||||
my $found = 0;
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::Flash::FLV');
|
||||
for (;;) {
|
||||
$raf->Read($buff, 15) == 15 or last;
|
||||
my $len = unpack('x4N', $buff);
|
||||
my $type = $len >> 24;
|
||||
$len &= 0x00ffffff;
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, $type);
|
||||
if ($verbose > 1) {
|
||||
my $name = $tagInfo ? $$tagInfo{Name} : "type $type";
|
||||
$et->VPrint(1, "FLV $name packet, len $len\n");
|
||||
}
|
||||
undef $buff;
|
||||
if ($tagInfo and $$tagInfo{SubDirectory}) {
|
||||
my $mask = $$tagInfo{BitMask};
|
||||
if ($mask) {
|
||||
# handle audio or video packet
|
||||
unless ($found & $mask) {
|
||||
$found |= $mask;
|
||||
$flags &= ~$mask;
|
||||
if ($len>=1 and $raf->Read($buff, 1) == 1) {
|
||||
$len -= 1;
|
||||
} else {
|
||||
$et->Warn("Bad $$tagInfo{Name} packet");
|
||||
last;
|
||||
}
|
||||
}
|
||||
} elsif ($raf->Read($buff, $len) == $len) {
|
||||
$len = 0;
|
||||
} else {
|
||||
$et->Warn('Truncated Meta packet');
|
||||
last;
|
||||
}
|
||||
}
|
||||
if (defined $buff) {
|
||||
$et->HandleTag($tagTablePtr, $type, undef,
|
||||
DataPt => \$buff,
|
||||
DataPos => $raf->Tell() - length($buff),
|
||||
);
|
||||
}
|
||||
last unless $flags;
|
||||
$raf->Seek($len, 1) or last if $len;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Found a Flash tag
|
||||
# Inputs: 0) ExifTool object ref, 1) tag name, 2) tag value
|
||||
sub FoundFlashTag($$$)
|
||||
{
|
||||
my ($et, $tag, $val) = @_;
|
||||
$et->HandleTag(\%Image::ExifTool::Flash::Main, $tag, $val);
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read data from possibly compressed file
|
||||
# Inputs: 0) RAF reference, 1) data buffer, 2) bytes to read, 2) compressed flag
|
||||
# Returns: number of bytes read (may be greater than requested bytes if compressed)
|
||||
# - concatenates data to current buffer
|
||||
# - updates compressed flag with reference to inflate object for future calls
|
||||
# (or sets to error message and returns zero on error)
|
||||
sub ReadCompressed($$$$)
|
||||
{
|
||||
my ($raf, $len, $inflate) = ($_[0], $_[2], $_[3]);
|
||||
my $buff;
|
||||
unless ($raf->Read($buff, $len)) {
|
||||
$_[3] = 'Error reading file';
|
||||
return 0;
|
||||
}
|
||||
# uncompress if necessary
|
||||
if ($inflate) {
|
||||
unless (ref $inflate) {
|
||||
unless (eval { require Compress::Zlib }) {
|
||||
$_[3] = 'Install Compress::Zlib to extract compressed information';
|
||||
return 0;
|
||||
}
|
||||
$inflate = Compress::Zlib::inflateInit();
|
||||
unless ($inflate) {
|
||||
$_[3] = 'Error initializing inflate for Flash data';
|
||||
return 0;
|
||||
}
|
||||
$_[3] = $inflate; # pass inflate object back to caller
|
||||
}
|
||||
my $tmp = $buff;
|
||||
$buff = '';
|
||||
# read 64 more bytes at a time and inflate until we get enough uncompressed data
|
||||
for (;;) {
|
||||
my ($dat, $stat) = $inflate->inflate($tmp);
|
||||
if ($stat == Compress::Zlib::Z_STREAM_END() or
|
||||
$stat == Compress::Zlib::Z_OK())
|
||||
{
|
||||
$buff .= $dat; # add inflated data to buffer
|
||||
last if length $buff >= $len or $stat == Compress::Zlib::Z_STREAM_END();
|
||||
$raf->Read($tmp,64) or last; # must read a bit more data
|
||||
} else {
|
||||
$buff = '';
|
||||
last;
|
||||
}
|
||||
}
|
||||
$_[3] = 'Error inflating compressed Flash data' unless length $buff;
|
||||
}
|
||||
$_[1] = defined $_[1] ? $_[1] . $buff : $buff;
|
||||
return length $buff;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read information frame a Flash file
|
||||
# Inputs: 0) ExifTool object reference, 1) Directory information reference
|
||||
# Returns: 1 on success, 0 if this wasn't a valid Flash file
|
||||
sub ProcessSWF($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my ($buff, $hasMeta);
|
||||
|
||||
$raf->Read($buff, 8) == 8 or return 0;
|
||||
$buff =~ /^(F|C)WS([^\0])/ or return 0;
|
||||
my ($compressed, $vers) = ($1 eq 'C' ? 1 : 0, ord($2));
|
||||
|
||||
SetByteOrder('II');
|
||||
$et->SetFileType();
|
||||
GetTagTable('Image::ExifTool::Flash::Main'); # make sure table is initialized
|
||||
|
||||
FoundFlashTag($et, FlashVersion => $vers);
|
||||
FoundFlashTag($et, Compressed => $compressed);
|
||||
|
||||
# read the next 64 bytes of the file (and inflate if necessary)
|
||||
$buff = '';
|
||||
unless (ReadCompressed($raf, $buff, 64, $compressed)) {
|
||||
$et->Warn($compressed) if $compressed;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# unpack elements of bit-packed Flash Rect structure
|
||||
my $nBits = unpack('C', $buff) >> 3; # bits in x1,x2,y1,y2 elements
|
||||
my $totBits = 5 + $nBits * 4; # total bits in Rect structure
|
||||
my $nBytes = int(($totBits + 7) / 8); # byte length of Rect structure
|
||||
if (length $buff < $nBytes + 4) {
|
||||
$et->Warn('Truncated Flash file');
|
||||
return 1;
|
||||
}
|
||||
my $bits = unpack("B$totBits", $buff);
|
||||
# isolate Rect elements and convert from ASCII bit strings to integers
|
||||
my @vals = unpack('x5' . "a$nBits" x 4, $bits);
|
||||
# (do conversion the hard way because oct("0b$val") requires Perl 5.6)
|
||||
map { $_ = unpack('N', pack('B32', '0' x (32 - length $_) . $_)) } @vals;
|
||||
|
||||
# calculate and store ImageWidth/Height
|
||||
FoundFlashTag($et, ImageWidth => ($vals[1] - $vals[0]) / 20);
|
||||
FoundFlashTag($et, ImageHeight => ($vals[3] - $vals[2]) / 20);
|
||||
|
||||
# get frame rate and count
|
||||
@vals = unpack("x${nBytes}v2", $buff);
|
||||
FoundFlashTag($et, FrameRate => $vals[0] / 256);
|
||||
FoundFlashTag($et, FrameCount => $vals[1]);
|
||||
FoundFlashTag($et, Duration => $vals[1] * 256 / $vals[0]) if $vals[0];
|
||||
|
||||
# scan through the tags to find FlashAttributes and XMP
|
||||
$buff = substr($buff, $nBytes + 4);
|
||||
for (;;) {
|
||||
my $buffLen = length $buff;
|
||||
last if $buffLen < 2;
|
||||
my $code = Get16u(\$buff, 0);
|
||||
my $pos = 2;
|
||||
my $tag = $code >> 6;
|
||||
my $size = $code & 0x3f;
|
||||
$et->VPrint(1, "SWF tag $tag ($size bytes):\n");
|
||||
last unless $tag == 69 or $tag == 77 or $hasMeta;
|
||||
# read enough to get a complete short record
|
||||
if ($pos + $size > $buffLen) {
|
||||
# (read 2 extra bytes if available to get next tag word)
|
||||
unless (ReadCompressed($raf, $buff, $size + 2, $compressed)) {
|
||||
$et->Warn($compressed) if $compressed;
|
||||
return 1;
|
||||
}
|
||||
$buffLen = length $buff;
|
||||
last if $pos + $size > $buffLen;
|
||||
}
|
||||
# read extended record if necessary
|
||||
if ($size == 0x3f) {
|
||||
last if $pos + 4 > $buffLen;
|
||||
$size = Get32u(\$buff, $pos);
|
||||
$pos += 4;
|
||||
last if $size > 1000000; # don't read anything huge
|
||||
if ($pos + $size > $buffLen) {
|
||||
unless (ReadCompressed($raf, $buff, $size + 2, $compressed)) {
|
||||
$et->Warn($compressed) if $compressed;
|
||||
return 1;
|
||||
}
|
||||
$buffLen = length $buff;
|
||||
last if $pos + $size > $buffLen;
|
||||
}
|
||||
$et->VPrint(1, " [extended size $size bytes]\n");
|
||||
}
|
||||
if ($tag == 69) { # FlashAttributes
|
||||
last unless $size;
|
||||
my $flags = Get8u(\$buff, $pos);
|
||||
FoundFlashTag($et, $tag => $flags);
|
||||
last unless $flags & 0x10; # only continue if we have metadata (XMP)
|
||||
$hasMeta = 1;
|
||||
} elsif ($tag == 77) { # Metadata
|
||||
my $val = substr($buff, $pos, $size);
|
||||
FoundFlashTag($et, $tag => $val);
|
||||
last;
|
||||
}
|
||||
last if $pos + 2 > $buffLen;
|
||||
$buff = substr($buff, $pos); # remove everything before the next tag
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::Flash - Read Shockwave Flash meta information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to read SWF
|
||||
(Shockwave Flash) and FLV (Flash Video) files.
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
Flash Video AMF3 support has not yet been added because I haven't yet found
|
||||
a FLV file containing AMF3 information. If someone sends me a sample then I
|
||||
will add AMF3 support.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://www.the-labs.com/MacromediaFlash/SWF-Spec/SWFfileformat.html>
|
||||
|
||||
=item L<http://sswf.sourceforge.net/SWFalexref.html>
|
||||
|
||||
=item L<http://osflash.org/flv/>
|
||||
|
||||
=item L<http://www.irisa.fr/texmex/people/dufouil/ffmpegdoxy/flv_8h.html>
|
||||
|
||||
=item L<http://help.adobe.com/en_US/FlashMediaServer/3.5_Deving/WS5b3ccc516d4fbf351e63e3d11a0773d56e-7ff6.html>
|
||||
|
||||
=item L<http://www.adobe.com/devnet/swf/pdf/swf_file_format_spec_v9.pdf>
|
||||
|
||||
=item L<http://www.adobe.com/devnet/flv/pdf/video_file_format_spec_v10.pdf>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/Flash Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,647 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Font.pm
|
||||
#
|
||||
# Description: Read meta information from font files
|
||||
#
|
||||
# Revisions: 2010/01/15 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://developer.apple.com/textfonts/TTRefMan/RM06/Chap6.html
|
||||
# 2) http://www.microsoft.com/typography/otspec/otff.htm
|
||||
# 3) http://partners.adobe.com/public/developer/opentype/index_font_file.html
|
||||
# 4) http://partners.adobe.com/public/developer/en/font/5178.PFM.pdf
|
||||
# 5) http://opensource.adobe.com/svn/opensource/flex/sdk/trunk/modules/compiler/src/java/flex2/compiler/util/MimeMappings.java
|
||||
# 6) http://www.adobe.com/devnet/font/pdfs/5004.AFM_Spec.pdf
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::Font;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION %ttLang);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.08';
|
||||
|
||||
sub ProcessOTF($$);
|
||||
|
||||
# TrueType 'name' platform codes
|
||||
my %ttPlatform = (
|
||||
0 => 'Unicode',
|
||||
1 => 'Macintosh',
|
||||
2 => 'ISO',
|
||||
3 => 'Windows',
|
||||
4 => 'Custom',
|
||||
);
|
||||
|
||||
# convert TrueType 'name' character encoding to ExifTool Charset (ref 1/2)
|
||||
my %ttCharset = (
|
||||
Macintosh => {
|
||||
0 => 'MacRoman', 17 => 'MacMalayalam',
|
||||
1 => 'MacJapanese', 18 => 'MacSinhalese',
|
||||
2 => 'MacChineseTW', 19 => 'MacBurmese',
|
||||
3 => 'MacKorean', 20 => 'MacKhmer',
|
||||
4 => 'MacArabic', 21 => 'MacThai',
|
||||
5 => 'MacHebrew', 22 => 'MacLaotian',
|
||||
6 => 'MacGreek', 23 => 'MacGeorgian',
|
||||
7 => 'MacCyrillic', 24 => 'MacArmenian', # 7=Russian
|
||||
8 => 'MacRSymbol', 25 => 'MacChineseCN',
|
||||
9 => 'MacDevanagari', 26 => 'MacTibetan',
|
||||
10 => 'MacGurmukhi', 27 => 'MacMongolian',
|
||||
11 => 'MacGujarati', 28 => 'MacGeez',
|
||||
12 => 'MacOriya', 29 => 'MacCyrillic', # 29=Slavic
|
||||
13 => 'MacBengali', 30 => 'MacVietnam',
|
||||
14 => 'MacTamil', 31 => 'MacSindhi',
|
||||
15 => 'MacTelugu', 32 => '', # 32=uninterpreted
|
||||
16 => 'MacKannada',
|
||||
},
|
||||
Windows => {
|
||||
0 => 'Symbol', 4 => 'Big5',
|
||||
1 => 'UCS2', 5 => 'Wansung',
|
||||
2 => 'ShiftJIS', 6 => 'Johab',
|
||||
3 => 'PRC', 10 => 'UCS4',
|
||||
},
|
||||
Unicode => {
|
||||
# (we don't currently handle the various Unicode flavours)
|
||||
0 => 'UCS2', # Unicode 1.0 semantics
|
||||
1 => 'UCS2', # Unicode 1.1 semantics
|
||||
2 => 'UCS2', # ISO 10646 semantics
|
||||
3 => 'UCS2', # Unicode 2.0 and onwards semantics, Unicode BMP only.
|
||||
4 => 'UCS2', # Unicode 2.0 and onwards semantics, Unicode full repertoire.
|
||||
# 5 => Unicode Variation Sequences (not used in Naming table)
|
||||
},
|
||||
ISO => { # (deprecated)
|
||||
0 => 'UTF8', # (7-bit ASCII)
|
||||
1 => 'UCS2', # ISO 10646
|
||||
2 => 'Latin', # ISO 8859-1
|
||||
},
|
||||
Custom => { },
|
||||
);
|
||||
|
||||
# convert TrueType 'name' language code to ExifTool language code
|
||||
%ttLang = (
|
||||
# Macintosh language codes (also used by QuickTime.pm)
|
||||
# oddities:
|
||||
# 49 - Cyrllic version 83 - Roman
|
||||
# 50 - Arabic version 84 - Arabic
|
||||
# 146 - with dot above
|
||||
Macintosh => {
|
||||
0 => 'en', 24 => 'lt', 48 => 'kk', 72 => 'ml', 129 => 'eu',
|
||||
1 => 'fr', 25 => 'pl', 49 => 'az', 73 => 'kn', 130 => 'ca',
|
||||
2 => 'de', 26 => 'hu', 50 => 'az', 74 => 'ta', 131 => 'la',
|
||||
3 => 'it', 27 => 'et', 51 => 'hy', 75 => 'te', 132 => 'qu',
|
||||
4 => 'nl', 28 => 'lv', 52 => 'ka', 76 => 'si', 133 => 'gn',
|
||||
5 => 'sv', 29 => 'smi', 53 => 'ro', 77 => 'my', 134 => 'ay',
|
||||
6 => 'es', 30 => 'fo', 54 => 'ky', 78 => 'km', 135 => 'tt',
|
||||
7 => 'da', 31 => 'fa', 55 => 'tg', 79 => 'lo', 136 => 'ug',
|
||||
8 => 'pt', 32 => 'ru', 56 => 'tk', 80 => 'vi', 137 => 'dz',
|
||||
9 => 'no', 33 => 'zh-CN', 57 => 'mn-MN', 81 => 'id', 138 => 'jv',
|
||||
10 => 'he', 34 => 'nl', 58 => 'mn-CN', 82 => 'tl', 139 => 'su',
|
||||
11 => 'ja', 35 => 'ga', 59 => 'ps', 83 => 'ms-MY', 140 => 'gl',
|
||||
12 => 'ar', 36 => 'sq', 60 => 'ku', 84 => 'ms-BN', 141 => 'af',
|
||||
13 => 'fi', 37 => 'ro', 61 => 'ks', 85 => 'am', 142 => 'br',
|
||||
14 => 'iu', 38 => 'cs', 62 => 'sd', 86 => 'ti', 144 => 'gd',
|
||||
15 => 'is', 39 => 'sk', 63 => 'bo', 87 => 'om', 145 => 'vg',
|
||||
16 => 'mt', 40 => 'sl', 64 => 'ne', 88 => 'so', 146 => 'ga',
|
||||
17 => 'tr', 41 => 'yi', 65 => 'sa', 89 => 'sw', 147 => 'rar',
|
||||
18 => 'hr', 42 => 'sr', 66 => 'mr', 90 => 'rw', 148 => 'el',
|
||||
19 => 'zh-TW', 43 => 'mk', 67 => 'bn', 91 => 'rn', 149 => 'kl',
|
||||
20 => 'ur', 44 => 'bg', 68 => 'as', 92 => 'ny', 150 => 'az',
|
||||
21 => 'hi', 45 => 'uk', 69 => 'gu', 93 => 'mg',
|
||||
22 => 'th', 46 => 'be', 70 => 'pa', 94 => 'eo',
|
||||
23 => 'ko', 47 => 'uz', 71 => 'or', 128 => 'cy',
|
||||
},
|
||||
# Windows language codes (http://msdn.microsoft.com/en-us/library/0h88fahh(VS.85).aspx)
|
||||
# Notes: This isn't an exact science. The reference above gives language codes
|
||||
# which are different from some ISO 639-1 numbers. Also, some Windows language
|
||||
# codes don't appear to have ISO 639-1 equivalents.
|
||||
# 0x0428 - fa by ref above
|
||||
# 0x048c - no ISO equivalent
|
||||
# 0x081a/0x83c - sr-SP
|
||||
# 0x0c0a - modern?
|
||||
# 0x2409 - Carribean country code not found in ISO 3166-1
|
||||
Windows => {
|
||||
0x0401 => 'ar-SA', 0x0438 => 'fo', 0x0481 => 'mi', 0x1409 => 'en-NZ',
|
||||
0x0402 => 'bg', 0x0439 => 'hi', 0x0482 => 'oc', 0x140a => 'es-CR',
|
||||
0x0403 => 'ca', 0x043a => 'mt', 0x0483 => 'co', 0x140c => 'fr-LU',
|
||||
0x0404 => 'zh-TW', 0x043b => 'se-NO', 0x0484 => 'gsw', 0x141a => 'bs-BA',
|
||||
0x0405 => 'cs', 0x043c => 'gd', 0x0485 => 'sah', 0x143b => 'smj-SE',
|
||||
0x0406 => 'da', 0x043d => 'yi', 0x0486 => 'ny', 0x1801 => 'ar-MA',
|
||||
0x0407 => 'de-DE', 0x043e => 'ms-MY', 0x0487 => 'rw', 0x1809 => 'en-IE',
|
||||
0x0408 => 'el', 0x043f => 'kk', 0x048c => 'Dari', 0x180a => 'es-PA',
|
||||
0x0409 => 'en-US', 0x0440 => 'ky', 0x0801 => 'ar-IQ', 0x180c => 'fr-MC',
|
||||
0x040a => 'es-ES', 0x0441 => 'sw', 0x0804 => 'zh-CN', 0x181a => 'sr-BA',
|
||||
0x040b => 'fi', 0x0442 => 'tk', 0x0807 => 'de-CH', 0x183b => 'sma-NO',
|
||||
0x040c => 'fr-FR', 0x0443 => 'uz-UZ', 0x0809 => 'en-GB', 0x1c01 => 'ar-TN',
|
||||
0x040d => 'he', 0x0444 => 'tt', 0x080a => 'es-MX', 0x1c09 => 'en-ZA',
|
||||
0x040e => 'hu', 0x0445 => 'bn-IN', 0x080c => 'fr-BE', 0x1c0a => 'es-DO',
|
||||
0x040f => 'is', 0x0446 => 'pa', 0x0810 => 'it-CH', 0x1c1a => 'sr-BA',
|
||||
0x0410 => 'it-IT', 0x0447 => 'gu', 0x0813 => 'nl-BE', 0x1c3b => 'sma-SE',
|
||||
0x0411 => 'ja', 0x0448 => 'wo', 0x0814 => 'nn', 0x2001 => 'ar-OM',
|
||||
0x0412 => 'ko', 0x0449 => 'ta', 0x0816 => 'pt-PT', 0x2009 => 'en-JM',
|
||||
0x0413 => 'nl-NL', 0x044a => 'te', 0x0818 => 'ro-MO', 0x200a => 'es-VE',
|
||||
0x0414 => 'no-NO', 0x044b => 'kn', 0x0819 => 'ru-MO', 0x201a => 'bs-BA',
|
||||
0x0415 => 'pl', 0x044c => 'ml', 0x081a => 'sr-RS', 0x203b => 'sms',
|
||||
0x0416 => 'pt-BR', 0x044d => 'as', 0x081d => 'sv-FI', 0x2401 => 'ar-YE',
|
||||
0x0417 => 'rm', 0x044e => 'mr', 0x082c => 'az-AZ', 0x2409 => 'en-CB',
|
||||
0x0418 => 'ro', 0x044f => 'sa', 0x082e => 'dsb', 0x240a => 'es-CO',
|
||||
0x0419 => 'ru', 0x0450 => 'mn-MN', 0x083b => 'se-SE', 0x243b => 'smn',
|
||||
0x041a => 'hr', 0x0451 => 'bo', 0x083c => 'ga', 0x2801 => 'ar-SY',
|
||||
0x041b => 'sk', 0x0452 => 'cy', 0x083e => 'ms-BN', 0x2809 => 'en-BZ',
|
||||
0x041c => 'sq', 0x0453 => 'km', 0x0843 => 'uz-UZ', 0x280a => 'es-PE',
|
||||
0x041d => 'sv-SE', 0x0454 => 'lo', 0x0845 => 'bn-BD', 0x2c01 => 'ar-JO',
|
||||
0x041e => 'th', 0x0456 => 'gl', 0x0850 => 'mn-CN', 0x2c09 => 'en-TT',
|
||||
0x041f => 'tr', 0x0457 => 'kok', 0x085d => 'iu-CA', 0x2c0a => 'es-AR',
|
||||
0x0420 => 'ur', 0x045a => 'syr', 0x085f => 'tmh', 0x3001 => 'ar-LB',
|
||||
0x0421 => 'id', 0x045b => 'si', 0x086b => 'qu-EC', 0x3009 => 'en-ZW',
|
||||
0x0422 => 'uk', 0x045d => 'iu-CA', 0x0c01 => 'ar-EG', 0x300a => 'es-EC',
|
||||
0x0423 => 'be', 0x045e => 'am', 0x0c04 => 'zh-HK', 0x3401 => 'ar-KW',
|
||||
0x0424 => 'sl', 0x0461 => 'ne', 0x0c07 => 'de-AT', 0x3409 => 'en-PH',
|
||||
0x0425 => 'et', 0x0462 => 'fy', 0x0c09 => 'en-AU', 0x340a => 'es-CL',
|
||||
0x0426 => 'lv', 0x0463 => 'ps', 0x0c0a => 'es-ES', 0x3801 => 'ar-AE',
|
||||
0x0427 => 'lt', 0x0464 => 'fil', 0x0c0c => 'fr-CA', 0x380a => 'es-UY',
|
||||
0x0428 => 'tg', 0x0465 => 'dv', 0x0c1a => 'sr-RS', 0x3c01 => 'ar-BH',
|
||||
0x042a => 'vi', 0x0468 => 'ha', 0x0c3b => 'se-FI', 0x3c0a => 'es-PY',
|
||||
0x042b => 'hy', 0x046a => 'yo', 0x0c6b => 'qu-PE', 0x4001 => 'ar-QA',
|
||||
0x042c => 'az-AZ', 0x046b => 'qu-BO', 0x1001 => 'ar-LY', 0x4009 => 'en-IN',
|
||||
0x042d => 'eu', 0x046c => 'st', 0x1004 => 'zh-SG', 0x400a => 'es-BO',
|
||||
0x042e => 'hsb', 0x046d => 'ba', 0x1007 => 'de-LU', 0x4409 => 'en-MY',
|
||||
0x042f => 'mk', 0x046e => 'lb', 0x1009 => 'en-CA', 0x440a => 'es-SV',
|
||||
0x0430 => 'st', 0x046f => 'kl', 0x100a => 'es-GT', 0x4809 => 'en-SG',
|
||||
0x0431 => 'ts', 0x0470 => 'ig', 0x100c => 'fr-CH', 0x480a => 'es-HN',
|
||||
0x0432 => 'tn', 0x0478 => 'yi', 0x101a => 'hr-BA', 0x4c0a => 'es-NI',
|
||||
0x0434 => 'xh', 0x047a => 'arn', 0x103b => 'smj-NO',0x500a => 'es-PR',
|
||||
0x0435 => 'zu', 0x047c => 'moh', 0x1401 => 'ar-DZ', 0x540a => 'es-US',
|
||||
0x0436 => 'af', 0x047e => 'br', 0x1404 => 'zh-MO',
|
||||
0x0437 => 'ka', 0x0480 => 'ug', 0x1407 => 'de-LI',
|
||||
},
|
||||
Unicode => { },
|
||||
ISO => { },
|
||||
Custom => { },
|
||||
);
|
||||
|
||||
# eclectic table of tags for various format font files
|
||||
%Image::ExifTool::Font::Main = (
|
||||
GROUPS => { 2 => 'Document' },
|
||||
NOTES => q{
|
||||
This table contains a collection of tags found in font files of various
|
||||
formats. ExifTool current recognizes OTF, TTF, TTC, DFONT, PFA, PFB, PFM,
|
||||
AFM, ACFM and AMFM font files.
|
||||
},
|
||||
name => {
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Font::Name' },
|
||||
},
|
||||
PFM => {
|
||||
Name => 'PFMHeader',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Font::PFM' },
|
||||
},
|
||||
PSInfo => {
|
||||
Name => 'PSFontInfo',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Font::PSInfo' },
|
||||
},
|
||||
AFM => {
|
||||
Name => 'AFM',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Font::AFM' },
|
||||
},
|
||||
numfonts => 'NumFonts',
|
||||
fontname => 'FontName',
|
||||
postfont => {
|
||||
Name => 'PostScriptFontName',
|
||||
Description => 'PostScript Font Name',
|
||||
},
|
||||
);
|
||||
|
||||
# TrueType name tags (ref 1/2)
|
||||
%Image::ExifTool::Font::Name = (
|
||||
GROUPS => { 2 => 'Document' },
|
||||
NOTES => q{
|
||||
The following tags are extracted from the TrueType font "name" table found
|
||||
in OTF, TTF, TTC and DFONT files. These tags support localized languages by
|
||||
adding a hyphen followed by a language code to the end of the tag name (eg.
|
||||
"Copyright-fr" or "License-en-US"). Tags with no language code use the
|
||||
default language of "en".
|
||||
},
|
||||
0 => { Name => 'Copyright', Groups => { 2 => 'Author' } },
|
||||
1 => 'FontFamily',
|
||||
2 => 'FontSubfamily',
|
||||
3 => 'FontSubfamilyID',
|
||||
4 => 'FontName', # full name
|
||||
5 => 'NameTableVersion',
|
||||
6 => { Name => 'PostScriptFontName', Description => 'PostScript Font Name' },
|
||||
7 => 'Trademark',
|
||||
8 => 'Manufacturer',
|
||||
9 => 'Designer',
|
||||
10 => 'Description',
|
||||
11 => 'VendorURL',
|
||||
12 => 'DesignerURL',
|
||||
13 => 'License',
|
||||
14 => 'LicenseInfoURL',
|
||||
16 => 'PreferredFamily',
|
||||
17 => 'PreferredSubfamily',
|
||||
18 => 'CompatibleFontName',
|
||||
19 => 'SampleText',
|
||||
20 => {
|
||||
Name => 'PostScriptFontName',
|
||||
Description => 'PostScript Font Name',
|
||||
},
|
||||
21 => 'WWSFamilyName',
|
||||
22 => 'WWSSubfamilyName',
|
||||
);
|
||||
|
||||
# PostScript Font Metric file header (ref 4)
|
||||
%Image::ExifTool::Font::PFM = (
|
||||
GROUPS => { 2 => 'Document' },
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
NOTES => 'Tags extracted from the PFM file header.',
|
||||
0 => {
|
||||
Name => 'PFMVersion',
|
||||
Format => 'int16u',
|
||||
PrintConv => 'sprintf("%x.%.2x",$val>>8,$val&0xff)',
|
||||
},
|
||||
6 => { Name => 'Copyright', Format => 'string[60]', Groups => { 2 => 'Author' } },
|
||||
66 => { Name => 'FontType', Format => 'int16u' },
|
||||
68 => { Name => 'PointSize', Format => 'int16u' },
|
||||
70 => { Name => 'YResolution', Format => 'int16u' },
|
||||
72 => { Name => 'XResolution', Format => 'int16u' },
|
||||
74 => { Name => 'Ascent', Format => 'int16u' },
|
||||
76 => { Name => 'InternalLeading', Format => 'int16u' },
|
||||
78 => { Name => 'ExternalLeading', Format => 'int16u' },
|
||||
80 => { Name => 'Italic' },
|
||||
81 => { Name => 'Underline' },
|
||||
82 => { Name => 'Strikeout' },
|
||||
83 => { Name => 'Weight', Format => 'int16u' },
|
||||
85 => { Name => 'CharacterSet' },
|
||||
86 => { Name => 'PixWidth', Format => 'int16u' },
|
||||
88 => { Name => 'PixHeight', Format => 'int16u' },
|
||||
90 => { Name => 'PitchAndFamily' },
|
||||
91 => { Name => 'AvgWidth', Format => 'int16u' },
|
||||
93 => { Name => 'MaxWidth', Format => 'int16u' },
|
||||
95 => { Name => 'FirstChar' },
|
||||
96 => { Name => 'LastChar' },
|
||||
97 => { Name => 'DefaultChar' },
|
||||
98 => { Name => 'BreakChar' },
|
||||
99 => { Name => 'WidthBytes', Format => 'int16u' },
|
||||
# 101 => { Name => 'DeviceTypeOffset', Format => 'int32u' },
|
||||
# 105 => { Name => 'FontNameOffset', Format => 'int32u' },
|
||||
# 109 => { Name => 'BitsPointer', Format => 'int32u' },
|
||||
# 113 => { Name => 'BitsOffset', Format => 'int32u' },
|
||||
);
|
||||
|
||||
# PostScript FontInfo attributes (PFA, PFB) (ref PH)
|
||||
%Image::ExifTool::Font::PSInfo = (
|
||||
GROUPS => { 2 => 'Document' },
|
||||
NOTES => 'Tags extracted from PostScript font files (PFA and PFB).',
|
||||
FullName => { },
|
||||
FamilyName => { Name => 'FontFamily' },
|
||||
Weight => { },
|
||||
ItalicAngle => { },
|
||||
isFixedPitch=> { },
|
||||
UnderlinePosition => { },
|
||||
UnderlineThickness => { },
|
||||
Copyright => { Groups => { 2 => 'Author' } },
|
||||
Notice => { Groups => { 2 => 'Author' } },
|
||||
version => { },
|
||||
FontName => { },
|
||||
FontType => { },
|
||||
FSType => { },
|
||||
);
|
||||
|
||||
# Adobe Font Metrics tags (AFM) (ref 6)
|
||||
%Image::ExifTool::Font::AFM = (
|
||||
GROUPS => { 2 => 'Document' },
|
||||
NOTES => 'Tags extracted from Adobe Font Metrics files (AFM, ACFM and AMFM).',
|
||||
'Creation Date' => { Name => 'CreateDate', Groups => { 2 => 'Time' } },
|
||||
FontName => { },
|
||||
FullName => { },
|
||||
FamilyName => { Name => 'FontFamily' },
|
||||
Weight => { },
|
||||
Version => { },
|
||||
Notice => { Groups => { 2 => 'Author' } },
|
||||
EncodingScheme => { },
|
||||
MappingScheme => { },
|
||||
EscChar => { },
|
||||
CharacterSet=> { },
|
||||
Characters => { },
|
||||
IsBaseFont => { },
|
||||
# VVector => { },
|
||||
IsFixedV => { },
|
||||
CapHeight => { },
|
||||
XHeight => { },
|
||||
Ascender => { },
|
||||
Descender => { },
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read information from a TrueType font collection (TTC) (refs 2,3)
|
||||
# Inputs: 0) ExifTool ref, 1) dirInfo ref
|
||||
# Returns: 1 on success, 0 if this wasn't a valid TrueType font collection
|
||||
sub ProcessTTC($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my ($buff, $i);
|
||||
|
||||
return 0 unless $raf->Read($buff, 12) == 12;
|
||||
return 0 unless $buff =~ /^ttcf\0[\x01\x02]\0\0/;
|
||||
SetByteOrder('MM');
|
||||
my $num = Get32u(\$buff, 8);
|
||||
# might as well put a limit on the number of fonts we will parse (< 256)
|
||||
return 0 unless $num < 0x100 and $raf->Read($buff, $num * 4) == $num * 4;
|
||||
$et->SetFileType('TTC');
|
||||
return 1 if $$et{OPTIONS}{FastScan} and $$et{OPTIONS}{FastScan} == 3;
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::Font::Main');
|
||||
$et->HandleTag($tagTablePtr, 'numfonts', $num);
|
||||
# loop through all fonts in the collection
|
||||
for ($i=0; $i<$num; ++$i) {
|
||||
my $n = $i + 1;
|
||||
$et->VPrint(0, "Font $n:\n");
|
||||
$$et{SET_GROUP1} = "+$n";
|
||||
my $offset = Get32u(\$buff, $i * 4);
|
||||
$raf->Seek($offset, 0) or last;
|
||||
ProcessOTF($et, $dirInfo) or last;
|
||||
}
|
||||
delete $$et{SET_GROUP1};
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read information from a TrueType font file (OTF or TTF) (refs 1,2)
|
||||
# Inputs: 0) ExifTool ref, 1) dirInfo ref
|
||||
# Returns: 1 on success, 0 if this wasn't a valid TrueType font file
|
||||
sub ProcessOTF($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my ($tbl, $buff, $pos, $i);
|
||||
my $base = $$dirInfo{Base} || 0;
|
||||
|
||||
return 0 unless $raf->Read($buff, 12) == 12;
|
||||
return 0 unless $buff =~ /^(\0\x01\0\0|OTTO|true|typ1|\xa5(kbd|lst))[\0\x01]/;
|
||||
|
||||
$et->SetFileType($1 eq 'OTTO' ? 'OTF' : 'TTF');
|
||||
return 1 if $$et{OPTIONS}{FastScan} and $$et{OPTIONS}{FastScan} == 3;
|
||||
SetByteOrder('MM');
|
||||
my $numTables = Get16u(\$buff, 4);
|
||||
return 0 unless $numTables > 0 and $numTables < 0x200;
|
||||
my $len = $numTables * 16;
|
||||
return 0 unless $raf->Read($tbl, $len) == $len;
|
||||
|
||||
my $verbose = $et->Options('Verbose');
|
||||
my $oldIndent = $$et{INDENT};
|
||||
$$et{INDENT} .= '| ';
|
||||
$et->VerboseDir('TrueType', $numTables) if $verbose;
|
||||
|
||||
for ($pos=0; $pos<$len; $pos+=16) {
|
||||
# look for 'name' table
|
||||
my $tag = substr($tbl, $pos, 4);
|
||||
next unless $tag eq 'name' or $verbose;
|
||||
my $offset = Get32u(\$tbl, $pos + 8);
|
||||
my $size = Get32u(\$tbl, $pos + 12);
|
||||
unless ($raf->Seek($offset+$base, 0) and $raf->Read($buff, $size) == $size) {
|
||||
$et->Warn("Error reading '${tag}' data");
|
||||
next;
|
||||
}
|
||||
if ($verbose) {
|
||||
$tag =~ s/([\0-\x1f\x80-\xff])/sprintf('\x%.2x',ord $1)/ge;
|
||||
my $str = sprintf("%s%d) Tag '%s' (offset 0x%.4x, %d bytes)\n",
|
||||
$$et{INDENT}, $pos/16, $tag, $offset, $size);
|
||||
$et->VPrint(0, $str);
|
||||
$et->VerboseDump(\$buff, Addr => $offset) if $verbose > 2;
|
||||
next unless $tag eq 'name';
|
||||
}
|
||||
next unless $size >= 8;
|
||||
my $entries = Get16u(\$buff, 2);
|
||||
my $recEnd = 6 + $entries * 12;
|
||||
if ($recEnd > $size) {
|
||||
$et->Warn('Truncated name record');
|
||||
last;
|
||||
}
|
||||
my $strStart = Get16u(\$buff, 4);
|
||||
if ($strStart < $recEnd or $strStart > $size) {
|
||||
$et->Warn('Invalid string offset');
|
||||
last;
|
||||
}
|
||||
# parse language-tag record (in format 1 Naming table only) (ref 2)
|
||||
my %langTag;
|
||||
if (Get16u(\$buff, 0) == 1 and $recEnd + 2 <= $size) {
|
||||
my $langTags = Get16u(\$buff, $recEnd);
|
||||
if ($langTags and $recEnd + 2 + $langTags * 4 < $size) {
|
||||
for ($i=0; $i<$langTags; ++$i) {
|
||||
my $pt = $recEnd + 2 + $i * 4;
|
||||
my $langLen = Get16u(\$buff, $pt);
|
||||
# make sure the language string length is reasonable (UTF-16BE)
|
||||
last if $langLen == 0 or $langLen & 0x01 or $langLen > 40;
|
||||
my $langPt = Get16u(\$buff, $pt + 2) + $strStart;
|
||||
last if $langPt + $langLen > $size;
|
||||
my $lang = substr($buff, $langPt, $langLen);
|
||||
$lang = $et->Decode($lang,'UCS2','MM','UTF8');
|
||||
$lang =~ tr/-_a-zA-Z0-9//dc; # remove naughty characters
|
||||
$langTag{$i + 0x8000} = $lang;
|
||||
}
|
||||
}
|
||||
}
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::Font::Name');
|
||||
$$et{INDENT} .= '| ';
|
||||
$et->VerboseDir('Name', $entries) if $verbose;
|
||||
for ($i=0; $i<$entries; ++$i) {
|
||||
my $pt = 6 + $i * 12;
|
||||
my $platform = Get16u(\$buff, $pt);
|
||||
my $encoding = Get16u(\$buff, $pt + 2);
|
||||
my $langID = Get16u(\$buff, $pt + 4);
|
||||
my $nameID = Get16u(\$buff, $pt + 6);
|
||||
my $strLen = Get16u(\$buff, $pt + 8);
|
||||
my $strPt = Get16u(\$buff, $pt + 10) + $strStart;
|
||||
if ($strPt + $strLen <= $size) {
|
||||
my $val = substr($buff, $strPt, $strLen);
|
||||
my ($lang, $charset, $extra);
|
||||
my $sys = $ttPlatform{$platform};
|
||||
# translate from specified encoding
|
||||
if ($sys) {
|
||||
$lang = $ttLang{$sys}{$langID} || $langTag{$langID};
|
||||
$charset = $ttCharset{$sys}{$encoding};
|
||||
if (not $charset) {
|
||||
if (not defined $charset and not $$et{FontWarn}) {
|
||||
$et->Warn("Unknown $sys character set ($encoding)");
|
||||
$$et{FontWarn} = 1;
|
||||
}
|
||||
} else {
|
||||
# translate to ExifTool character set
|
||||
$val = $et->Decode($val, $charset);
|
||||
}
|
||||
} else {
|
||||
$et->Warn("Unknown platform ($platform) for name $nameID");
|
||||
}
|
||||
# get the tagInfo for our specific language (use 'en' for default)
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, $nameID);
|
||||
if ($tagInfo and $lang and $lang ne 'en') {
|
||||
my $langInfo = Image::ExifTool::GetLangInfo($tagInfo, $lang);
|
||||
$tagInfo = $langInfo if $langInfo;
|
||||
}
|
||||
if ($verbose) {
|
||||
$langID > 0x400 and $langID = sprintf('0x%x', $langID);
|
||||
$extra = ", Plat=$platform/" . ($sys || 'Unknown') . ', ' .
|
||||
"Enc=$encoding/" . ($charset || 'Unknown') . ', ' .
|
||||
"Lang=$langID/" . ($lang || 'Unknown');
|
||||
}
|
||||
$et->HandleTag($tagTablePtr, $nameID, $val,
|
||||
TagInfo => $tagInfo,
|
||||
DataPt => \$buff,
|
||||
DataPos => $offset,
|
||||
Start => $strPt,
|
||||
Size => $strLen,
|
||||
Index => $i,
|
||||
Extra => $extra,
|
||||
);
|
||||
}
|
||||
}
|
||||
$$et{INDENT} = $oldIndent . '| ';
|
||||
last unless $verbose;
|
||||
}
|
||||
$$et{INDENT} = $oldIndent;
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read information from an Adobe Font Metrics file (AFM, ACFM, AMFM) (ref 6)
|
||||
# Inputs: 0) ExifTool ref, 1) dirInfo ref
|
||||
# Returns: 1 on success, 0 if this wasn't a recognized AFM-type file
|
||||
sub ProcessAFM($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my ($buff, $comment);
|
||||
|
||||
require Image::ExifTool::PostScript;
|
||||
local $/ = Image::ExifTool::PostScript::GetInputRecordSeparator($raf);
|
||||
$raf->ReadLine($buff);
|
||||
return 0 unless $buff =~ /^Start(Comp|Master)?FontMetrics\s+\d+/;
|
||||
my $ftyp = $1 ? ($1 eq 'Comp' ? 'ACFM' : 'AMFM') : 'AFM';
|
||||
$et->SetFileType($ftyp, 'application/x-font-afm');
|
||||
return 1 if $$et{OPTIONS}{FastScan} and $$et{OPTIONS}{FastScan} == 3;
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::Font::AFM');
|
||||
|
||||
for (;;) {
|
||||
$raf->ReadLine($buff) or last;
|
||||
if (defined $comment and $buff !~ /^Comment\s/) {
|
||||
$et->FoundTag('Comment', $comment);
|
||||
undef $comment;
|
||||
}
|
||||
$buff =~ /^(\w+)\s+(.*?)[\x0d\x0a]/ or next;
|
||||
my ($tag, $val) = ($1, $2);
|
||||
if ($tag eq 'Comment' and $val =~ /^(Creation Date):\s+(.*)/) {
|
||||
($tag, $val) = ($1, $2);
|
||||
}
|
||||
$val =~ s/^\((.*)\)$/$1/; # (some values may be in brackets)
|
||||
if ($tag eq 'Comment') {
|
||||
# concatinate all comments into a single value
|
||||
$comment = defined($comment) ? "$comment\n$val" : $val;
|
||||
next;
|
||||
}
|
||||
unless ($et->HandleTag($tagTablePtr, $tag, $val)) {
|
||||
# end parsing if we start any subsection
|
||||
last if $tag =~ /^Start/ and $tag ne 'StartDirection';
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read information from various format font files
|
||||
# Inputs: 0) ExifTool ref, 1) dirInfo ref
|
||||
# Returns: 1 on success, 0 if this wasn't a recognized Font file
|
||||
sub ProcessFont($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my ($buff, $buf2, $rtnVal);
|
||||
return 0 unless $raf->Read($buff, 24) and $raf->Seek(0,0);
|
||||
if ($buff =~ /^(\0\x01\0\0|OTTO|true|typ1)[\0\x01]/) { # OTF, TTF
|
||||
$rtnVal = ProcessOTF($et, $dirInfo);
|
||||
} elsif ($buff =~ /^ttcf\0[\x01\x02]\0\0/) { # TTC
|
||||
$rtnVal = ProcessTTC($et, $dirInfo);
|
||||
} elsif ($buff =~ /^Start(Comp|Master)?FontMetrics\s+\d+/s) { # AFM
|
||||
$rtnVal = ProcessAFM($et, $dirInfo);
|
||||
} elsif ($buff =~ /^(.{6})?%!(PS-(AdobeFont-|Bitstream )|FontType1-)/s) {# PFA, PFB
|
||||
$raf->Seek(6,0) and $et->SetFileType('PFB') if $1;
|
||||
require Image::ExifTool::PostScript;
|
||||
$rtnVal = Image::ExifTool::PostScript::ProcessPS($et, $dirInfo);
|
||||
} elsif ($buff =~ /^\0[\x01\x02]/ and $raf->Seek(0, 2) and # PFM
|
||||
# validate file size
|
||||
$raf->Tell() > 117 and $raf->Tell() == unpack('x2V',$buff) and
|
||||
# read PFM header
|
||||
$raf->Seek(0,0) and $raf->Read($buff,117) == 117 and
|
||||
# validate "DeviceType" string (must be "PostScript\0")
|
||||
SetByteOrder('II') and $raf->Seek(Get32u(\$buff, 101), 0) and
|
||||
# the DeviceType should be "PostScript\0", but FontForge
|
||||
# incorrectly writes "Postscript\0", so ignore case
|
||||
$raf->Read($buf2, 11) == 11 and lc($buf2) eq "postscript\0")
|
||||
{
|
||||
$et->SetFileType('PFM');
|
||||
return 1 if $$et{OPTIONS}{FastScan} and $$et{OPTIONS}{FastScan} == 3;
|
||||
SetByteOrder('II');
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::Font::Main');
|
||||
# process the PFM header
|
||||
$et->HandleTag($tagTablePtr, 'PFM', $buff);
|
||||
# extract the font names
|
||||
my $nameOff = Get32u(\$buff, 105);
|
||||
if ($raf->Seek($nameOff, 0) and $raf->Read($buff, 256) and
|
||||
$buff =~ /^([\x20-\xff]+)\0([\x20-\xff]+)\0/)
|
||||
{
|
||||
$et->HandleTag($tagTablePtr, 'fontname', $1);
|
||||
$et->HandleTag($tagTablePtr, 'postfont', $2);
|
||||
}
|
||||
$rtnVal = 1;
|
||||
} else {
|
||||
$rtnVal = 0;
|
||||
}
|
||||
return $rtnVal;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::Font - Read meta information from font files
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains the routines required by Image::ExifTool to read meta
|
||||
information from various format font files. Currently recognized font file
|
||||
types are OTF, TTF, TTC, DFONT, PFA, PFB, PFM, AFM, ACFM and AMFM.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://developer.apple.com/textfonts/TTRefMan/RM06/Chap6.html>
|
||||
|
||||
=item L<http://www.microsoft.com/typography/otspec/otff.htm>
|
||||
|
||||
=item L<http://partners.adobe.com/public/developer/opentype/index_font_file.html>
|
||||
|
||||
=item L<http://partners.adobe.com/public/developer/en/font/5178.PFM.pdf>
|
||||
|
||||
=item L<http://opensource.adobe.com/svn/opensource/flex/sdk/trunk/modules/compiler/src/java/flex2/compiler/util/MimeMappings.java>
|
||||
|
||||
=item L<http://www.adobe.com/devnet/font/pdfs/5004.AFM_Spec.pdf>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/Font Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,261 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: FotoStation.pm
|
||||
#
|
||||
# Description: Read/write FotoWare FotoStation trailer
|
||||
#
|
||||
# Revisions: 10/28/2006 - P. Harvey Created
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::FotoStation;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.04';
|
||||
|
||||
sub ProcessFotoStation($$);
|
||||
|
||||
%Image::ExifTool::FotoStation::Main = (
|
||||
PROCESS_PROC => \&ProcessFotoStation,
|
||||
WRITE_PROC => \&ProcessFotoStation,
|
||||
GROUPS => { 2 => 'Image' },
|
||||
NOTES => q{
|
||||
The following tables define information found in the FotoWare FotoStation
|
||||
trailer.
|
||||
},
|
||||
0x01 => {
|
||||
Name => 'IPTC',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::IPTC::Main',
|
||||
},
|
||||
},
|
||||
0x02 => {
|
||||
Name => 'SoftEdit',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::FotoStation::SoftEdit',
|
||||
},
|
||||
},
|
||||
0x03 => {
|
||||
Name => 'ThumbnailImage',
|
||||
Groups => { 2 => 'Preview' },
|
||||
Writable => 1,
|
||||
RawConv => '$self->ValidateImage(\$val,$tag)',
|
||||
},
|
||||
0x04 => {
|
||||
Name => 'PreviewImage',
|
||||
Groups => { 2 => 'Preview' },
|
||||
Writable => 1,
|
||||
RawConv => '$self->ValidateImage(\$val,$tag)',
|
||||
},
|
||||
);
|
||||
|
||||
# crop coordinate conversions
|
||||
my %cropConv = (
|
||||
ValueConv => '$val / 1000',
|
||||
ValueConvInv => '$val * 1000',
|
||||
PrintConv => '"$val%"',
|
||||
PrintConvInv => '$val=~tr/ %//d; $val',
|
||||
);
|
||||
|
||||
# soft crop record
|
||||
%Image::ExifTool::FotoStation::SoftEdit = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
|
||||
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
|
||||
WRITABLE => 1,
|
||||
FORMAT => 'int32s',
|
||||
FIRST_ENTRY => 0,
|
||||
GROUPS => { 2 => 'Image' },
|
||||
0 => {
|
||||
Name => 'OriginalImageWidth',
|
||||
},
|
||||
1 => 'OriginalImageHeight',
|
||||
2 => 'ColorPlanes',
|
||||
3 => {
|
||||
Name => 'XYResolution',
|
||||
ValueConv => '$val / 1000',
|
||||
ValueConvInv => '$val * 1000',
|
||||
},
|
||||
4 => {
|
||||
Name => 'Rotation',
|
||||
Notes => q{
|
||||
rotations are stored as degrees CCW * 100, but converted to degrees CW by
|
||||
ExifTool
|
||||
},
|
||||
# raw value is 0, 9000, 18000 or 27000
|
||||
ValueConv => '$val ? 360 - $val / 100 : 0',
|
||||
ValueConvInv => '$val ? (360 - $val) * 100 : 0',
|
||||
},
|
||||
# 5 Validity Check (0x11222211)
|
||||
6 => {
|
||||
Name => 'CropLeft',
|
||||
%cropConv,
|
||||
},
|
||||
7 => {
|
||||
Name => 'CropTop',
|
||||
%cropConv,
|
||||
},
|
||||
8 => {
|
||||
Name => 'CropRight',
|
||||
%cropConv,
|
||||
},
|
||||
9 => {
|
||||
Name => 'CropBottom',
|
||||
%cropConv,
|
||||
},
|
||||
11 => {
|
||||
Name => 'CropRotation',
|
||||
# raw value in the range -4500 to 4500
|
||||
ValueConv => '-$val / 100',
|
||||
ValueConvInv => '-$val * 100',
|
||||
},
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read/write FotoStation information in a file
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
||||
# Returns: 1 on success, 0 if this file didn't contain FotoStation information
|
||||
# - updates DataPos to point to start of FotoStation information
|
||||
# - updates DirLen to trailer length
|
||||
sub ProcessFotoStation($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
$et or return 1; # allow dummy access to autoload this package
|
||||
my ($buff, $footer, $dirBuff, $tagTablePtr);
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $outfile = $$dirInfo{OutFile};
|
||||
my $offset = $$dirInfo{Offset} || 0;
|
||||
my $verbose = $et->Options('Verbose');
|
||||
my $out = $et->Options('TextOut');
|
||||
my $rtnVal = 0;
|
||||
|
||||
$$dirInfo{DirLen} = 0; # initialize returned trailer length
|
||||
$raf->Seek(-$offset, 2); # seek to specified offset from end of file
|
||||
|
||||
# loop through FotoStation records
|
||||
for (;;) {
|
||||
# look for trailer signature
|
||||
last unless $raf->Seek(-10, 1) and $raf->Read($footer, 10) == 10;
|
||||
my ($tag, $size, $sig) = unpack('nNN', $footer);
|
||||
last unless $sig == 0xa1b2c3d4 and $size >= 10 and $raf->Seek(-$size, 1);
|
||||
$size -= 10; # size of data only
|
||||
last unless $raf->Read($buff, $size) == $size;
|
||||
$raf->Seek(-$size, 1);
|
||||
# set variables returned in dirInfo hash
|
||||
$$dirInfo{DataPos} = $raf->Tell();
|
||||
$$dirInfo{DirLen} += $size + 10;
|
||||
|
||||
unless ($tagTablePtr) {
|
||||
$tagTablePtr = GetTagTable('Image::ExifTool::FotoStation::Main');
|
||||
SetByteOrder('MM'); # necessary for the binary data
|
||||
$rtnVal = 1; # we found a valid FotoStation trailer
|
||||
}
|
||||
unless ($outfile) {
|
||||
# print verbose trailer information
|
||||
if ($verbose or $$et{HTML_DUMP}) {
|
||||
$et->DumpTrailer({
|
||||
RAF => $raf,
|
||||
DataPos => $$dirInfo{DataPos},
|
||||
DirLen => $size + 10,
|
||||
DirName => "FotoStation_$tag",
|
||||
});
|
||||
}
|
||||
# extract information for this tag
|
||||
$et->HandleTag($tagTablePtr, $tag, $buff,
|
||||
DataPt => \$buff,
|
||||
Start => 0,
|
||||
Size => $size,
|
||||
DataPos => $$dirInfo{DataPos},
|
||||
);
|
||||
next;
|
||||
}
|
||||
if ($$et{DEL_GROUP}{FotoStation}) {
|
||||
$verbose and print $out " Deleting FotoStation trailer\n";
|
||||
$verbose = 0; # no more verbose messages after this
|
||||
++$$et{CHANGED};
|
||||
next;
|
||||
}
|
||||
# rewrite this information
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
|
||||
if ($tagInfo) {
|
||||
my $newVal;
|
||||
my $tagName = $$tagInfo{Name};
|
||||
if ($$tagInfo{SubDirectory}) {
|
||||
my %subdirInfo = (
|
||||
DataPt => \$buff,
|
||||
DirStart => 0,
|
||||
DirLen => $size,
|
||||
DataPos => $$dirInfo{DataPos},
|
||||
DirName => $tagName,
|
||||
Parent => 'FotoStation',
|
||||
);
|
||||
my $subTable = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
|
||||
$newVal = $et->WriteDirectory(\%subdirInfo, $subTable);
|
||||
} else {
|
||||
my $nvHash = $et->GetNewValueHash($tagInfo);
|
||||
if ($et->IsOverwriting($nvHash) > 0) {
|
||||
$newVal = $et->GetNewValue($nvHash);
|
||||
$newVal = '' unless defined $newVal;
|
||||
if ($verbose > 1) {
|
||||
my $n = length $newVal;
|
||||
print $out " - FotoStation:$tagName ($size bytes)\n" if $size;
|
||||
print $out " + FotoStation:$tagName ($n bytes)\n" if $n;
|
||||
}
|
||||
++$$et{CHANGED};
|
||||
}
|
||||
}
|
||||
if (defined $newVal) {
|
||||
# note: length may be 0 here, but we write the empty record anyway
|
||||
$buff = $newVal;
|
||||
$size = length($newVal) + 10;
|
||||
$footer = pack('nNN', $tag, $size, $sig);
|
||||
}
|
||||
}
|
||||
if (defined $dirBuff) {
|
||||
# maintain original record order
|
||||
$dirBuff = $buff . $footer . $dirBuff;
|
||||
} else {
|
||||
$dirBuff = $buff . $footer;
|
||||
}
|
||||
}
|
||||
# write the modified FotoStation trailer
|
||||
Write($outfile, $dirBuff) or $rtnVal = -1 if $dirBuff;
|
||||
return $rtnVal;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::FotoStation - Read/write FotoWare FotoStation trailer
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to read and
|
||||
write information from the FotoWare FotoStation trailer.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 ACKNOWLEDGEMENTS
|
||||
|
||||
Thanks to Mark Tate for information about the FotoStation data format.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/FotoStation Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,81 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: GE.pm
|
||||
#
|
||||
# Description: General Imaging maker notes tags
|
||||
#
|
||||
# Revisions: 2010-12-14 - P. Harvey Created
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::GE;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
use Image::ExifTool::Exif;
|
||||
|
||||
$VERSION = '1.00';
|
||||
|
||||
sub ProcessGE2($$$);
|
||||
|
||||
# GE type 1 maker notes (ref PH)
|
||||
# (similar to Kodak::Type11 and Ricoh::Type2)
|
||||
%Image::ExifTool::GE::Main = (
|
||||
WRITE_PROC => \&Image::ExifTool::Exif::WriteExif,
|
||||
CHECK_PROC => \&Image::ExifTool::Exif::CheckExif,
|
||||
WRITABLE => 1,
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
|
||||
NOTES => q{
|
||||
This table lists tags found in the maker notes of some General Imaging
|
||||
camera models.
|
||||
},
|
||||
# 0x0104 - int32u
|
||||
# 0x0200 - int32u[3] (with invalid offset of 0)
|
||||
0x0202 => {
|
||||
Name => 'Macro',
|
||||
Writable => 'int16u',
|
||||
PrintConv => { 0 => 'Off', 1 => 'On' },
|
||||
},
|
||||
# 0x0203 - int16u: 0
|
||||
# 0x0204 - rational64u: 10/10
|
||||
# 0x0205 - rational64u: 7.249,7.34,9.47 (changes with camera model)
|
||||
# 0x0206 - int16u[6] (with invalid offset of 0)
|
||||
0x0207 => {
|
||||
Name => 'GEModel',
|
||||
Format => 'string',
|
||||
},
|
||||
0x0300 => {
|
||||
Name => 'GEMake',
|
||||
Format => 'string',
|
||||
},
|
||||
# 0x0500 - int16u: 0
|
||||
# 0x0600 - int32u: 0
|
||||
);
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::GE - General Imaging maker notes tags
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is loaded automatically by Image::ExifTool when required.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to interpret
|
||||
General Imaging maker notes.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/GE Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,560 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: GIF.pm
|
||||
#
|
||||
# Description: Read and write GIF meta information
|
||||
#
|
||||
# Revisions: 10/18/2005 - P. Harvey Separated from ExifTool.pm
|
||||
# 05/23/2008 - P. Harvey Added ability to read/write XMP
|
||||
# 10/28/2011 - P. Harvey Added ability to read/write ICC_Profile
|
||||
#
|
||||
# References: 1) http://www.w3.org/Graphics/GIF/spec-gif89a.txt
|
||||
# 2) http://www.adobe.com/devnet/xmp/
|
||||
# 3) http://graphcomp.com/info/specs/ani_gif.html
|
||||
# 4) http://www.color.org/icc_specs2.html
|
||||
# 5) http://www.midiox.com/mmgif.htm
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::GIF;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.15';
|
||||
|
||||
# road map of directory locations in GIF images
|
||||
my %gifMap = (
|
||||
XMP => 'GIF',
|
||||
ICC_Profile => 'GIF',
|
||||
);
|
||||
|
||||
%Image::ExifTool::GIF::Main = (
|
||||
GROUPS => { 2 => 'Image' },
|
||||
VARS => { NO_ID => 1 },
|
||||
NOTES => q{
|
||||
This table lists information extracted from GIF images. See
|
||||
L<http://www.w3.org/Graphics/GIF/spec-gif89a.txt> for the official GIF89a
|
||||
specification.
|
||||
},
|
||||
GIFVersion => { },
|
||||
FrameCount => { Notes => 'number of animated images' },
|
||||
Text => { Notes => 'text displayed in image' },
|
||||
Comment => {
|
||||
# for documentation only -- flag as writable for the docs, but
|
||||
# it won't appear in the TagLookup because there is no WRITE_PROC
|
||||
Writable => 1,
|
||||
},
|
||||
Duration => {
|
||||
Notes => 'duration of a single animation iteration',
|
||||
PrintConv => 'sprintf("%.2f s",$val)',
|
||||
},
|
||||
ScreenDescriptor => {
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::GIF::Screen' },
|
||||
},
|
||||
Extensions => { # (for documentation only)
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::GIF::Extensions' },
|
||||
},
|
||||
);
|
||||
|
||||
# GIF89a application extensions:
|
||||
%Image::ExifTool::GIF::Extensions = (
|
||||
GROUPS => { 2 => 'Image' },
|
||||
NOTES => 'Tags extracted from GIF89a application extensions.',
|
||||
'NETSCAPE/2.0' => { #3
|
||||
Name => 'Animation',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::GIF::Animation' },
|
||||
},
|
||||
'XMP Data/XMP' => { #2
|
||||
Name => 'XMP',
|
||||
IncludeLengthBytes => 1, # length bytes are included in the data
|
||||
Writable => 1,
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
|
||||
},
|
||||
'ICCRGBG1/012' => { #4
|
||||
Name => 'ICC_Profile',
|
||||
Writable => 1,
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main' },
|
||||
},
|
||||
'MIDICTRL/Jon' => { #5
|
||||
Name => 'MIDIControl',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::GIF::MIDIControl' },
|
||||
},
|
||||
'MIDISONG/Dm7' => { #5
|
||||
Name => 'MIDISong',
|
||||
Groups => { 2 => 'Audio' },
|
||||
Binary => 1,
|
||||
},
|
||||
);
|
||||
|
||||
# GIF locical screen descriptor
|
||||
%Image::ExifTool::GIF::Screen = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 2 => 'Image' },
|
||||
NOTES => 'Information extracted from the GIF logical screen descriptor.',
|
||||
0 => {
|
||||
Name => 'ImageWidth',
|
||||
Format => 'int16u',
|
||||
},
|
||||
2 => {
|
||||
Name => 'ImageHeight',
|
||||
Format => 'int16u',
|
||||
},
|
||||
4.1 => {
|
||||
Name => 'HasColorMap',
|
||||
Mask => 0x80,
|
||||
PrintConv => { 0x00 => 'No', 0x80 => 'Yes' },
|
||||
},
|
||||
4.2 => {
|
||||
Name => 'ColorResolutionDepth',
|
||||
Mask => 0x70,
|
||||
ValueConv => '($val >> 4) + 1',
|
||||
},
|
||||
4.3 => {
|
||||
Name => 'BitsPerPixel',
|
||||
Mask => 0x07,
|
||||
ValueConv => '$val + 1',
|
||||
},
|
||||
5 => 'BackgroundColor',
|
||||
);
|
||||
|
||||
# GIF Netscape 2.0 animation extension (ref 3)
|
||||
%Image::ExifTool::GIF::Animation = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 2 => 'Image' },
|
||||
NOTES => 'Information extracted from the "NETSCAPE2.0" animation extension.',
|
||||
1 => {
|
||||
Name => 'AnimationIterations',
|
||||
Format => 'int16u',
|
||||
PrintConv => '$val ? $val : "Infinite"',
|
||||
},
|
||||
);
|
||||
|
||||
# GIF MIDICTRL extension (ref 5)
|
||||
%Image::ExifTool::GIF::MIDIControl = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 2 => 'Audio' },
|
||||
NOTES => 'Information extracted from the MIDI control block extension.',
|
||||
0 => 'MIDIControlVersion',
|
||||
1 => 'SequenceNumber',
|
||||
2 => 'MelodicPolyphony',
|
||||
3 => 'PercussivePolyphony',
|
||||
4 => {
|
||||
Name => 'ChannelUsage',
|
||||
Format => 'int16u',
|
||||
PrintConv => 'sprintf("0x%.4x", $val)',
|
||||
},
|
||||
6 => {
|
||||
Name => 'DelayTime',
|
||||
Format => 'int16u',
|
||||
ValueConv => '$val / 100',
|
||||
PrintConv => '$val . " s"',
|
||||
},
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process meta information in GIF image
|
||||
# Inputs: 0) ExifTool object reference, 1) Directory information ref
|
||||
# Returns: 1 on success, 0 if this wasn't a valid GIF file, or -1 if
|
||||
# an output file was specified and a write error occurred
|
||||
sub ProcessGIF($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $outfile = $$dirInfo{OutFile};
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $verbose = $et->Options('Verbose');
|
||||
my $out = $et->Options('TextOut');
|
||||
my ($a, $s, $ch, $length, $buff);
|
||||
my ($err, $newComment, $setComment, $nvComment);
|
||||
my ($addDirs, %doneDir);
|
||||
my ($frameCount, $delayTime) = (0, 0);
|
||||
|
||||
# verify this is a valid GIF file
|
||||
return 0 unless $raf->Read($buff, 6) == 6
|
||||
and $buff =~ /^GIF(8[79]a)$/
|
||||
and $raf->Read($s, 7) == 7;
|
||||
|
||||
my $ver = $1;
|
||||
my $rtnVal = 0;
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::GIF::Main');
|
||||
SetByteOrder('II');
|
||||
|
||||
if ($outfile) {
|
||||
$et->InitWriteDirs(\%gifMap, 'XMP'); # make XMP the preferred group for GIF
|
||||
$addDirs = $$et{ADD_DIRS};
|
||||
# determine if we are editing the File:Comment tag
|
||||
my $delGroup = $$et{DEL_GROUP};
|
||||
$newComment = $et->GetNewValue('Comment', \$nvComment);
|
||||
$setComment = 1 if $nvComment or $$delGroup{File};
|
||||
# change to GIF 89a if adding comment, XMP or ICC_Profile
|
||||
$buff = 'GIF89a' if $$addDirs{XMP} or $$addDirs{ICC_Profile} or defined $newComment;
|
||||
Write($outfile, $buff, $s) or $err = 1;
|
||||
} else {
|
||||
$et->SetFileType(); # set file type
|
||||
$et->HandleTag($tagTablePtr, 'GIFVersion', $ver);
|
||||
$et->HandleTag($tagTablePtr, 'ScreenDescriptor', $s);
|
||||
}
|
||||
my $flags = Get8u(\$s, 4);
|
||||
if ($flags & 0x80) { # does this image contain a color table?
|
||||
# calculate color table size
|
||||
$length = 3 * (2 << ($flags & 0x07));
|
||||
$raf->Read($buff, $length) == $length or return 0; # skip color table
|
||||
Write($outfile, $buff) or $err = 1 if $outfile;
|
||||
}
|
||||
#
|
||||
# loop through GIF blocks
|
||||
#
|
||||
Block:
|
||||
for (;;) {
|
||||
last unless $raf->Read($ch, 1);
|
||||
# write out any new metadata now if this isn't an extension block
|
||||
if ($outfile and ord($ch) != 0x21) {
|
||||
# write the comment first if necessary
|
||||
if (defined $newComment and $$nvComment{IsCreating}) {
|
||||
# write comment marker
|
||||
Write($outfile, "\x21\xfe") or $err = 1;
|
||||
$verbose and print $out " + Comment = $newComment\n";
|
||||
my $len = length($newComment);
|
||||
# write out the comment in 255-byte chunks, each
|
||||
# chunk beginning with a length byte
|
||||
my $n;
|
||||
for ($n=0; $n<$len; $n+=255) {
|
||||
my $size = $len - $n;
|
||||
$size > 255 and $size = 255;
|
||||
my $str = substr($newComment,$n,$size);
|
||||
Write($outfile, pack('C',$size), $str) or $err = 1;
|
||||
}
|
||||
Write($outfile, "\0") or $err = 1; # empty chunk as terminator
|
||||
undef $newComment;
|
||||
undef $nvComment; # delete any other extraneous comments
|
||||
++$$et{CHANGED}; # increment file changed flag
|
||||
}
|
||||
# add application extension containing XMP block if necessary
|
||||
# (this will place XMP before the first non-extension block)
|
||||
if (exists $$addDirs{XMP} and not defined $doneDir{XMP}) {
|
||||
$doneDir{XMP} = 1;
|
||||
# write new XMP data
|
||||
my $xmpTable = GetTagTable('Image::ExifTool::XMP::Main');
|
||||
my %dirInfo = ( Parent => 'GIF' );
|
||||
$verbose and print $out "Creating XMP application extension block:\n";
|
||||
$buff = $et->WriteDirectory(\%dirInfo, $xmpTable);
|
||||
if (defined $buff and length $buff) {
|
||||
my $lz = pack('C*',1,reverse(0..255),0);
|
||||
Write($outfile, "\x21\xff\x0bXMP DataXMP", $buff, $lz) or $err = 1;
|
||||
++$doneDir{XMP}; # set to 2 to indicate we added XMP
|
||||
} else {
|
||||
$verbose and print $out " -> no XMP to add\n";
|
||||
}
|
||||
}
|
||||
# add application extension containing ICC_Profile if necessary
|
||||
if (exists $$addDirs{ICC_Profile} and not defined $doneDir{ICC_Profile}) {
|
||||
$doneDir{ICC_Profile} = 1;
|
||||
# write new ICC_Profile
|
||||
my $iccTable = GetTagTable('Image::ExifTool::ICC_Profile::Main');
|
||||
my %dirInfo = ( Parent => 'GIF' );
|
||||
$verbose and print $out "Creating ICC_Profile application extension block:\n";
|
||||
$buff = $et->WriteDirectory(\%dirInfo, $iccTable);
|
||||
if (defined $buff and length $buff) {
|
||||
my $pos = 0;
|
||||
Write($outfile, "\x21\xff\x0bICCRGBG1012") or $err = 1;
|
||||
my $len = length $buff;
|
||||
while ($pos < $len) {
|
||||
my $n = $len - $pos;
|
||||
$n = 255 if $n > 255;
|
||||
Write($outfile, chr($n), substr($buff, $pos, $n)) or $err = 1;
|
||||
$pos += $n;
|
||||
}
|
||||
Write($outfile, "\0") or $err = 1; # write null terminator
|
||||
++$doneDir{ICC_Profile}; # set to 2 to indicate we added a new profile
|
||||
} else {
|
||||
$verbose and print $out " -> no ICC_Profile to add\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
if (ord($ch) == 0x2c) {
|
||||
++$frameCount;
|
||||
Write($outfile, $ch) or $err = 1 if $outfile;
|
||||
# image descriptor
|
||||
last unless $raf->Read($buff, 8) == 8 and $raf->Read($ch, 1);
|
||||
Write($outfile, $buff, $ch) or $err = 1 if $outfile;
|
||||
if ($verbose) {
|
||||
my ($left, $top, $w, $h) = unpack('v*', $buff);
|
||||
print $out "Image: left=$left top=$top width=$w height=$h\n";
|
||||
}
|
||||
if (ord($ch) & 0x80) { # does color table exist?
|
||||
$length = 3 * (2 << (ord($ch) & 0x07));
|
||||
# skip the color table
|
||||
last unless $raf->Read($buff, $length) == $length;
|
||||
Write($outfile, $buff) or $err = 1 if $outfile;
|
||||
}
|
||||
# skip "LZW Minimum Code Size" byte
|
||||
last unless $raf->Read($buff, 1);
|
||||
Write($outfile,$buff) or $err = 1 if $outfile;
|
||||
# skip image blocks
|
||||
for (;;) {
|
||||
last unless $raf->Read($ch, 1);
|
||||
Write($outfile, $ch) or $err = 1 if $outfile;
|
||||
last unless ord($ch);
|
||||
last unless $raf->Read($buff, ord($ch));
|
||||
Write($outfile,$buff) or $err = 1 if $outfile;
|
||||
}
|
||||
next; # continue with next field
|
||||
}
|
||||
# last if ord($ch) == 0x3b; # normal end of GIF marker
|
||||
unless (ord($ch) == 0x21) {
|
||||
if ($outfile) {
|
||||
Write($outfile, $ch) or $err = 1;
|
||||
# copy the rest of the file
|
||||
while ($raf->Read($buff, 65536)) {
|
||||
Write($outfile, $buff) or $err = 1;
|
||||
}
|
||||
}
|
||||
$rtnVal = 1;
|
||||
last;
|
||||
}
|
||||
# get extension block type/size
|
||||
last unless $raf->Read($s, 2) == 2;
|
||||
# get marker and block size
|
||||
($a,$length) = unpack("C"x2, $s);
|
||||
|
||||
if ($a == 0xfe) { # comment extension
|
||||
|
||||
my $comment = '';
|
||||
while ($length) {
|
||||
last unless $raf->Read($buff, $length) == $length;
|
||||
$et->VerboseDump(\$buff) unless $outfile;
|
||||
# add buffer to comment string
|
||||
$comment .= $buff;
|
||||
last unless $raf->Read($ch, 1); # read next block header
|
||||
$length = ord($ch); # get next block size
|
||||
}
|
||||
last if $length; # was a read error if length isn't zero
|
||||
if ($outfile) {
|
||||
my $isOverwriting;
|
||||
if ($setComment) {
|
||||
if ($nvComment) {
|
||||
$isOverwriting = $et->IsOverwriting($nvComment,$comment);
|
||||
# get new comment again (may have been shifted)
|
||||
$newComment = $et->GetNewValue($nvComment) if defined $newComment;
|
||||
} else {
|
||||
# group delete, or deleting additional comments after writing one
|
||||
$isOverwriting = 1;
|
||||
}
|
||||
}
|
||||
if ($isOverwriting) {
|
||||
++$$et{CHANGED}; # increment file changed flag
|
||||
$et->VerboseValue('- Comment', $comment);
|
||||
$comment = $newComment;
|
||||
$et->VerboseValue('+ Comment', $comment) if defined $comment;
|
||||
undef $nvComment; # just delete remaining comments
|
||||
} else {
|
||||
undef $setComment; # leave remaining comments alone
|
||||
}
|
||||
if (defined $comment) {
|
||||
# write comment marker
|
||||
Write($outfile, "\x21\xfe") or $err = 1;
|
||||
my $len = length($comment);
|
||||
# write out the comment in 255-byte chunks, each
|
||||
# chunk beginning with a length byte
|
||||
my $n;
|
||||
for ($n=0; $n<$len; $n+=255) {
|
||||
my $size = $len - $n;
|
||||
$size > 255 and $size = 255;
|
||||
my $str = substr($comment,$n,$size);
|
||||
Write($outfile, pack('C',$size), $str) or $err = 1;
|
||||
}
|
||||
Write($outfile, "\0") or $err = 1; # empty chunk as terminator
|
||||
}
|
||||
undef $newComment; # don't write the new comment again
|
||||
} else {
|
||||
$rtnVal = 1;
|
||||
$et->FoundTag('Comment', $comment) if $comment;
|
||||
undef $comment;
|
||||
# assume no more than one comment in FastScan mode
|
||||
last if $et->Options('FastScan');
|
||||
}
|
||||
next;
|
||||
|
||||
} elsif ($a == 0xff and $length == 0x0b) { # application extension
|
||||
|
||||
last unless $raf->Read($buff, $length) == $length;
|
||||
my $hdr = "$ch$s$buff";
|
||||
# add "/" for readability
|
||||
my $tag = substr($buff, 0, 8) . '/' . substr($buff, 8);
|
||||
$tag =~ tr/\0-\x1f//d; # remove nulls and control characters
|
||||
$verbose and print $out "Application Extension: $tag\n";
|
||||
|
||||
my $extTable = GetTagTable('Image::ExifTool::GIF::Extensions');
|
||||
my $extInfo = $$extTable{$tag};
|
||||
my ($subdir, $inclLen, $justCopy);
|
||||
if ($extInfo) {
|
||||
$subdir = $$extInfo{SubDirectory};
|
||||
$inclLen = $$extInfo{IncludeLengthBytes};
|
||||
# rewrite as-is unless this is a writable subdirectory
|
||||
$justCopy = 1 if $outfile and (not $subdir or not $$extInfo{Writable});
|
||||
} else {
|
||||
$justCopy = 1 if $outfile;
|
||||
}
|
||||
Write($outfile, $hdr) or $err = 1 if $justCopy;
|
||||
|
||||
# read the extension data
|
||||
my $dat = '';
|
||||
for (;;) {
|
||||
$raf->Read($ch, 1) or last Block; # read next block header
|
||||
$length = ord($ch) or last; # get next block size
|
||||
$raf->Read($buff, $length) == $length or last Block;
|
||||
Write($outfile, $ch, $buff) or $err = 1 if $justCopy;
|
||||
$dat .= $inclLen ? $ch . $buff : $buff;
|
||||
}
|
||||
Write($outfile, "\0") if $justCopy;
|
||||
|
||||
if ($subdir) {
|
||||
my $dirLen = length $dat;
|
||||
my $name = $$extInfo{Name};
|
||||
if ($name eq 'XMP') {
|
||||
# get length of XMP without landing zone data
|
||||
# (note that LZ data may not be exactly the same as what we use)
|
||||
$dirLen = pos($dat) if $dat =~ /<\?xpacket end=['"][wr]['"]\?>/g;
|
||||
}
|
||||
my %dirInfo = (
|
||||
DataPt => \$dat,
|
||||
DataLen => length $dat,
|
||||
DirLen => $dirLen,
|
||||
DirName => $name,
|
||||
Parent => 'GIF',
|
||||
);
|
||||
my $subTable = GetTagTable($$subdir{TagTable});
|
||||
if (not $outfile) {
|
||||
$et->ProcessDirectory(\%dirInfo, $subTable);
|
||||
} elsif ($$extInfo{Writable}) {
|
||||
if ($doneDir{$name} and $doneDir{$name} > 1) {
|
||||
$et->Warn("Duplicate $name block created");
|
||||
}
|
||||
$buff = $et->WriteDirectory(\%dirInfo, $subTable);
|
||||
if (defined $buff) {
|
||||
next unless length $buff; # delete this extension if length is zero
|
||||
# check for null just to be safe
|
||||
$et->Error("$name contained NULL character") if $buff =~ /\0/;
|
||||
$dat = $buff;
|
||||
# add landing zone (without terminator, which will be added later)
|
||||
$dat .= pack('C*',1,reverse(0..255)) if $$extInfo{IncludeLengthBytes};
|
||||
} # (else rewrite original data)
|
||||
|
||||
$doneDir{$name} = 1;
|
||||
|
||||
if ($$extInfo{IncludeLengthBytes}) {
|
||||
# write data and landing zone
|
||||
Write($outfile, $hdr, $dat) or $err = 1;
|
||||
} else {
|
||||
# write as sub-blocks
|
||||
Write($outfile, $hdr) or $err = 1;
|
||||
my $pos = 0;
|
||||
my $len = length $dat;
|
||||
while ($pos < $len) {
|
||||
my $n = $len - $pos;
|
||||
$n = 255 if $n > 255;
|
||||
Write($outfile, chr($n), substr($dat, $pos, $n)) or $err = 1;
|
||||
$pos += $n;
|
||||
}
|
||||
}
|
||||
Write($outfile, "\0") or $err = 1; # write null terminator
|
||||
}
|
||||
} elsif (not $outfile) {
|
||||
$et->HandleTag($extTable, $tag, $dat);
|
||||
}
|
||||
next;
|
||||
|
||||
} elsif ($a == 0xf9 and $length == 4) { # graphic control extension
|
||||
|
||||
last unless $raf->Read($buff, $length) == $length;
|
||||
# sum the indivual delay times
|
||||
my $delay = Get16u(\$buff, 1);
|
||||
$delayTime += $delay;
|
||||
$verbose and printf $out "Graphic Control: delay=%.2f\n", $delay / 100;
|
||||
$raf->Seek(-$length, 1) or last;
|
||||
|
||||
} elsif ($a == 0x01 and $length == 12) { # plain text extension
|
||||
|
||||
last unless $raf->Read($buff, $length) == $length;
|
||||
Write($outfile, $ch, $s, $buff) or $err = 1 if $outfile;
|
||||
if ($verbose) {
|
||||
my ($left, $top, $w, $h) = unpack('v4', $buff);
|
||||
print $out "Text: left=$left top=$top width=$w height=$h\n";
|
||||
}
|
||||
my $text = '';
|
||||
for (;;) {
|
||||
last unless $raf->Read($ch, 1);
|
||||
$length = ord($ch) or last;
|
||||
last unless $raf->Read($buff, $length) == $length;
|
||||
Write($outfile, $ch, $buff) or $err = 1 if $outfile; # write block
|
||||
$text .= $buff;
|
||||
}
|
||||
Write($outfile, "\0") or $err = 1 if $outfile; # write terminator block
|
||||
$et->HandleTag($tagTablePtr, 'Text', $text);
|
||||
next;
|
||||
}
|
||||
Write($outfile, $ch, $s) or $err = 1 if $outfile;
|
||||
# skip the block
|
||||
while ($length) {
|
||||
last unless $raf->Read($buff, $length) == $length;
|
||||
Write($outfile, $buff) or $err = 1 if $outfile;
|
||||
last unless $raf->Read($ch, 1); # read next block header
|
||||
Write($outfile, $ch) or $err = 1 if $outfile;
|
||||
$length = ord($ch); # get next block size
|
||||
}
|
||||
}
|
||||
unless ($outfile) {
|
||||
$et->HandleTag($tagTablePtr, 'FrameCount', $frameCount) if $frameCount > 1;
|
||||
$et->HandleTag($tagTablePtr, 'Duration', $delayTime/100) if $delayTime;
|
||||
}
|
||||
|
||||
# set return value to -1 if we only had a write error
|
||||
$rtnVal = -1 if $rtnVal and $err;
|
||||
return $rtnVal;
|
||||
}
|
||||
|
||||
|
||||
1; #end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::GIF - Read and write GIF meta information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is loaded automatically by Image::ExifTool when required.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to read and
|
||||
write GIF meta information.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://www.w3.org/Graphics/GIF/spec-gif89a.txt>
|
||||
|
||||
=item L<http://www.adobe.com/devnet/xmp/>
|
||||
|
||||
=item L<http://graphcomp.com/info/specs/ani_gif.html>
|
||||
|
||||
=item L<http://www.color.org/icc_specs2.html>
|
||||
|
||||
=item L<http://www.midiox.com/mmgif.htm>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,258 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: GIMP.pm
|
||||
#
|
||||
# Description: Read meta information from GIMP XCF images
|
||||
#
|
||||
# Revisions: 2010/10/05 - P. Harvey Created
|
||||
#
|
||||
# References: 1) GIMP source code
|
||||
# 2) http://svn.gnome.org/viewvc/gimp/trunk/devel-docs/xcf.txt?view=markup
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::GIMP;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.02';
|
||||
|
||||
sub ProcessParasites($$$);
|
||||
|
||||
# GIMP XCF properties (ref 2)
|
||||
%Image::ExifTool::GIMP::Main = (
|
||||
GROUPS => { 2 => 'Image' },
|
||||
VARS => { ALPHA_FIRST => 1 },
|
||||
NOTES => q{
|
||||
The GNU Image Manipulation Program (GIMP) writes these tags in its native
|
||||
XCF (eXperimental Computing Facilty) images.
|
||||
},
|
||||
header => { SubDirectory => { TagTable => 'Image::ExifTool::GIMP::Header' } },
|
||||
17 => {
|
||||
Name => 'Compression',
|
||||
Format => 'int8u',
|
||||
PrintConv => {
|
||||
0 => 'None',
|
||||
1 => 'RLE Encoding',
|
||||
2 => 'Zlib',
|
||||
3 => 'Fractal',
|
||||
},
|
||||
},
|
||||
19 => {
|
||||
Name => 'Resolution',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::GIMP::Resolution' },
|
||||
},
|
||||
21 => {
|
||||
Name => 'Parasites',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::GIMP::Parasite' },
|
||||
},
|
||||
);
|
||||
|
||||
# information extracted from the XCF file header (ref 2)
|
||||
%Image::ExifTool::GIMP::Header = (
|
||||
GROUPS => { 2 => 'Image' },
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
9 => {
|
||||
Name => 'XCFVersion',
|
||||
Format => 'string[5]',
|
||||
PrintConv => {
|
||||
'file' => '0',
|
||||
'v001' => '1',
|
||||
'v002' => '2',
|
||||
},
|
||||
},
|
||||
14 => { Name => 'ImageWidth', Format => 'int32u' },
|
||||
18 => { Name => 'ImageHeight', Format => 'int32u' },
|
||||
22 => {
|
||||
Name => 'ColorMode',
|
||||
Format => 'int32u',
|
||||
PrintConv => {
|
||||
0 => 'RGB Color',
|
||||
1 => 'Grayscale',
|
||||
2 => 'Indexed Color',
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
# XCF resolution data (property type 19) (ref 2)
|
||||
%Image::ExifTool::GIMP::Resolution = (
|
||||
GROUPS => { 2 => 'Image' },
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
FORMAT => 'float',
|
||||
0 => 'XResolution',
|
||||
1 => 'YResolution',
|
||||
);
|
||||
|
||||
# XCF "Parasite" data (property type 21) (ref 1/PH)
|
||||
%Image::ExifTool::GIMP::Parasite = (
|
||||
GROUPS => { 2 => 'Image' },
|
||||
PROCESS_PROC => \&ProcessParasites,
|
||||
'gimp-comment' => {
|
||||
Name => 'Comment',
|
||||
Format => 'string',
|
||||
},
|
||||
'exif-data' => {
|
||||
Name => 'ExifData',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::Exif::Main',
|
||||
ProcessProc => \&Image::ExifTool::ProcessTIFF,
|
||||
Start => 6, # starts after "Exif\0\0" header
|
||||
},
|
||||
},
|
||||
'jpeg-exif-data' => { # (deprecated, untested)
|
||||
Name => 'JPEGExifData',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::Exif::Main',
|
||||
ProcessProc => \&Image::ExifTool::ProcessTIFF,
|
||||
Start => 6,
|
||||
},
|
||||
},
|
||||
'iptc-data' => { # (untested)
|
||||
Name => 'IPTCData',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::IPTC::Main' },
|
||||
},
|
||||
'icc-profile' => {
|
||||
Name => 'ICC_Profile',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main' },
|
||||
},
|
||||
'icc-profile-name' => {
|
||||
Name => 'ICCProfileName',
|
||||
Format => 'string',
|
||||
},
|
||||
'gimp-metadata' => {
|
||||
Name => 'XMP',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::XMP::Main',
|
||||
Start => 10, # starts after "GIMP_XMP_1" header
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read information in a GIMP XCF parasite data (ref PH)
|
||||
# Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: 1 on success
|
||||
sub ProcessParasites($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $unknown = $et->Options('Unknown') || $et->Options('Verbose');
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $pos = $$dirInfo{DirStart} || 0;
|
||||
my $end = length $$dataPt;
|
||||
$et->VerboseDir('Parasites', undef, $end);
|
||||
for (;;) {
|
||||
last if $pos + 4 > $end;
|
||||
my $size = Get32u($dataPt, $pos); # length of tag string
|
||||
$pos += 4;
|
||||
last if $pos + $size + 8 > $end;
|
||||
my $tag = substr($$dataPt, $pos, $size);
|
||||
$pos += $size;
|
||||
$tag =~ s/\0.*//s; # trim at null terminator
|
||||
# my $flags = Get32u($dataPt, $pos); (ignore flags)
|
||||
$size = Get32u($dataPt, $pos + 4); # length of data
|
||||
$pos += 8;
|
||||
last if $pos + $size > $end;
|
||||
if (not $$tagTablePtr{$tag} and $unknown) {
|
||||
my $name = $tag;
|
||||
$name =~ tr/-_A-Za-z0-9//dc;
|
||||
$name =~ s/^gimp-//;
|
||||
next unless length $name;
|
||||
$name = ucfirst $name;
|
||||
$name =~ s/([a-z])-([a-z])/$1\u$2/g;
|
||||
$name = "GIMP-$name" unless length($name) > 1;
|
||||
AddTagToTable($tagTablePtr, $tag, { Name => $name, Unknown => 1 });
|
||||
}
|
||||
$et->HandleTag($tagTablePtr, $tag, undef,
|
||||
DataPt => $dataPt,
|
||||
Start => $pos,
|
||||
Size => $size,
|
||||
);
|
||||
$pos += $size;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read information in a GIMP XCF document
|
||||
# Inputs: 0) ExifTool ref, 1) dirInfo ref
|
||||
# Returns: 1 on success, 0 if this wasn't a valid XCF file
|
||||
sub ProcessXCF($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $buff;
|
||||
|
||||
return 0 unless $raf->Read($buff, 26) == 26;
|
||||
return 0 unless $buff =~ /^gimp xcf /;
|
||||
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::GIMP::Main');
|
||||
my $verbose = $et->Options('Verbose');
|
||||
$et->SetFileType();
|
||||
SetByteOrder('MM');
|
||||
|
||||
# process the XCF header
|
||||
$et->HandleTag($tagTablePtr, 'header', $buff);
|
||||
|
||||
# loop through image properties
|
||||
for (;;) {
|
||||
$raf->Read($buff, 8) == 8 or last;
|
||||
my $tag = Get32u(\$buff, 0) or last;
|
||||
my $size = Get32u(\$buff, 4);
|
||||
$verbose and $et->VPrint(0, "XCF property $tag ($size bytes):\n");
|
||||
unless ($$tagTablePtr{$tag}) {
|
||||
$raf->Seek($size, 1);
|
||||
next;
|
||||
}
|
||||
$raf->Read($buff, $size) == $size or last;
|
||||
$et->HandleTag($tagTablePtr, $tag, undef,
|
||||
DataPt => \$buff,
|
||||
DataPos => $raf->Tell() - $size,
|
||||
Size => $size,
|
||||
);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::GIMP - Read meta information from GIMP XCF images
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to read meta
|
||||
information from GIMP (GNU Image Manipulation Program) XCF (eXperimental
|
||||
Computing Facility) images. This is the native image format used by the
|
||||
GIMP software.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<GIMP source code>
|
||||
|
||||
=item L<http://svn.gnome.org/viewvc/gimp/trunk/devel-docs/xcf.txt?view=markup>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/GIMP Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,578 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: GPS.pm
|
||||
#
|
||||
# Description: EXIF GPS meta information tags
|
||||
#
|
||||
# Revisions: 12/09/2003 - P. Harvey Created
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::GPS;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool::Exif;
|
||||
|
||||
$VERSION = '1.49';
|
||||
|
||||
my %coordConv = (
|
||||
ValueConv => 'Image::ExifTool::GPS::ToDegrees($val)',
|
||||
ValueConvInv => 'Image::ExifTool::GPS::ToDMS($self, $val)',
|
||||
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1)',
|
||||
PrintConvInv => 'Image::ExifTool::GPS::ToDegrees($val)',
|
||||
);
|
||||
|
||||
%Image::ExifTool::GPS::Main = (
|
||||
GROUPS => { 0 => 'EXIF', 1 => 'GPS', 2 => 'Location' },
|
||||
WRITE_PROC => \&Image::ExifTool::Exif::WriteExif,
|
||||
CHECK_PROC => \&Image::ExifTool::Exif::CheckExif,
|
||||
WRITABLE => 1,
|
||||
WRITE_GROUP => 'GPS',
|
||||
0x0000 => {
|
||||
Name => 'GPSVersionID',
|
||||
Writable => 'int8u',
|
||||
Mandatory => 1,
|
||||
Count => 4,
|
||||
PrintConv => '$val =~ tr/ /./; $val',
|
||||
PrintConvInv => '$val =~ tr/./ /; $val',
|
||||
},
|
||||
0x0001 => {
|
||||
Name => 'GPSLatitudeRef',
|
||||
Writable => 'string',
|
||||
Notes => q{
|
||||
tags 0x0001-0x0006 used for camera location according to MWG 2.0. ExifTool
|
||||
will also accept a number when writing GPSLatitudeRef, positive for north
|
||||
latitudes or negative for south, or a string ending in N or S
|
||||
},
|
||||
Count => 2,
|
||||
PrintConv => {
|
||||
# extract N/S if written from Composite:GPSLatitude
|
||||
# (also allow writing from a signed number)
|
||||
OTHER => sub {
|
||||
my ($val, $inv) = @_;
|
||||
return undef unless $inv;
|
||||
return uc $1 if $val =~ /\b([NS])$/i;
|
||||
return $1 eq '-' ? 'S' : 'N' if $val =~ /^([-+]?)\d+(\.\d*)?$/;
|
||||
return undef;
|
||||
},
|
||||
N => 'North',
|
||||
S => 'South',
|
||||
},
|
||||
},
|
||||
0x0002 => {
|
||||
Name => 'GPSLatitude',
|
||||
Writable => 'rational64u',
|
||||
Count => 3,
|
||||
%coordConv,
|
||||
},
|
||||
0x0003 => {
|
||||
Name => 'GPSLongitudeRef',
|
||||
Writable => 'string',
|
||||
Count => 2,
|
||||
Notes => q{
|
||||
ExifTool will also accept a number when writing this tag, positive for east
|
||||
longitudes or negative for west, or a string ending in E or W
|
||||
},
|
||||
PrintConv => {
|
||||
# extract E/W if written from Composite:GPSLongitude
|
||||
# (also allow writing from a signed number)
|
||||
OTHER => sub {
|
||||
my ($val, $inv) = @_;
|
||||
return undef unless $inv;
|
||||
return uc $1 if $val =~ /\b([EW])$/i;
|
||||
return $1 eq '-' ? 'W' : 'E' if $val =~ /^([-+]?)\d+(\.\d*)?$/;
|
||||
return undef;
|
||||
},
|
||||
E => 'East',
|
||||
W => 'West',
|
||||
},
|
||||
},
|
||||
0x0004 => {
|
||||
Name => 'GPSLongitude',
|
||||
Writable => 'rational64u',
|
||||
Count => 3,
|
||||
%coordConv,
|
||||
},
|
||||
0x0005 => {
|
||||
Name => 'GPSAltitudeRef',
|
||||
Writable => 'int8u',
|
||||
Notes => q{
|
||||
ExifTool will also accept a signed number when writing this tag, beginning
|
||||
with "+" for above sea level, or "-" for below
|
||||
},
|
||||
PrintConv => {
|
||||
OTHER => sub {
|
||||
my ($val, $inv) = @_;
|
||||
return undef unless $inv and $val =~ /^([-+])/;
|
||||
return($1 eq '-' ? 1 : 0);
|
||||
},
|
||||
0 => 'Above Sea Level',
|
||||
1 => 'Below Sea Level',
|
||||
},
|
||||
},
|
||||
0x0006 => {
|
||||
Name => 'GPSAltitude',
|
||||
Writable => 'rational64u',
|
||||
# extricate unsigned decimal number from string
|
||||
ValueConvInv => '$val=~/((?=\d|\.\d)\d*(?:\.\d*)?)/ ? $1 : undef',
|
||||
PrintConv => '$val =~ /^(inf|undef)$/ ? $val : "$val m"',
|
||||
PrintConvInv => '$val=~s/\s*m$//;$val',
|
||||
},
|
||||
0x0007 => {
|
||||
Name => 'GPSTimeStamp',
|
||||
Groups => { 2 => 'Time' },
|
||||
Writable => 'rational64u',
|
||||
Count => 3,
|
||||
Shift => 'Time',
|
||||
Notes => q{
|
||||
UTC time of GPS fix. When writing, date is stripped off if present, and
|
||||
time is adjusted to UTC if it includes a timezone
|
||||
},
|
||||
ValueConv => 'Image::ExifTool::GPS::ConvertTimeStamp($val)',
|
||||
ValueConvInv => '$val=~tr/:/ /;$val',
|
||||
PrintConv => 'Image::ExifTool::GPS::PrintTimeStamp($val)',
|
||||
# pull time out of any format date/time string
|
||||
# (converting to UTC if a timezone is given)
|
||||
PrintConvInv => sub {
|
||||
my ($v, $et) = @_;
|
||||
$v = $et->TimeNow() if lc($v) eq 'now';
|
||||
my @tz;
|
||||
if ($v =~ s/([-+])(.*)//s) { # remove timezone
|
||||
my $s = $1 eq '-' ? 1 : -1; # opposite sign to convert back to UTC
|
||||
my $t = $2;
|
||||
@tz = ($s*$1, $s*$2) if $t =~ /^(\d{2}):?(\d{2})\s*$/;
|
||||
}
|
||||
my @a = ($v =~ /((?=\d|\.\d)\d*(?:\.\d*)?)/g);
|
||||
push @a, '00' while @a < 3;
|
||||
if (@tz) {
|
||||
# adjust to UTC
|
||||
$a[-2] += $tz[1];
|
||||
$a[-3] += $tz[0];
|
||||
while ($a[-2] >= 60) { $a[-2] -= 60; ++$a[-3] }
|
||||
while ($a[-2] < 0) { $a[-2] += 60; --$a[-3] }
|
||||
$a[-3] = ($a[-3] + 24) % 24;
|
||||
}
|
||||
return "$a[-3]:$a[-2]:$a[-1]";
|
||||
},
|
||||
},
|
||||
0x0008 => {
|
||||
Name => 'GPSSatellites',
|
||||
Writable => 'string',
|
||||
},
|
||||
0x0009 => {
|
||||
Name => 'GPSStatus',
|
||||
Writable => 'string',
|
||||
Count => 2,
|
||||
PrintConv => {
|
||||
A => 'Measurement Active', # Exif2.2 "Measurement in progress"
|
||||
V => 'Measurement Void', # Exif2.2 "Measurement Interoperability" (WTF?)
|
||||
# (meaning for 'V' taken from status code in NMEA GLL and RMC sentences)
|
||||
},
|
||||
},
|
||||
0x000a => {
|
||||
Name => 'GPSMeasureMode',
|
||||
Writable => 'string',
|
||||
Count => 2,
|
||||
PrintConv => {
|
||||
2 => '2-Dimensional Measurement',
|
||||
3 => '3-Dimensional Measurement',
|
||||
},
|
||||
},
|
||||
0x000b => {
|
||||
Name => 'GPSDOP',
|
||||
Description => 'GPS Dilution Of Precision',
|
||||
Writable => 'rational64u',
|
||||
},
|
||||
0x000c => {
|
||||
Name => 'GPSSpeedRef',
|
||||
Writable => 'string',
|
||||
Count => 2,
|
||||
PrintConv => {
|
||||
K => 'km/h',
|
||||
M => 'mph',
|
||||
N => 'knots',
|
||||
},
|
||||
},
|
||||
0x000d => {
|
||||
Name => 'GPSSpeed',
|
||||
Writable => 'rational64u',
|
||||
},
|
||||
0x000e => {
|
||||
Name => 'GPSTrackRef',
|
||||
Writable => 'string',
|
||||
Count => 2,
|
||||
PrintConv => {
|
||||
M => 'Magnetic North',
|
||||
T => 'True North',
|
||||
},
|
||||
},
|
||||
0x000f => {
|
||||
Name => 'GPSTrack',
|
||||
Writable => 'rational64u',
|
||||
},
|
||||
0x0010 => {
|
||||
Name => 'GPSImgDirectionRef',
|
||||
Writable => 'string',
|
||||
Count => 2,
|
||||
PrintConv => {
|
||||
M => 'Magnetic North',
|
||||
T => 'True North',
|
||||
},
|
||||
},
|
||||
0x0011 => {
|
||||
Name => 'GPSImgDirection',
|
||||
Writable => 'rational64u',
|
||||
},
|
||||
0x0012 => {
|
||||
Name => 'GPSMapDatum',
|
||||
Writable => 'string',
|
||||
},
|
||||
0x0013 => {
|
||||
Name => 'GPSDestLatitudeRef',
|
||||
Writable => 'string',
|
||||
Notes => 'tags 0x0013-0x001a used for subject location according to MWG 2.0',
|
||||
Count => 2,
|
||||
PrintConv => { N => 'North', S => 'South' },
|
||||
},
|
||||
0x0014 => {
|
||||
Name => 'GPSDestLatitude',
|
||||
Writable => 'rational64u',
|
||||
Count => 3,
|
||||
%coordConv,
|
||||
},
|
||||
0x0015 => {
|
||||
Name => 'GPSDestLongitudeRef',
|
||||
Writable => 'string',
|
||||
Count => 2,
|
||||
PrintConv => { E => 'East', W => 'West' },
|
||||
},
|
||||
0x0016 => {
|
||||
Name => 'GPSDestLongitude',
|
||||
Writable => 'rational64u',
|
||||
Count => 3,
|
||||
%coordConv,
|
||||
},
|
||||
0x0017 => {
|
||||
Name => 'GPSDestBearingRef',
|
||||
Writable => 'string',
|
||||
Count => 2,
|
||||
PrintConv => {
|
||||
M => 'Magnetic North',
|
||||
T => 'True North',
|
||||
},
|
||||
},
|
||||
0x0018 => {
|
||||
Name => 'GPSDestBearing',
|
||||
Writable => 'rational64u',
|
||||
},
|
||||
0x0019 => {
|
||||
Name => 'GPSDestDistanceRef',
|
||||
Writable => 'string',
|
||||
Count => 2,
|
||||
PrintConv => {
|
||||
K => 'Kilometers',
|
||||
M => 'Miles',
|
||||
N => 'Nautical Miles',
|
||||
},
|
||||
},
|
||||
0x001a => {
|
||||
Name => 'GPSDestDistance',
|
||||
Writable => 'rational64u',
|
||||
},
|
||||
0x001b => {
|
||||
Name => 'GPSProcessingMethod',
|
||||
Writable => 'undef',
|
||||
Notes => 'values of "GPS", "CELLID", "WLAN" or "MANUAL" by the EXIF spec.',
|
||||
RawConv => 'Image::ExifTool::Exif::ConvertExifText($self,$val,1,$tag)',
|
||||
RawConvInv => 'Image::ExifTool::Exif::EncodeExifText($self,$val)',
|
||||
},
|
||||
0x001c => {
|
||||
Name => 'GPSAreaInformation',
|
||||
Writable => 'undef',
|
||||
RawConv => 'Image::ExifTool::Exif::ConvertExifText($self,$val,1,$tag)',
|
||||
RawConvInv => 'Image::ExifTool::Exif::EncodeExifText($self,$val)',
|
||||
},
|
||||
0x001d => {
|
||||
Name => 'GPSDateStamp',
|
||||
Groups => { 2 => 'Time' },
|
||||
Writable => 'string',
|
||||
Format => 'undef', # (Casio EX-H20G uses "\0" instead of ":" as a separator)
|
||||
Count => 11,
|
||||
Shift => 'Time',
|
||||
Notes => q{
|
||||
when writing, time is stripped off if present, after adjusting date/time to
|
||||
UTC if time includes a timezone. Format is YYYY:mm:dd
|
||||
},
|
||||
RawConv => '$val =~ s/\0+$//; $val',
|
||||
ValueConv => 'Image::ExifTool::Exif::ExifDate($val)',
|
||||
ValueConvInv => '$val',
|
||||
# pull date out of any format date/time string
|
||||
# (and adjust to UTC if this is a full date/time/timezone value)
|
||||
PrintConvInv => q{
|
||||
my $secs;
|
||||
$val = $self->TimeNow() if lc($val) eq 'now';
|
||||
if ($val =~ /[-+]/ and ($secs = Image::ExifTool::GetUnixTime($val, 1))) {
|
||||
$val = Image::ExifTool::ConvertUnixTime($secs);
|
||||
}
|
||||
return $val =~ /(\d{4}).*?(\d{2}).*?(\d{2})/ ? "$1:$2:$3" : undef;
|
||||
},
|
||||
},
|
||||
0x001e => {
|
||||
Name => 'GPSDifferential',
|
||||
Writable => 'int16u',
|
||||
PrintConv => {
|
||||
0 => 'No Correction',
|
||||
1 => 'Differential Corrected',
|
||||
},
|
||||
},
|
||||
0x001f => {
|
||||
Name => 'GPSHPositioningError',
|
||||
Description => 'GPS Horizontal Positioning Error',
|
||||
PrintConv => '"$val m"',
|
||||
PrintConvInv => '$val=~s/\s*m$//; $val',
|
||||
Writable => 'rational64u',
|
||||
},
|
||||
# 0xea1c - Nokia Lumina 1020, Samsung GT-I8750, and other Windows 8
|
||||
# phones write this (padding) in GPS IFD - PH
|
||||
);
|
||||
|
||||
# Composite GPS tags
|
||||
%Image::ExifTool::GPS::Composite = (
|
||||
GROUPS => { 2 => 'Location' },
|
||||
GPSDateTime => {
|
||||
Description => 'GPS Date/Time',
|
||||
Groups => { 2 => 'Time' },
|
||||
SubDoc => 1, # generate for all sub-documents
|
||||
Require => {
|
||||
0 => 'GPS:GPSDateStamp',
|
||||
1 => 'GPS:GPSTimeStamp',
|
||||
},
|
||||
ValueConv => '"$val[0] $val[1]Z"',
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
# Note: The following tags are used by other modules
|
||||
# which must therefore require this module as necessary
|
||||
GPSLatitude => {
|
||||
SubDoc => 1, # generate for all sub-documents
|
||||
Require => {
|
||||
0 => 'GPS:GPSLatitude',
|
||||
1 => 'GPS:GPSLatitudeRef',
|
||||
},
|
||||
ValueConv => '$val[1] =~ /^S/i ? -$val[0] : $val[0]',
|
||||
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "N")',
|
||||
},
|
||||
GPSLongitude => {
|
||||
SubDoc => 1, # generate for all sub-documents
|
||||
Require => {
|
||||
0 => 'GPS:GPSLongitude',
|
||||
1 => 'GPS:GPSLongitudeRef',
|
||||
},
|
||||
ValueConv => '$val[1] =~ /^W/i ? -$val[0] : $val[0]',
|
||||
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "E")',
|
||||
},
|
||||
GPSAltitude => {
|
||||
SubDoc => [1,3], # generate for sub-documents if Desire 1 or 3 has a chance to exist
|
||||
Desire => {
|
||||
0 => 'GPS:GPSAltitude',
|
||||
1 => 'GPS:GPSAltitudeRef',
|
||||
2 => 'XMP:GPSAltitude',
|
||||
3 => 'XMP:GPSAltitudeRef',
|
||||
},
|
||||
# Require either GPS:GPSAltitudeRef or XMP:GPSAltitudeRef
|
||||
RawConv => '(defined $val[1] or defined $val[3]) ? $val : undef',
|
||||
ValueConv => q{
|
||||
my $alt = $val[0];
|
||||
$alt = $val[2] unless defined $alt;
|
||||
return undef unless defined $alt and IsFloat($alt);
|
||||
return ($val[1] || $val[3]) ? -$alt : $alt;
|
||||
},
|
||||
PrintConv => q{
|
||||
$val = int($val * 10) / 10;
|
||||
return ($val =~ s/^-// ? "$val m Below" : "$val m Above") . " Sea Level";
|
||||
},
|
||||
},
|
||||
GPSDestLatitude => {
|
||||
Require => {
|
||||
0 => 'GPS:GPSDestLatitude',
|
||||
1 => 'GPS:GPSDestLatitudeRef',
|
||||
},
|
||||
ValueConv => '$val[1] =~ /^S/i ? -$val[0] : $val[0]',
|
||||
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "N")',
|
||||
},
|
||||
GPSDestLongitude => {
|
||||
SubDoc => 1, # generate for all sub-documents
|
||||
Require => {
|
||||
0 => 'GPS:GPSDestLongitude',
|
||||
1 => 'GPS:GPSDestLongitudeRef',
|
||||
},
|
||||
ValueConv => '$val[1] =~ /^W/i ? -$val[0] : $val[0]',
|
||||
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "E")',
|
||||
},
|
||||
);
|
||||
|
||||
# add our composite tags
|
||||
Image::ExifTool::AddCompositeTags('Image::ExifTool::GPS');
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Convert GPS timestamp value
|
||||
# Inputs: 0) raw timestamp value string
|
||||
# Returns: EXIF-formatted time string
|
||||
sub ConvertTimeStamp($)
|
||||
{
|
||||
my $val = shift;
|
||||
my ($h,$m,$s) = split ' ', $val;
|
||||
my $f = (($h || 0) * 60 + ($m || 0)) * 60 + ($s || 0);
|
||||
$h = int($f / 3600); $f -= $h * 3600;
|
||||
$m = int($f / 60); $f -= $m * 60;
|
||||
$s = int($f); $f -= $s;
|
||||
$f = int($f * 1000000000 + 0.5);
|
||||
if ($f) {
|
||||
($f = sprintf(".%.9d", $f)) =~ s/0+$//;
|
||||
} else {
|
||||
$f = ''
|
||||
}
|
||||
return sprintf("%.2d:%.2d:%.2d%s",$h,$m,$s,$f);
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Print GPS timestamp
|
||||
# Inputs: 0) EXIF-formatted time string
|
||||
# Returns: time rounded to the nearest microsecond
|
||||
sub PrintTimeStamp($)
|
||||
{
|
||||
my $val = shift;
|
||||
return $val unless $val =~ s/:(\d{2}\.\d+)$//;
|
||||
my $s = int($1 * 1000000 + 0.5) / 1000000;
|
||||
$s = "0$s" if $s < 10;
|
||||
return "${val}:$s";
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Convert degrees to DMS, or whatever the current settings are
|
||||
# Inputs: 0) ExifTool reference, 1) Value in degrees,
|
||||
# 2) format code (0=no format, 1=CoordFormat, 2=XMP format)
|
||||
# 3) 'N' or 'E' if sign is significant and N/S/E/W should be added
|
||||
# Returns: DMS string
|
||||
sub ToDMS($$;$$)
|
||||
{
|
||||
my ($et, $val, $doPrintConv, $ref) = @_;
|
||||
my ($fmt, @fmt, $num, $sign);
|
||||
|
||||
unless (length $val) {
|
||||
# don't convert an empty value
|
||||
return $val if $doPrintConv and $doPrintConv eq 1; # avoid hiding existing tag when extracting
|
||||
return undef; # avoid writing empty value
|
||||
}
|
||||
if ($ref) {
|
||||
if ($val < 0) {
|
||||
$val = -$val;
|
||||
$ref = {N => 'S', E => 'W'}->{$ref};
|
||||
$sign = '-';
|
||||
} else {
|
||||
$sign = '+';
|
||||
}
|
||||
$ref = " $ref" unless $doPrintConv and $doPrintConv eq '2';
|
||||
} else {
|
||||
$val = abs($val);
|
||||
$ref = '';
|
||||
}
|
||||
if ($doPrintConv) {
|
||||
if ($doPrintConv eq '1') {
|
||||
$fmt = $et->Options('CoordFormat');
|
||||
if (not $fmt) {
|
||||
$fmt = q{%d deg %d' %.2f"} . $ref;
|
||||
} elsif ($ref) {
|
||||
# use signed value instead of reference direction if specified
|
||||
$fmt =~ s/%\+/$sign%/g or $fmt .= $ref;
|
||||
} else {
|
||||
$fmt =~ s/%\+/%/g; # don't know sign, so don't print it
|
||||
}
|
||||
} else {
|
||||
$fmt = "%d,%.6f$ref"; # use XMP standard format
|
||||
}
|
||||
# count (and capture) the format specifiers (max 3)
|
||||
while ($fmt =~ /(%(%|[^%]*?[diouxXDOUeEfFgGcs]))/g) {
|
||||
next if $1 eq '%%';
|
||||
push @fmt, $1;
|
||||
last if @fmt >= 3;
|
||||
}
|
||||
$num = scalar @fmt;
|
||||
} else {
|
||||
$num = 3;
|
||||
}
|
||||
my @c; # coordinates (D) or (D,M) or (D,M,S)
|
||||
$c[0] = $val;
|
||||
if ($num > 1) {
|
||||
$c[0] = int($c[0]);
|
||||
$c[1] = ($val - $c[0]) * 60;
|
||||
if ($num > 2) {
|
||||
$c[1] = int($c[1]);
|
||||
$c[2] = ($val - $c[0] - $c[1] / 60) * 3600;
|
||||
}
|
||||
# handle round-off errors to ensure minutes and seconds are
|
||||
# less than 60 (eg. convert "72 59 60.00" to "73 0 0.00")
|
||||
$c[-1] = $doPrintConv ? sprintf($fmt[-1], $c[-1]) : ($c[-1] . '');
|
||||
if ($c[-1] >= 60) {
|
||||
$c[-1] -= 60;
|
||||
($c[-2] += 1) >= 60 and $num > 2 and $c[-2] -= 60, $c[-3] += 1;
|
||||
}
|
||||
}
|
||||
return $doPrintConv ? sprintf($fmt, @c) : "@c$ref";
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Convert to decimal degrees
|
||||
# Inputs: 0) a string containing 1-3 decimal numbers and any amount of other garbage
|
||||
# 1) true if value should be negative if coordinate ends in 'S' or 'W'
|
||||
# Returns: Coordinate in degrees
|
||||
sub ToDegrees($;$)
|
||||
{
|
||||
my ($val, $doSign) = @_;
|
||||
# extract decimal or floating point values out of any other garbage
|
||||
my ($d, $m, $s) = ($val =~ /((?:[+-]?)(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee][+-]\d+)?)/g);
|
||||
return '' unless defined $d;
|
||||
my $deg = $d + (($m || 0) + ($s || 0)/60) / 60;
|
||||
# make negative if S or W coordinate
|
||||
$deg = -$deg if $doSign ? $val =~ /[^A-Z](S|W)$/i : $deg < 0;
|
||||
return $deg;
|
||||
}
|
||||
|
||||
|
||||
1; #end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::GPS - EXIF GPS meta information tags
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is loaded automatically by Image::ExifTool when required.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to interpret
|
||||
GPS (Global Positioning System) meta information in EXIF data.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<Image::Info|Image::Info>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/GPS Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>,
|
||||
L<Image::Info(3pm)|Image::Info>
|
||||
|
||||
=cut
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,709 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: GoPro.pm
|
||||
#
|
||||
# Description: Read information from GoPro videos
|
||||
#
|
||||
# Revisions: 2018/01/12 - P. Harvey Created
|
||||
#
|
||||
# References: 1) https://github.com/gopro/gpmf-parser
|
||||
# 2) https://github.com/stilldavid/gopro-utils
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::GoPro;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
use Image::ExifTool::QuickTime;
|
||||
|
||||
$VERSION = '1.02';
|
||||
|
||||
sub ProcessGoPro($$$);
|
||||
sub ProcessString($$$);
|
||||
sub ScaleValues($$);
|
||||
sub AddUnits($$$);
|
||||
sub ConvertSystemTime($$);
|
||||
|
||||
# GoPro data types that have ExifTool equivalents (ref 1)
|
||||
my %goProFmt = ( # format codes
|
||||
# 0x00 - container (subdirectory)
|
||||
0x62 => 'int8s', # 'b'
|
||||
0x42 => 'int8u', # 'B'
|
||||
0x63 => 'string', # 'c' (possibly null terminated)
|
||||
0x73 => 'int16s', # 's'
|
||||
0x53 => 'int16u', # 'S'
|
||||
0x6c => 'int32s', # 'l'
|
||||
0x4c => 'int32u', # 'L'
|
||||
0x66 => 'float', # 'f'
|
||||
0x64 => 'double', # 'd'
|
||||
0x46 => 'undef', # 'F' (4-char ID)
|
||||
0x47 => 'undef', # 'G' (16-byte uuid)
|
||||
0x6a => 'int64s', # 'j'
|
||||
0x4a => 'int64u', # 'J'
|
||||
0x71 => 'fixed32s', # 'q'
|
||||
0x51 => 'fixed64s', # 'Q'
|
||||
0x55 => 'undef', # 'U' (16-byte date)
|
||||
0x3f => 'undef', # '?' (complex structure)
|
||||
);
|
||||
|
||||
# sizes of format codes if different than what FormatSize() would return
|
||||
my %goProSize = (
|
||||
0x46 => 4,
|
||||
0x47 => 16,
|
||||
0x55 => 16,
|
||||
);
|
||||
|
||||
# tagInfo elements to add units to PrintConv value
|
||||
my %addUnits = (
|
||||
AddUnits => 1,
|
||||
PrintConv => 'Image::ExifTool::GoPro::AddUnits($self, $val, $tag)',
|
||||
);
|
||||
|
||||
# Tags found in the GPMF box of Hero6 mp4 videos (ref PH), and
|
||||
# the gpmd-format timed metadata of Hero5 and Hero6 videos (ref 1)
|
||||
%Image::ExifTool::GoPro::GPMF = (
|
||||
PROCESS_PROC => \&ProcessGoPro,
|
||||
GROUPS => { 2 => 'Camera' },
|
||||
NOTES => q{
|
||||
Tags extracted from the GPMF box of GoPro MP4 videos, the APP6 "GoPro" segment
|
||||
of JPEG files, and from the "gpmd" timed metadata if the ExtractEmbedded option
|
||||
is enabled. Many more tags exist, but are currently unknown and extracted only
|
||||
with the -u option. Please let me know if you discover the meaning of any of
|
||||
these unknown tags. See L<https://github.com/gopro/gpmf-parser> for details
|
||||
about this format.
|
||||
},
|
||||
ACCL => { #2 (gpmd)
|
||||
Name => 'Accelerometer',
|
||||
Notes => 'accelerator readings in m/s',
|
||||
Binary => 1,
|
||||
},
|
||||
ALLD => 'AutoLowLightDuration', #1 (gpmd) (untested)
|
||||
# APTO (GPMF) - seen: 'RAW' (fmt c)
|
||||
ATTD => { #PH (Karma)
|
||||
Name => 'Attitude',
|
||||
# UNIT=s,rad,rad,rad,rad/s,rad/s,rad/s,
|
||||
# TYPE=LffffffB
|
||||
# SCAL=1000 1 1 1 1 1 1 1
|
||||
Binary => 1,
|
||||
},
|
||||
ATTR => { #PH (Karma)
|
||||
Name => 'AttitudeTarget',
|
||||
# UNIT=s,rad,rad,rad,
|
||||
# TYPE=Jffff
|
||||
# SCAL=1000 1 1 1 1
|
||||
Binary => 1,
|
||||
},
|
||||
AUDO => 'AudioSetting', #PH (GPMF - seen: 'WIND', fmt c)
|
||||
# AUPT (GPMF) - seen: 'N' (fmt c)
|
||||
BPOS => { #PH (Karma)
|
||||
Name => 'Controller',
|
||||
Unknown => 1,
|
||||
# UNIT=deg,deg,m,deg,deg,m,m,m
|
||||
# TYPE=lllfffff
|
||||
# SCAL=10000000 10000000 1000 1 1 1 1 1
|
||||
%addUnits,
|
||||
},
|
||||
# BRID (GPMF) - seen: 0 (fmt B)
|
||||
# BROD (GPMF) - seen: 'ASK' (fmt c)
|
||||
CASN => 'CameraSerialNumber', #PH (GPMF - seen: 'C3221324545448', fmt c)
|
||||
# CINF (GPMF) - seen: 0x67376be7709bc8876a8baf3940908618 (fmt B)
|
||||
# CMOD (GPMF) - seen: 12,13,17 [13 time-laps video, 17 JPEG] (fmt B)
|
||||
CYTS => { #PH (Karma)
|
||||
Name => 'CoyoteStatus',
|
||||
# UNIT=s,,,,,rad,rad,rad,,
|
||||
# TYPE=LLLLLfffBB
|
||||
# SCAL=1000 1 1 1 1 1 1 1 1 1
|
||||
Binary => 1,
|
||||
},
|
||||
CSEN => { #PH (Karma)
|
||||
Name => 'CoyoteSense',
|
||||
# UNIT=s,rad/s,rad/s,rad/s,g,g,g,,,,
|
||||
# TYPE=LffffffLLLL
|
||||
# SCAL=1000 1 1 1 1 1 1 1 1 1 1
|
||||
Binary => 1,
|
||||
},
|
||||
DEVC => { #PH (gpmd,GPMF, fmt \0)
|
||||
Name => 'DeviceContainer',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::GoPro::GPMF' },
|
||||
},
|
||||
# DVID (GPMF) - DeviceID; seen: 1 (fmt L), HLMT (fmt F)
|
||||
DVID => { Name => 'DeviceID', Unknown => 1 }, #2 (gpmd)
|
||||
# DVNM (GPMF) seen: 'Video Global Settings' (fmt c), 'Highlights' (fmt c)
|
||||
# DVNM (gpmd) seen: 'Camera' (Hero5), 'Hero6 Black' (Hero6), 'GoPro Karma v1.0' (Karma)
|
||||
DVNM => 'DeviceName', #PH
|
||||
DZOM => { #PH (GPMF - seen: 'Y', fmt c)
|
||||
Name => 'DigitalZoom',
|
||||
PrintConv => { N => 'No', Y => 'Yes' },
|
||||
},
|
||||
# DZST (GPMF) - seen: 0 (fmt L) (something to do with digital zoom maybe?)
|
||||
# EISA (GPMF) - seen: 'Y','N' [N was for a time-lapse video] (fmt c)
|
||||
# EISE (GPMF) - seen: 'Y' (fmt c)
|
||||
EMPT => { Name => 'Empty', Unknown => 1 }, #2 (gpmd)
|
||||
ESCS => { #PH (Karma)
|
||||
Name => 'EscapeStatus',
|
||||
# UNIT=s,rpm,rpm,rpm,rpm,rpm,rpm,rpm,rpm,degC,degC,degC,degC,V,V,V,V,A,A,A,A,,,,,,,,,
|
||||
# TYPE=JSSSSSSSSssssSSSSSSSSSSSSSSSSB
|
||||
# (no SCAL!)
|
||||
Unknown => 1,
|
||||
%addUnits,
|
||||
},
|
||||
# EXPT (GPMF) - seen: '' (fmt c)
|
||||
FACE => 'FaceDetected', #PH (gpmd)
|
||||
FCNM => 'FaceNumbers', #PH (gpmd) (faces counted per frame, ref 1)
|
||||
FMWR => 'FirmwareVersion', #PH (GPMF - seen: HD6.01.01.51.00, fmt c)
|
||||
FWVS => 'OtherFirmware', #PH (NC) (gpmd - seen: '1.1.11.0', Karma)
|
||||
GLPI => { #PH (gpmd, Karma)
|
||||
Name => 'GPSPos',
|
||||
# UNIT=s,deg,deg,m,m,m/s,m/s,m/s,deg
|
||||
# TYPE=LllllsssS
|
||||
# SCAL=1000 10000000 10000000 1000 1000 100 100 100 100
|
||||
RawConv => '$val', # necessary to use scaled value instead of raw data as subdir data
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::GoPro::GLPI' },
|
||||
},
|
||||
GPRI => { #PH (gpmd, Karma)
|
||||
Name => 'GPSRaw',
|
||||
# UNIT=s,deg,deg,m,m,m,m/s,deg,,
|
||||
# TYPE=JlllSSSSBB
|
||||
# SCAL=1000000,10000000,10000000,1000,100,100,100,100,1,1
|
||||
Unknown => 1,
|
||||
RawConv => '$val', # necessary to use scaled value instead of raw data as subdir data
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::GoPro::GPRI' },
|
||||
},
|
||||
GPS5 => { #2 (gpmd)
|
||||
Name => 'GPSInfo',
|
||||
# SCAL=10000000,10000000,1000,1000,100
|
||||
RawConv => '$val', # necessary to use scaled value instead of raw data as subdir data
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::GoPro::GPS5' },
|
||||
},
|
||||
GPSF => { #2 (gpmd)
|
||||
Name => 'GPSMeasureMode',
|
||||
PrintConv => {
|
||||
2 => '2-Dimensional Measurement',
|
||||
3 => '3-Dimensional Measurement',
|
||||
},
|
||||
},
|
||||
GPSP => { #2 (gpmd)
|
||||
Name => 'GPSHPositioningError',
|
||||
Description => 'GPS Horizontal Positioning Error',
|
||||
ValueConv => '$val / 100', # convert from cm to m
|
||||
},
|
||||
GPSU => { #2 (gpmd)
|
||||
Name => 'GPSDateTime',
|
||||
Groups => { 2 => 'Time' },
|
||||
# (HERO5 writes this in 'c' format, HERO6 writes 'U')
|
||||
ValueConv => '$val =~ s/^(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/20$1:$2:$3 $4:$5:/; $val',
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
GYRO => { #2 (gpmd)
|
||||
Name => 'Gyroscope',
|
||||
Notes => 'gyroscope readings in rad/s',
|
||||
Binary => 1,
|
||||
},
|
||||
# HFLG (APP6) - seen: 0
|
||||
ISOE => 'ISOSpeeds', #PH (gpmd)
|
||||
ISOG => { #2 (gpmd)
|
||||
Name => 'ImageSensorGain',
|
||||
Binary => 1,
|
||||
},
|
||||
KBAT => { #PH (gpmd) (Karma)
|
||||
Name => 'BatteryStatus',
|
||||
# UNIT=A,Ah,J,degC,V,V,V,V,s,%,,,,,%
|
||||
# TYPE=lLlsSSSSSSSBBBb
|
||||
# SCAL=1000,1000,0.00999999977648258,100,1000,1000,1000,1000,0.0166666675359011,1,1,1,1,1,1
|
||||
RawConv => '$val', # necessary to use scaled value instead of raw data as subdir data
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::GoPro::KBAT' },
|
||||
},
|
||||
# LINF (GPMF) - seen: LAJ7061916601668 (fmt c)
|
||||
LNED => { #PH (Karma)
|
||||
Name => 'LocalPositionNED',
|
||||
# UNIT=s,m,m,m,m/s,m/s,m/s
|
||||
# TYPE=Lffffff
|
||||
# SCAL=1000 1 1 1 1 1 1
|
||||
Binary => 1,
|
||||
},
|
||||
MAGN => 'Magnetometer', #1 (gpmd) (units of uT)
|
||||
MINF => { #PH (GPMF - seen: HERO6 Black, fmt c)
|
||||
Name => 'Model',
|
||||
Groups => { 2 => 'Camera' },
|
||||
Description => 'Camera Model Name',
|
||||
},
|
||||
# MTYP (GPMF) - seen: 0,1,11 [1 for time-lapse video, 11 for JPEG] (fmt B)
|
||||
# MUID (GPMF) - seen: 3882563431 2278071152 967805802 411471936 0 0 0 0 (fmt L)
|
||||
OREN => { #PH (GPMF - seen: 'U', fmt c)
|
||||
Name => 'AutoRotation',
|
||||
PrintConv => {
|
||||
U => 'Up',
|
||||
D => 'Down', # (NC)
|
||||
A => 'Auto', # (NC)
|
||||
},
|
||||
},
|
||||
# (most of the "P" tags are ProTune settings - PH)
|
||||
PHDR => 'HDRSetting', #PH (APP6 - seen: 0)
|
||||
PIMN => 'AutoISOMin', #PH (GPMF - seen: 100, fmt L)
|
||||
PIMX => 'AutoISOMax', #PH (GPMF - seen: 1600, fmt L)
|
||||
# PRAW (APP6) - seen: 0
|
||||
PRES => 'PhotoResolution', #PH (APP6 - seen: '12MP_W')
|
||||
PRTN => { #PH (GPMF - seen: 'N', fmt c)
|
||||
Name => 'ProTune',
|
||||
PrintConv => {
|
||||
N => 'Off',
|
||||
Y => 'On', # (NC)
|
||||
},
|
||||
},
|
||||
PTCL => 'ColorMode', #PH (GPMF - seen: 'GOPRO', fmt c' APP6: 'FLAT')
|
||||
PTEV => 'ExposureCompensation', #PH (GPMF - seen: '0.0', fmt c)
|
||||
PTSH => 'Sharpness', #PH (GPMF - seen: 'HIGH', fmt c)
|
||||
PTWB => 'WhiteBalance', #PH (GPMF - seen: 'AUTO', fmt c)
|
||||
RATE => 'Rate', #PH (GPMF - seen: '0_5SEC', fmt c; APP6 - seen: '4_1SEC')
|
||||
RMRK => { #2 (gpmd)
|
||||
Name => 'Comments',
|
||||
ValueConv => '$self->Decode($val, "Latin")',
|
||||
},
|
||||
SCAL => { #2 (gpmd) scale factor for subsequent data
|
||||
Name => 'ScaleFactor',
|
||||
Unknown => 1,
|
||||
},
|
||||
SCPR => { #PH (Karma) [stream was empty]
|
||||
Name => 'ScaledPressure',
|
||||
# UNIT=s,Pa,Pa,degC
|
||||
# TYPE=Lffs
|
||||
# SCAL=1000 0.00999999977648258 0.00999999977648258 100
|
||||
%addUnits,
|
||||
},
|
||||
SHUT => { #2 (gpmd)
|
||||
Name => 'ExposureTimes',
|
||||
PrintConv => q{
|
||||
my @a = split ' ', $val;
|
||||
$_ = Image::ExifTool::Exif::PrintExposureTime($_) foreach @a;
|
||||
return join ' ', @a;
|
||||
},
|
||||
},
|
||||
SIMU => { #PH (Karma)
|
||||
Name => 'ScaledIMU',
|
||||
# UNIT=s,g,g,g,rad/s,rad/s,rad/s,T,T,T
|
||||
# TYPE=Lsssssssss
|
||||
# SCAL=1000 1000 1000 1000 1000 1000 1000 1000 1000 1000
|
||||
%addUnits,
|
||||
},
|
||||
SIUN => { #2 (gpmd - seen : 'm/s2','rad/s')
|
||||
Name => 'SIUnits',
|
||||
Unknown => 1,
|
||||
ValueConv => '$self->Decode($val, "Latin")',
|
||||
},
|
||||
# SMTR (GPMF) - seen: 'N' (fmt c)
|
||||
STMP => { #1 (gpmd)
|
||||
Name => 'TimeStamp',
|
||||
ValueConv => '$val / 1e6',
|
||||
},
|
||||
STRM => { #2 (gpmd,GPMF, fmt \0)
|
||||
Name => 'NestedSignalStream',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::GoPro::GPMF' },
|
||||
},
|
||||
STNM => { #2 (gpmd)
|
||||
Name => 'StreamName',
|
||||
Unknown => 1,
|
||||
ValueConv => '$self->Decode($val, "Latin")',
|
||||
},
|
||||
SYST => { #PH (Karma)
|
||||
Name => 'SystemTime',
|
||||
# UNIT=s,s
|
||||
# TYPE=JJ
|
||||
# SCAL=1000000 1000
|
||||
# save system time calibrations for later
|
||||
RawConv => q{
|
||||
my @v = split ' ', $val;
|
||||
if (@v == 2) {
|
||||
my $s = $$self{SystemTimeList};
|
||||
$s or $s = $$self{SystemTimeList} = [ ];
|
||||
push @$s, \@v;
|
||||
}
|
||||
return $val;
|
||||
},
|
||||
},
|
||||
# TICK => { Name => 'InTime', Unknown => 1, ValueConv => '$val/1000' }, #1 (gpmd)
|
||||
TMPC => { #2 (gpmd)
|
||||
Name => 'CameraTemperature',
|
||||
PrintConv => '"$val C"',
|
||||
},
|
||||
# TOCK => { Name => 'OutTime', Unknown => 1, ValueConv => '$val/1000' }, #1 (gpmd)
|
||||
TSMP => { Name => 'TotalSamples', Unknown => 1 }, #2 (gpmd)
|
||||
TYPE => { Name => 'StructureType', Unknown => 1 }, #2 (gpmd,GPMF - eg 'LLLllfFff', fmt c)
|
||||
UNIT => { #2 (gpmd) alternative units
|
||||
Name => 'Units',
|
||||
Unknown => 1,
|
||||
ValueConv => '$self->Decode($val, "Latin")',
|
||||
},
|
||||
VFOV => { #PH (GPMF - seen: 'W', fmt c)
|
||||
Name => 'FieldOfView',
|
||||
PrintConv => {
|
||||
W => 'Wide',
|
||||
S => 'Super View', # (NC, not seen)
|
||||
L => 'Linear', # (NC, not seen)
|
||||
},
|
||||
},
|
||||
# VLTA (GPMF) - seen: 78 ('N') (fmt B -- wrong format?)
|
||||
VFRH => { #PH (Karma)
|
||||
Name => 'VisualFlightRulesHUD',
|
||||
BinaryData => 1,
|
||||
# UNIT=m/s,m/s,m,m/s,deg,%
|
||||
# TYPE=ffffsS
|
||||
},
|
||||
# VLTE (GPMF) - seen: 'Y' (fmt c)
|
||||
WBAL => 'ColorTemperatures', #PH (gpmd)
|
||||
WRGB => { #PH (gpmd)
|
||||
Name => 'WhiteBalanceRGB',
|
||||
Binary => 1,
|
||||
},
|
||||
);
|
||||
|
||||
# GoPro GPS5 tags (ref 2) (Hero5,Hero6)
|
||||
%Image::ExifTool::GoPro::GPS5 = (
|
||||
PROCESS_PROC => \&ProcessString,
|
||||
GROUPS => { 1 => 'GoPro', 2 => 'Location' },
|
||||
VARS => { HEX_ID => 0, ID_LABEL => 'Index' },
|
||||
0 => { # (unit='deg')
|
||||
Name => 'GPSLatitude',
|
||||
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "N")',
|
||||
},
|
||||
1 => { # (unit='deg')
|
||||
Name => 'GPSLongitude',
|
||||
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "E")',
|
||||
},
|
||||
2 => { # (unit='m')
|
||||
Name => 'GPSAltitude',
|
||||
PrintConv => '"$val m"',
|
||||
},
|
||||
3 => 'GPSSpeed', # (unit='m/s')
|
||||
4 => 'GPSSpeed3D', # (unit='m/s')
|
||||
);
|
||||
|
||||
# GoPro GPRI tags (ref PH) (Karma)
|
||||
%Image::ExifTool::GoPro::GPRI = (
|
||||
PROCESS_PROC => \&ProcessString,
|
||||
GROUPS => { 1 => 'GoPro', 2 => 'Location' },
|
||||
VARS => { HEX_ID => 0, ID_LABEL => 'Index' },
|
||||
0 => { # (unit='s')
|
||||
Name => 'GPSDateTimeRaw',
|
||||
Groups => { 2 => 'Time' },
|
||||
ValueConv => \&ConvertSystemTime, # convert to date/time based on SystemTime clock
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
1 => { # (unit='deg')
|
||||
Name => 'GPSLatitudeRaw',
|
||||
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "N")',
|
||||
},
|
||||
2 => { # (unit='deg')
|
||||
Name => 'GPSLongitudeRaw',
|
||||
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "E")',
|
||||
},
|
||||
3 => {
|
||||
Name => 'GPSAltitudeRaw', # (NC)
|
||||
PrintConv => '"$val m"',
|
||||
},
|
||||
# (unknown tags must be defined so that ProcessString() will iterate through all values)
|
||||
4 => { Name => 'GPRI_Unknown4', Unknown => 1, Hidden => 1, PrintConv => '"$val m"' },
|
||||
5 => { Name => 'GPRI_Unknown5', Unknown => 1, Hidden => 1, PrintConv => '"$val m"' },
|
||||
6 => 'GPSSpeedRaw', # (NC) # (unit='m/s' -- should convert to other units?)
|
||||
7 => 'GPSTrackRaw', # (NC) # (unit='deg')
|
||||
8 => { Name => 'GPRI_Unknown8', Unknown => 1, Hidden => 1 }, # (no units)
|
||||
9 => { Name => 'GPRI_Unknown9', Unknown => 1, Hidden => 1 }, # (no units)
|
||||
);
|
||||
|
||||
# GoPro GLPI tags (ref PH) (Karma)
|
||||
%Image::ExifTool::GoPro::GLPI = (
|
||||
PROCESS_PROC => \&ProcessString,
|
||||
GROUPS => { 1 => 'GoPro', 2 => 'Location' },
|
||||
VARS => { HEX_ID => 0, ID_LABEL => 'Index' },
|
||||
0 => { # (unit='s')
|
||||
Name => 'GPSDateTime',
|
||||
Groups => { 2 => 'Time' },
|
||||
ValueConv => \&ConvertSystemTime, # convert to date/time based on SystemTime clock
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
1 => { # (unit='deg')
|
||||
Name => 'GPSLatitude',
|
||||
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "N")',
|
||||
},
|
||||
2 => { # (unit='deg')
|
||||
Name => 'GPSLongitude',
|
||||
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "E")',
|
||||
},
|
||||
3 => { # (unit='m')
|
||||
Name => 'GPSAltitude', # (NC)
|
||||
PrintConv => '"$val m"',
|
||||
},
|
||||
# (unknown tags must be defined so that ProcessString() will iterate through all values)
|
||||
4 => { Name => 'GLPI_Unknown4', Unknown => 1, Hidden => 1, PrintConv => '"$val m"' },
|
||||
5 => { Name => 'GPSSpeedX', PrintConv => '"$val m/s"' }, # (NC)
|
||||
6 => { Name => 'GPSSpeedY', PrintConv => '"$val m/s"' }, # (NC)
|
||||
7 => { Name => 'GPSSpeedZ', PrintConv => '"$val m/s"' }, # (NC)
|
||||
8 => { Name => 'GPSTrack' }, # (unit='deg')
|
||||
);
|
||||
|
||||
# GoPro KBAT tags (ref PH)
|
||||
%Image::ExifTool::GoPro::KBAT = (
|
||||
PROCESS_PROC => \&ProcessString,
|
||||
GROUPS => { 1 => 'GoPro', 2 => 'Camera' },
|
||||
VARS => { HEX_ID => 0, ID_LABEL => 'Index' },
|
||||
NOTES => 'Battery status information found in GoPro Karma videos.',
|
||||
0 => { Name => 'BatteryCurrent', PrintConv => '"$val A"' },
|
||||
1 => { Name => 'BatteryCapacity', PrintConv => '"$val Ah"' },
|
||||
2 => { Name => 'KBAT_Unknown2', PrintConv => '"$val J"', Unknown => 1, Hidden => 1 },
|
||||
3 => { Name => 'BatteryTemperature', PrintConv => '"$val C"' },
|
||||
4 => { Name => 'BatteryVoltage1', PrintConv => '"$val V"' },
|
||||
5 => { Name => 'BatteryVoltage2', PrintConv => '"$val V"' },
|
||||
6 => { Name => 'BatteryVoltage3', PrintConv => '"$val V"' },
|
||||
7 => { Name => 'BatteryVoltage4', PrintConv => '"$val V"' },
|
||||
8 => { Name => 'BatteryTime', PrintConv => 'ConvertDuration(int($val + 0.5))' }, # (NC)
|
||||
9 => { Name => 'KBAT_Unknown9', PrintConv => '"$val %"', Unknown => 1, Hidden => 1, },
|
||||
10 => { Name => 'KBAT_Unknown10', Unknown => 1, Hidden => 1 }, # (no units)
|
||||
11 => { Name => 'KBAT_Unknown11', Unknown => 1, Hidden => 1 }, # (no units)
|
||||
12 => { Name => 'KBAT_Unknown12', Unknown => 1, Hidden => 1 }, # (no units)
|
||||
13 => { Name => 'KBAT_Unknown13', Unknown => 1, Hidden => 1 }, # (no units)
|
||||
14 => { Name => 'BatteryLevel', PrintConv => '"$val %"' },
|
||||
);
|
||||
|
||||
# GoPro fdsc tags written by the Hero5 and Hero6 (ref PH)
|
||||
%Image::ExifTool::GoPro::fdsc = (
|
||||
GROUPS => { 2 => 'Camera' },
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
NOTES => q{
|
||||
Tags extracted from the MP4 "fdsc" timed metadata when the ExtractEmbedded
|
||||
option is used.
|
||||
},
|
||||
0x08 => { Name => 'FirmwareVersion', Format => 'string[15]' },
|
||||
0x17 => { Name => 'SerialNumber', Format => 'string[16]' },
|
||||
0x57 => { Name => 'OtherSerialNumber', Format => 'string[15]' }, # (NC)
|
||||
0x66 => {
|
||||
Name => 'Model',
|
||||
Description => 'Camera Model Name',
|
||||
Format => 'string[16]',
|
||||
},
|
||||
# ...
|
||||
# after this there are lots of interesting values also found in the GPMF box,
|
||||
# but this block is lacking tag ID's and any directory structure, so the
|
||||
# value offsets are therefore presumably firmware dependent :(
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Convert system time to date/time string
|
||||
# Inputs: 0) system time value, 1) ExifTool ref
|
||||
# Returns: EXIF-format date/time string with milliseconds
|
||||
sub ConvertSystemTime($$)
|
||||
{
|
||||
my ($val, $et) = @_;
|
||||
my $s = $$et{SystemTimeList} or return '<uncalibrated>';
|
||||
unless ($$et{SystemTimeListSorted}) {
|
||||
$s = $$et{SystemTimeList} = [ sort { $$a[0] <=> $$b[0] } @$s ];
|
||||
$$et{SystemTimeListSorted} = 1;
|
||||
}
|
||||
my ($i, $j) = (0, $#$s);
|
||||
# perform binary search to find this system time value
|
||||
while ($j - $i > 1) {
|
||||
my $t = int(($i + $j) / 2);
|
||||
($val < $$s[$t][0] ? $j : $i) = $t;
|
||||
}
|
||||
if ($i == $j or $$s[$j][0] == $$s[$i][0]) {
|
||||
$val = $$s[$i][1];
|
||||
} else {
|
||||
# interpolate between values
|
||||
$val = $$s[$i][1] + ($$s[$j][1] - $$s[$i][1]) * ($val - $$s[$i][0]) / ($$s[$j][0] - $$s[$i][0]);
|
||||
}
|
||||
# (a bit tricky to remove fractional seconds then add them back again after
|
||||
# the date/time conversion while avoiding round-off errors which could
|
||||
# put the seconds out by 1...)
|
||||
my ($t, $f) = ("$val" =~ /^(\d+)(\.\d+)/);
|
||||
return Image::ExifTool::ConvertUnixTime($t, $$et{OPTIONS}{QuickTimeUTC}) . $f;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Scale values by last 'SCAL' constants
|
||||
# Inputs: 0) value or list of values, 1) string of scale factors
|
||||
# Returns: nothing, but updates values
|
||||
sub ScaleValues($$)
|
||||
{
|
||||
my ($val, $scl) = @_;
|
||||
return unless $val and $scl;
|
||||
my @scl = split ' ', $scl or return;
|
||||
my @scaled;
|
||||
my $v = (ref $val eq 'ARRAY') ? $val : [ $val ];
|
||||
foreach $val (@$v) {
|
||||
my @a = split ' ', $val;
|
||||
$a[$_] /= $scl[$_ % @scl] foreach 0..$#a;
|
||||
push @scaled, join(' ', @a);
|
||||
}
|
||||
$_[0] = @scaled > 1 ? \@scaled : $scaled[0];
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Add units to values for human-readable output
|
||||
# Inputs: 0) ExifTool ref, 1) value, 2) tag key
|
||||
# Returns: converted value
|
||||
sub AddUnits($$$)
|
||||
{
|
||||
my ($et, $val, $tag) = @_;
|
||||
if ($et and $$et{TAG_EXTRA}{$tag} and $$et{TAG_EXTRA}{$tag}{Units}) {
|
||||
my $u = $$et{TAG_EXTRA}{$tag}{Units};
|
||||
$u = [ $u ] unless ref $u eq 'ARRAY';
|
||||
my @a = split ' ', $val;
|
||||
if (@$u == @a) {
|
||||
my $i;
|
||||
for ($i=0; $i<@a; ++$i) {
|
||||
$a[$i] .= ' ' . $$u[$i] if $$u[$i];
|
||||
}
|
||||
$val = join ' ', @a;
|
||||
}
|
||||
}
|
||||
return $val;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process string of values (or array of strings) to extract as separate tags
|
||||
# Inputs: 0) ExifTool object ref, 1) directory information ref, 2) tag table ref
|
||||
# Returns: 1 on success
|
||||
sub ProcessString($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my @list = ref $$dataPt eq 'ARRAY' ? @{$$dataPt} : ( $$dataPt );
|
||||
my ($string, $val);
|
||||
$et->VerboseDir('GoPro structure');
|
||||
foreach $string (@list) {
|
||||
my @val = split ' ', $string;
|
||||
my $i = 0;
|
||||
foreach $val (@val) {
|
||||
$et->HandleTag($tagTablePtr, $i, $val);
|
||||
$$tagTablePtr{++$i} or $i = 0;
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process GoPro metadata (gpmd samples, GPMF box, or APP6) (ref PH/1/2)
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: 1 on success
|
||||
sub ProcessGoPro($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $base = $$dirInfo{Base};
|
||||
my $pos = $$dirInfo{DirStart} || 0;
|
||||
my $dirEnd = $pos + ($$dirInfo{DirLen} || (length($$dataPt) - $pos));
|
||||
my $verbose = $et->Options('Verbose');
|
||||
my $unknown = $verbose || $et->Options('Unknown');
|
||||
my ($size, $type, $unit, $scal, $setGroup0);
|
||||
|
||||
$et->VerboseDir($$dirInfo{DirName} || 'GPMF', undef, $dirEnd-$pos) if $verbose;
|
||||
if ($pos) {
|
||||
my $parent = $$dirInfo{Parent};
|
||||
$setGroup0 = $$et{SET_GROUP0} = 'APP6' if $parent and $parent eq 'APP6';
|
||||
} else {
|
||||
# set group0 to "QuickTime" unless group1 is being changed (to Track#)
|
||||
$setGroup0 = $$et{SET_GROUP0} = 'QuickTime' unless $$et{SET_GROUP1};
|
||||
}
|
||||
|
||||
for (; $pos+8<=$dirEnd; $pos+=($size+3)&0xfffffffc) {
|
||||
my ($tag,$fmt,$len,$count) = unpack("x${pos}a4CCn", $$dataPt);
|
||||
$size = $len * $count;
|
||||
$pos += 8;
|
||||
last if $pos + $size > $dirEnd;
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
|
||||
last if $tag eq "\0\0\0\0"; # stop at null tag
|
||||
next unless $size or $verbose; # don't save empty values unless verbose
|
||||
my $format = $goProFmt{$fmt} || 'undef';
|
||||
my ($val, $i, $j, $p, @v);
|
||||
if ($fmt eq 0x3f and defined $type) {
|
||||
# decode structure with format given by previous 'TYPE'
|
||||
for ($i=0; $i<$count; ++$i) {
|
||||
my (@s, $l);
|
||||
for ($j=0, $p=0; $j<length($type); ++$j, $p+=$l) {
|
||||
my $b = Get8u(\$type, $j);
|
||||
my $f = $goProFmt{$b} or last;
|
||||
$l = $goProSize{$b} || Image::ExifTool::FormatSize($f) or last;
|
||||
last if $p + $l > $len;
|
||||
my $s = ReadValue($dataPt, $pos+$i*$len+$p, $f, undef, $l);
|
||||
last unless defined $s;
|
||||
push @s, $s;
|
||||
}
|
||||
push @v, join ' ', @s if @s;
|
||||
}
|
||||
$val = @v > 1 ? \@v : $v[0];
|
||||
} elsif (($format eq 'undef' or $format eq 'string') and $count > 1 and $len > 1) {
|
||||
# unpack multiple undef/string values as a list
|
||||
my $a = $format eq 'undef' ? 'a' : 'A';
|
||||
$val = [ unpack("x${pos}".("$a$len" x $count), $$dataPt) ];
|
||||
} else {
|
||||
$val = ReadValue($dataPt, $pos, $format, undef, $size);
|
||||
}
|
||||
# save TYPE, UNIT/SIUN and SCAL values for later
|
||||
$type = $val if $tag eq 'TYPE';
|
||||
$unit = $val if $tag eq 'UNIT' or $tag eq 'SIUN';
|
||||
$scal = $val if $tag eq 'SCAL';
|
||||
|
||||
unless ($tagInfo) {
|
||||
next unless $unknown;
|
||||
my $name = Image::ExifTool::QuickTime::PrintableTagID($tag);
|
||||
$tagInfo = { Name => "GoPro_$name", Description => "GoPro $name", Unknown => 1 };
|
||||
$$tagInfo{SubDirectory} = { TagTable => 'Image::ExifTool::GoPro::GPMF' } if not $fmt;
|
||||
AddTagToTable($tagTablePtr, $tag, $tagInfo);
|
||||
}
|
||||
# apply scaling if available to last tag in this container
|
||||
ScaleValues($val, $scal) if $scal and $tag ne 'SCAL' and $pos+$size+3>=$dirEnd;
|
||||
my $key = $et->HandleTag($tagTablePtr, $tag, $val,
|
||||
DataPt => $dataPt,
|
||||
Base => $base,
|
||||
Start => $pos,
|
||||
Size => $size,
|
||||
TagInfo => $tagInfo,
|
||||
Format => $format,
|
||||
Extra => $verbose ? ", type='".($fmt ? chr($fmt) : '\0')."' size=$len count=$count" : undef,
|
||||
);
|
||||
# save units for adding in print conversion if specified
|
||||
$$et{TAG_EXTRA}{$key}{Units} = $unit if $$tagInfo{AddUnits} and $key;
|
||||
}
|
||||
delete $$et{SET_GROUP0} if $setGroup0;
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::GoPro - Read information from GoPro videos
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to decode
|
||||
metadata from GoPro MP4 videos.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<https://github.com/gopro/gpmf-parser>
|
||||
|
||||
=item L<https://github.com/stilldavid/gopro-utils>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/GoPro Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,263 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: HP.pm
|
||||
#
|
||||
# Description: Hewlett-Packard maker notes tags
|
||||
#
|
||||
# Revisions: 2007-05-03 - P. Harvey Created
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::HP;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.04';
|
||||
|
||||
sub ProcessHP($$$);
|
||||
sub ProcessTDHD($$$);
|
||||
|
||||
# HP EXIF-format maker notes (or is it Vivitar?)
|
||||
%Image::ExifTool::HP::Main = (
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
|
||||
NOTES => q{
|
||||
These tables list tags found in the maker notes of some Hewlett-Packard
|
||||
camera models.
|
||||
|
||||
The first table lists tags found in the EXIF-format maker notes of the
|
||||
PhotoSmart 720 (also used by the Vivitar ViviCam 3705, 3705B and 3715).
|
||||
},
|
||||
0x0e00 => {
|
||||
Name => 'PrintIM',
|
||||
Description => 'Print Image Matching',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::PrintIM::Main',
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
# other types of HP maker notes
|
||||
%Image::ExifTool::HP::Type2 = (
|
||||
PROCESS_PROC => \&ProcessHP,
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
|
||||
NOTES => 'These tags are used by the PhotoSmart E427.',
|
||||
'PreviewImage' => {
|
||||
Name => 'PreviewImage',
|
||||
Groups => { 2 => 'Preview' },
|
||||
RawConv => '$self->ValidateImage(\$val,$tag)',
|
||||
},
|
||||
'Serial Number' => 'SerialNumber',
|
||||
'Lens Shading' => 'LensShading',
|
||||
);
|
||||
|
||||
%Image::ExifTool::HP::Type4 = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
|
||||
NOTES => 'These tags are used by the PhotoSmart M627.',
|
||||
0x0c => {
|
||||
Name => 'MaxAperture',
|
||||
Format => 'int16u',
|
||||
ValueConv => '$val / 10',
|
||||
},
|
||||
0x10 => {
|
||||
Name => 'ExposureTime',
|
||||
Format => 'int32u',
|
||||
ValueConv => '$val / 1e6',
|
||||
PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
|
||||
},
|
||||
0x14 => {
|
||||
Name => 'CameraDateTime',
|
||||
Groups => { 2 => 'Time' },
|
||||
Format => 'string[20]',
|
||||
},
|
||||
0x34 => {
|
||||
Name => 'ISO',
|
||||
Format => 'int16u',
|
||||
},
|
||||
0x5c => {
|
||||
Name => 'SerialNumber',
|
||||
Format => 'string[26]',
|
||||
RawConv => '$val =~ s/^SERIAL NUMBER:// ? $val : undef',
|
||||
},
|
||||
);
|
||||
|
||||
%Image::ExifTool::HP::Type6 = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
|
||||
NOTES => 'These tags are used by the PhotoSmart M425, M525 and M527.',
|
||||
0x0c => {
|
||||
Name => 'FNumber',
|
||||
Format => 'int16u',
|
||||
ValueConv => '$val / 10',
|
||||
},
|
||||
0x10 => {
|
||||
Name => 'ExposureTime',
|
||||
Format => 'int32u',
|
||||
ValueConv => '$val / 1e6',
|
||||
PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
|
||||
},
|
||||
0x14 => {
|
||||
Name => 'CameraDateTime',
|
||||
Groups => { 2 => 'Time' },
|
||||
Format => 'string[20]',
|
||||
},
|
||||
0x34 => {
|
||||
Name => 'ISO',
|
||||
Format => 'int16u',
|
||||
},
|
||||
0x58 => {
|
||||
Name => 'SerialNumber',
|
||||
Format => 'string[26]',
|
||||
RawConv => '$val =~ s/^SERIAL NUMBER:// ? $val : undef',
|
||||
},
|
||||
);
|
||||
|
||||
# proprietary format TDHD data written by Photosmart R837 (ref PH)
|
||||
%Image::ExifTool::HP::TDHD = (
|
||||
PROCESS_PROC => \&ProcessTDHD,
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
|
||||
NOTES => q{
|
||||
These tags are extracted from the APP6 "TDHD" segment of Photosmart R837
|
||||
JPEG images. Many other unknown tags exist in is data, and can be seen with
|
||||
the Unknown (-u) option.
|
||||
},
|
||||
# (all subdirectories except TDHD and LSLV are automatically recognized
|
||||
# by their "type" word of 0x10001)
|
||||
TDHD => {
|
||||
Name => 'TDHD',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::HP::TDHD' },
|
||||
},
|
||||
LSLV => {
|
||||
Name => 'LSLV',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::HP::TDHD' },
|
||||
},
|
||||
FWRV => 'FirmwareVersion',
|
||||
CMSN => 'SerialNumber', # (unverified)
|
||||
# LTEM - some temperature?
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process HP APP6 TDHD metadata (ref PH)
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: 1 on success
|
||||
sub ProcessTDHD($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dataPos = $$dirInfo{DataPos};
|
||||
my $pos = $$dirInfo{DirStart};
|
||||
my $dirEnd = $pos + $$dirInfo{DirLen};
|
||||
my $unknown = $et->Options('Unknown') || $et->Options('Verbose');
|
||||
$et->VerboseDir('TDHD', undef, $$dirInfo{DirLen});
|
||||
SetByteOrder('II');
|
||||
while ($pos + 12 < $dirEnd) {
|
||||
my $tag = substr($$dataPt, $pos, 4);
|
||||
my $type = Get32u($dataPt, $pos + 4);
|
||||
my $size = Get32u($dataPt, $pos + 8);
|
||||
$pos += 12;
|
||||
last if $size < 0 or $pos + $size > $dirEnd;
|
||||
if ($type == 0x10001) {
|
||||
# this is a subdirectory containing more tags
|
||||
my %dirInfo = (
|
||||
DataPt => $dataPt,
|
||||
DataPos => $dataPos,
|
||||
DirStart => $pos,
|
||||
DirLen => $size,
|
||||
);
|
||||
$et->ProcessDirectory(\%dirInfo, $tagTablePtr);
|
||||
} else {
|
||||
if (not $$tagTablePtr{$tag} and $unknown) {
|
||||
my $name = $tag;
|
||||
$name =~ tr/-_A-Za-z0-9//dc; # remove invalid characters
|
||||
my %tagInfo = (
|
||||
Name => "HP_TDHD_$name",
|
||||
Unknown => 1,
|
||||
);
|
||||
# guess format based on data size
|
||||
if ($size == 1) {
|
||||
$tagInfo{Format} = 'int8u';
|
||||
} elsif ($size == 2) {
|
||||
$tagInfo{Format} = 'int16u';
|
||||
} elsif ($size == 4) {
|
||||
$tagInfo{Format} = 'int32s';
|
||||
} elsif ($size > 80) {
|
||||
$tagInfo{Binary} = 1;
|
||||
}
|
||||
AddTagToTable($tagTablePtr, $tag, \%tagInfo);
|
||||
}
|
||||
$et->HandleTag($tagTablePtr, $tag, undef,
|
||||
DataPt => $dataPt,
|
||||
DataPos => $dataPos,
|
||||
Start => $pos,
|
||||
Size => $size,
|
||||
);
|
||||
}
|
||||
$pos += $size;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process HP maker notes
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: 1 on success, otherwise returns 0 and sets a Warning
|
||||
sub ProcessHP($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dataLen = $$dirInfo{DataLen};
|
||||
my $dirStart = $$dirInfo{DirStart} || 0;
|
||||
my $dirLen = $$dirInfo{DirLen} || $dataLen - $dirStart;
|
||||
|
||||
# look for known text-type tags
|
||||
if ($dirStart or $dirLen != length($$dataPt)) {
|
||||
my $buff = substr($$dataPt, $dirStart, $dirLen);
|
||||
$dataPt = \$buff;
|
||||
}
|
||||
my $tagID;
|
||||
# brute-force scan for PreviewImage
|
||||
if ($$tagTablePtr{PreviewImage} and $$dataPt =~ /(\xff\xd8\xff\xdb.*\xff\xd9)/gs) {
|
||||
$et->HandleTag($tagTablePtr, 'PreviewImage', $1);
|
||||
# truncate preview to speed subsequent tag scans
|
||||
my $buff = substr($$dataPt, 0, pos($$dataPt)-length($1));
|
||||
$dataPt = \$buff;
|
||||
}
|
||||
# scan for other tag ID's
|
||||
foreach $tagID (sort(TagTableKeys($tagTablePtr))) {
|
||||
next if $tagID eq 'PreviewImage';
|
||||
next unless $$dataPt =~ /$tagID:\s*([\x20-\x7f]+)/i;
|
||||
$et->HandleTag($tagTablePtr, $tagID, $1);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::HP - Hewlett-Packard maker notes tags
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is loaded automatically by Image::ExifTool when required.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to interpret
|
||||
Hewlett-Packard maker notes.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/HP Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,576 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: HTML.pm
|
||||
#
|
||||
# Description: Read HTML meta information
|
||||
#
|
||||
# Revisions: 01/30/2007 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://www.w3.org/TR/html4/
|
||||
# 2) http://www.daisy.org/publications/specifications/daisy_202.html
|
||||
# 3) http://vancouver-webpages.com/META/metatags.detail.html
|
||||
# 4) http://www.html-reference.com/META.htm
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::HTML;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION @ISA @EXPORT_OK);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
use Image::ExifTool::PostScript;
|
||||
use Image::ExifTool::XMP qw(EscapeXML UnescapeXML);
|
||||
require Exporter;
|
||||
|
||||
$VERSION = '1.15';
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT_OK = qw(EscapeHTML UnescapeHTML);
|
||||
|
||||
sub SetHTMLCharset($$);
|
||||
|
||||
# convert HTML charset (lower case) to ExifTool Charset name
|
||||
my %htmlCharset = (
|
||||
macintosh => 'MacRoman',
|
||||
'iso-8859-1' => 'Latin',
|
||||
'utf-8' => 'UTF8',
|
||||
'windows-1252' => 'Latin',
|
||||
);
|
||||
|
||||
# HTML 4 character entity references
|
||||
my %entityNum = (
|
||||
'quot' => 34, 'eth' => 240, 'lsquo' => 8216,
|
||||
'amp' => 38, 'ntilde' => 241, 'rsquo' => 8217,
|
||||
'apos' => 39, 'ograve' => 242, 'sbquo' => 8218,
|
||||
'lt' => 60, 'oacute' => 243, 'ldquo' => 8220,
|
||||
'gt' => 62, 'ocirc' => 244, 'rdquo' => 8221,
|
||||
'nbsp' => 160, 'otilde' => 245, 'bdquo' => 8222,
|
||||
'iexcl' => 161, 'ouml' => 246, 'dagger' => 8224,
|
||||
'cent' => 162, 'divide' => 247, 'Dagger' => 8225,
|
||||
'pound' => 163, 'oslash' => 248, 'bull' => 8226,
|
||||
'curren' => 164, 'ugrave' => 249, 'hellip' => 8230,
|
||||
'yen' => 165, 'uacute' => 250, 'permil' => 8240,
|
||||
'brvbar' => 166, 'ucirc' => 251, 'prime' => 8242,
|
||||
'sect' => 167, 'uuml' => 252, 'Prime' => 8243,
|
||||
'uml' => 168, 'yacute' => 253, 'lsaquo' => 8249,
|
||||
'copy' => 169, 'thorn' => 254, 'rsaquo' => 8250,
|
||||
'ordf' => 170, 'yuml' => 255, 'oline' => 8254,
|
||||
'laquo' => 171, 'OElig' => 338, 'frasl' => 8260,
|
||||
'not' => 172, 'oelig' => 339, 'euro' => 8364,
|
||||
'shy' => 173, 'Scaron' => 352, 'image' => 8465,
|
||||
'reg' => 174, 'scaron' => 353, 'weierp' => 8472,
|
||||
'macr' => 175, 'Yuml' => 376, 'real' => 8476,
|
||||
'deg' => 176, 'fnof' => 402, 'trade' => 8482,
|
||||
'plusmn' => 177, 'circ' => 710, 'alefsym'=> 8501,
|
||||
'sup2' => 178, 'tilde' => 732, 'larr' => 8592,
|
||||
'sup3' => 179, 'Alpha' => 913, 'uarr' => 8593,
|
||||
'acute' => 180, 'Beta' => 914, 'rarr' => 8594,
|
||||
'micro' => 181, 'Gamma' => 915, 'darr' => 8595,
|
||||
'para' => 182, 'Delta' => 916, 'harr' => 8596,
|
||||
'middot' => 183, 'Epsilon'=> 917, 'crarr' => 8629,
|
||||
'cedil' => 184, 'Zeta' => 918, 'lArr' => 8656,
|
||||
'sup1' => 185, 'Eta' => 919, 'uArr' => 8657,
|
||||
'ordm' => 186, 'Theta' => 920, 'rArr' => 8658,
|
||||
'raquo' => 187, 'Iota' => 921, 'dArr' => 8659,
|
||||
'frac14' => 188, 'Kappa' => 922, 'hArr' => 8660,
|
||||
'frac12' => 189, 'Lambda' => 923, 'forall' => 8704,
|
||||
'frac34' => 190, 'Mu' => 924, 'part' => 8706,
|
||||
'iquest' => 191, 'Nu' => 925, 'exist' => 8707,
|
||||
'Agrave' => 192, 'Xi' => 926, 'empty' => 8709,
|
||||
'Aacute' => 193, 'Omicron'=> 927, 'nabla' => 8711,
|
||||
'Acirc' => 194, 'Pi' => 928, 'isin' => 8712,
|
||||
'Atilde' => 195, 'Rho' => 929, 'notin' => 8713,
|
||||
'Auml' => 196, 'Sigma' => 931, 'ni' => 8715,
|
||||
'Aring' => 197, 'Tau' => 932, 'prod' => 8719,
|
||||
'AElig' => 198, 'Upsilon'=> 933, 'sum' => 8721,
|
||||
'Ccedil' => 199, 'Phi' => 934, 'minus' => 8722,
|
||||
'Egrave' => 200, 'Chi' => 935, 'lowast' => 8727,
|
||||
'Eacute' => 201, 'Psi' => 936, 'radic' => 8730,
|
||||
'Ecirc' => 202, 'Omega' => 937, 'prop' => 8733,
|
||||
'Euml' => 203, 'alpha' => 945, 'infin' => 8734,
|
||||
'Igrave' => 204, 'beta' => 946, 'ang' => 8736,
|
||||
'Iacute' => 205, 'gamma' => 947, 'and' => 8743,
|
||||
'Icirc' => 206, 'delta' => 948, 'or' => 8744,
|
||||
'Iuml' => 207, 'epsilon'=> 949, 'cap' => 8745,
|
||||
'ETH' => 208, 'zeta' => 950, 'cup' => 8746,
|
||||
'Ntilde' => 209, 'eta' => 951, 'int' => 8747,
|
||||
'Ograve' => 210, 'theta' => 952, 'there4' => 8756,
|
||||
'Oacute' => 211, 'iota' => 953, 'sim' => 8764,
|
||||
'Ocirc' => 212, 'kappa' => 954, 'cong' => 8773,
|
||||
'Otilde' => 213, 'lambda' => 955, 'asymp' => 8776,
|
||||
'Ouml' => 214, 'mu' => 956, 'ne' => 8800,
|
||||
'times' => 215, 'nu' => 957, 'equiv' => 8801,
|
||||
'Oslash' => 216, 'xi' => 958, 'le' => 8804,
|
||||
'Ugrave' => 217, 'omicron'=> 959, 'ge' => 8805,
|
||||
'Uacute' => 218, 'pi' => 960, 'sub' => 8834,
|
||||
'Ucirc' => 219, 'rho' => 961, 'sup' => 8835,
|
||||
'Uuml' => 220, 'sigmaf' => 962, 'nsub' => 8836,
|
||||
'Yacute' => 221, 'sigma' => 963, 'sube' => 8838,
|
||||
'THORN' => 222, 'tau' => 964, 'supe' => 8839,
|
||||
'szlig' => 223, 'upsilon'=> 965, 'oplus' => 8853,
|
||||
'agrave' => 224, 'phi' => 966, 'otimes' => 8855,
|
||||
'aacute' => 225, 'chi' => 967, 'perp' => 8869,
|
||||
'acirc' => 226, 'psi' => 968, 'sdot' => 8901,
|
||||
'atilde' => 227, 'omega' => 969, 'lceil' => 8968,
|
||||
'auml' => 228, 'thetasym'=>977, 'rceil' => 8969,
|
||||
'aring' => 229, 'upsih' => 978, 'lfloor' => 8970,
|
||||
'aelig' => 230, 'piv' => 982, 'rfloor' => 8971,
|
||||
'ccedil' => 231, 'ensp' => 8194, 'lang' => 9001,
|
||||
'egrave' => 232, 'emsp' => 8195, 'rang' => 9002,
|
||||
'eacute' => 233, 'thinsp' => 8201, 'loz' => 9674,
|
||||
'ecirc' => 234, 'zwnj' => 8204, 'spades' => 9824,
|
||||
'euml' => 235, 'zwj' => 8205, 'clubs' => 9827,
|
||||
'igrave' => 236, 'lrm' => 8206, 'hearts' => 9829,
|
||||
'iacute' => 237, 'rlm' => 8207, 'diams' => 9830,
|
||||
'icirc' => 238, 'ndash' => 8211,
|
||||
'iuml' => 239, 'mdash' => 8212,
|
||||
);
|
||||
my %entityName; # look up entity names by number (built as necessary)
|
||||
|
||||
# HTML info
|
||||
# (tag ID's are case insensitive and must be all lower case in tables)
|
||||
%Image::ExifTool::HTML::Main = (
|
||||
GROUPS => { 2 => 'Document' },
|
||||
NOTES => q{
|
||||
Meta information extracted from the header of HTML and XHTML files. This is
|
||||
a mix of information found in the C<META> elements, C<XML> element, and the
|
||||
C<TITLE> element.
|
||||
},
|
||||
dc => {
|
||||
Name => 'DC',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::HTML::dc' },
|
||||
},
|
||||
ncc => {
|
||||
Name => 'NCC',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::HTML::ncc' },
|
||||
},
|
||||
prod => {
|
||||
Name => 'Prod',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::HTML::prod' },
|
||||
},
|
||||
vw96 => {
|
||||
Name => 'VW96',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::HTML::vw96' },
|
||||
},
|
||||
'http-equiv' => {
|
||||
Name => 'HTTP-equiv',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::HTML::equiv' },
|
||||
},
|
||||
o => {
|
||||
Name => 'Office',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::HTML::Office' },
|
||||
},
|
||||
abstract => { },
|
||||
author => { },
|
||||
classification => { },
|
||||
'content-language'=>{ Name => 'ContentLanguage' },
|
||||
copyright => { },
|
||||
description => { },
|
||||
distribution => { },
|
||||
'doc-class' => { Name => 'DocClass' },
|
||||
'doc-rights' => { Name => 'DocRights' },
|
||||
'doc-type' => { Name => 'DocType' },
|
||||
formatter => { },
|
||||
generator => { },
|
||||
generatorversion=> { Name => 'GeneratorVersion' },
|
||||
googlebot => { Name => 'GoogleBot' },
|
||||
keywords => { List => 1 },
|
||||
mssmarttagspreventparsing => { Name => 'NoMSSmartTags' },
|
||||
originator => { },
|
||||
owner => { },
|
||||
progid => { Name => 'ProgID' },
|
||||
rating => { },
|
||||
refresh => { },
|
||||
'resource-type' => { Name => 'ResourceType' },
|
||||
'revisit-after' => { Name => 'RevisitAfter' },
|
||||
robots => { List => 1 },
|
||||
title => { Notes => "the only extracted tag which isn't from an HTML META element" },
|
||||
);
|
||||
|
||||
# ref 2
|
||||
%Image::ExifTool::HTML::dc = (
|
||||
GROUPS => { 1 => 'HTML-dc', 2 => 'Document' },
|
||||
NOTES => 'Dublin Core schema tags (also used in XMP).',
|
||||
contributor => { Groups => { 2 => 'Author' }, List => 'Bag' },
|
||||
coverage => { },
|
||||
creator => { Groups => { 2 => 'Author' }, List => 'Seq' },
|
||||
date => {
|
||||
Groups => { 2 => 'Time' },
|
||||
List => 'Seq',
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
description => { },
|
||||
'format' => { },
|
||||
identifier => { },
|
||||
language => { List => 'Bag' },
|
||||
publisher => { Groups => { 2 => 'Author' }, List => 'Bag' },
|
||||
relation => { List => 'Bag' },
|
||||
rights => { Groups => { 2 => 'Author' } },
|
||||
source => { Groups => { 2 => 'Author' } },
|
||||
subject => { List => 'Bag' },
|
||||
title => { },
|
||||
type => { List => 'Bag' },
|
||||
);
|
||||
|
||||
# ref 2
|
||||
%Image::ExifTool::HTML::ncc = (
|
||||
GROUPS => { 1 => 'HTML-ncc', 2 => 'Document' },
|
||||
charset => { Name => 'CharacterSet' }, # name changed to avoid conflict with -charset option
|
||||
depth => { },
|
||||
files => { },
|
||||
footnotes => { },
|
||||
generator => { },
|
||||
kbytesize => { Name => 'KByteSize' },
|
||||
maxpagenormal => { Name => 'MaxPageNormal' },
|
||||
multimediatype => { Name => 'MultimediaType' },
|
||||
narrator => { },
|
||||
pagefront => { Name => 'PageFront' },
|
||||
pagenormal => { Name => 'PageNormal' },
|
||||
pagespecial => { Name => 'PageSpecial' },
|
||||
prodnotes => { Name => 'ProdNotes' },
|
||||
producer => { },
|
||||
produceddate => { Name => 'ProducedDate', Groups => { 2 => 'Time' } }, # YYYY-mm-dd
|
||||
revision => { },
|
||||
revisiondate => { Name => 'RevisionDate', Groups => { 2 => 'Time' } },
|
||||
setinfo => { Name => 'SetInfo' },
|
||||
sidebars => { },
|
||||
sourcedate => { Name => 'SourceDate', Groups => { 2 => 'Time' } },
|
||||
sourceedition => { Name => 'SourceEdition' },
|
||||
sourcepublisher => { Name => 'SourcePublisher' },
|
||||
sourcerights => { Name => 'SourceRights' },
|
||||
sourcetitle => { Name => 'SourceTitle' },
|
||||
tocitems => { Name => 'TOCItems' },
|
||||
totaltime => { Name => 'Duration' }, # HH:MM:SS
|
||||
);
|
||||
|
||||
# ref 3
|
||||
%Image::ExifTool::HTML::vw96 = (
|
||||
GROUPS => { 1 => 'HTML-vw96', 2 => 'Document' },
|
||||
objecttype => { Name => 'ObjectType' },
|
||||
);
|
||||
|
||||
# ref 2
|
||||
%Image::ExifTool::HTML::prod = (
|
||||
GROUPS => { 1 => 'HTML-prod', 2 => 'Document' },
|
||||
reclocation => { Name => 'RecLocation' },
|
||||
recengineer => { Name => 'RecEngineer' },
|
||||
);
|
||||
|
||||
# ref 3/4
|
||||
%Image::ExifTool::HTML::equiv = (
|
||||
GROUPS => { 1 => 'HTTP-equiv', 2 => 'Document' },
|
||||
NOTES => 'These tags have a family 1 group name of "HTTP-equiv".',
|
||||
'cache-control' => { Name => 'CacheControl' },
|
||||
'content-disposition' => { Name => 'ContentDisposition' },
|
||||
'content-language' => { Name => 'ContentLanguage' },
|
||||
'content-script-type' => { Name => 'ContentScriptType' },
|
||||
'content-style-type' => { Name => 'ContentStyleType' },
|
||||
# note: setting the HTMLCharset like this will miss any tags which come earlier
|
||||
'content-type' => { Name => 'ContentType', RawConv => \&SetHTMLCharset },
|
||||
'default-style' => { Name => 'DefaultStyle' },
|
||||
expires => { },
|
||||
'ext-cache' => { Name => 'ExtCache' },
|
||||
imagetoolbar => { Name => 'ImageToolbar' },
|
||||
lotus => { },
|
||||
'page-enter' => { Name => 'PageEnter' },
|
||||
'page-exit' => { Name => 'PageExit' },
|
||||
'pics-label' => { Name => 'PicsLabel' },
|
||||
pragma => { },
|
||||
refresh => { },
|
||||
'reply-to' => { Name => 'ReplyTo' },
|
||||
'set-cookie' => { Name => 'SetCookie' },
|
||||
'site-enter' => { Name => 'SiteEnter' },
|
||||
'site-exit' => { Name => 'SiteExit' },
|
||||
vary => { },
|
||||
'window-target' => { Name => 'WindowTarget' },
|
||||
);
|
||||
|
||||
# MS Office namespace (ref PH)
|
||||
%Image::ExifTool::HTML::Office = (
|
||||
GROUPS => { 1 => 'HTML-office', 2 => 'Document' },
|
||||
NOTES => 'Tags written by Microsoft Office applications.',
|
||||
Subject => { },
|
||||
Author => { Groups => { 2 => 'Author' } },
|
||||
Keywords => { },
|
||||
Description => { },
|
||||
Template => { },
|
||||
LastAuthor => { Groups => { 2 => 'Author' } },
|
||||
Revision => { Name => 'RevisionNumber' },
|
||||
TotalTime => { Name => 'TotalEditTime', PrintConv => 'ConvertTimeSpan($val, 60)' },
|
||||
Created => {
|
||||
Name => 'CreateDate',
|
||||
Groups => { 2 => 'Time' },
|
||||
ValueConv => 'Image::ExifTool::XMP::ConvertXMPDate($val)',
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
LastSaved => {
|
||||
Name => 'ModifyDate',
|
||||
Groups => { 2 => 'Time' },
|
||||
ValueConv => 'Image::ExifTool::XMP::ConvertXMPDate($val)',
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
LastSaved => {
|
||||
Name => 'ModifyDate',
|
||||
Groups => { 2 => 'Time' },
|
||||
ValueConv => 'Image::ExifTool::XMP::ConvertXMPDate($val)',
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
LastPrinted => {
|
||||
Name => 'LastPrinted',
|
||||
Groups => { 2 => 'Time' },
|
||||
ValueConv => 'Image::ExifTool::XMP::ConvertXMPDate($val)',
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
Pages => { },
|
||||
Words => { },
|
||||
Characters => { },
|
||||
Category => { },
|
||||
Manager => { },
|
||||
Company => { },
|
||||
Lines => { },
|
||||
Paragraphs => { },
|
||||
CharactersWithSpaces => { },
|
||||
Version => { Name => 'RevisionNumber' },
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Set HTMLCharset member based on content type
|
||||
# Inputs: 0) content type string, 1) ExifTool ref
|
||||
# Returns: original string
|
||||
sub SetHTMLCharset($$)
|
||||
{
|
||||
my ($val, $et) = @_;
|
||||
$$et{HTMLCharset} = $htmlCharset{lc $1} if $val =~ /charset=['"]?([-\w]+)/;
|
||||
return $val;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Convert single UTF-8 character to HTML character reference
|
||||
# Inputs: 0) UTF-8 character sequence
|
||||
# Returns: HTML character reference (eg. """);
|
||||
# Note: Must be called via EscapeHTML to load name lookup
|
||||
sub EscapeChar($)
|
||||
{
|
||||
my $ch = shift;
|
||||
my $val;
|
||||
if ($] < 5.006001) {
|
||||
($val) = Image::ExifTool::UnpackUTF8($ch);
|
||||
} else {
|
||||
# the meaning of "U0" is reversed as of Perl 5.10.0!
|
||||
($val) = unpack($] < 5.010000 ? 'U0U' : 'C0U', $ch);
|
||||
}
|
||||
return '?' unless defined $val;
|
||||
return "&$entityName{$val};" if $entityName{$val};
|
||||
return sprintf('&#x%x;',$val);
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Escape any special characters for HTML
|
||||
# Inputs: 0) UTF-8 string to be escaped
|
||||
# Returns: escaped string
|
||||
sub EscapeHTML($)
|
||||
{
|
||||
my $str = shift;
|
||||
# escape XML characters
|
||||
$str = EscapeXML($str);
|
||||
# escape other special characters if they exist
|
||||
if ($str =~ /[\x80-\xff]/) {
|
||||
# generate entity name lookup if necessary
|
||||
unless (%entityName) {
|
||||
local $_;
|
||||
foreach (keys %entityNum) {
|
||||
$entityName{$entityNum{$_}} = $_;
|
||||
}
|
||||
delete $entityName{39}; # 'apos' is not valid HTML
|
||||
}
|
||||
# suppress warnings
|
||||
local $SIG{'__WARN__'} = sub { 1 };
|
||||
# escape any non-ascii characters for HTML
|
||||
$str =~ s/([\xc2-\xf7][\x80-\xbf]+)/EscapeChar($1)/sge;
|
||||
}
|
||||
return $str;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Unescape all HTML character references
|
||||
# Inputs: 0) string to be unescaped
|
||||
# Returns: unescaped string
|
||||
sub UnescapeHTML($)
|
||||
{
|
||||
return UnescapeXML(shift, \%entityNum);
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Extract information from a HTML file
|
||||
# Inputs: 0) ExifTool object reference, 1) DirInfo reference
|
||||
# Returns: 1 on success, 0 if this wasn't a valid HTML file
|
||||
sub ProcessHTML($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $buff;
|
||||
|
||||
# validate HTML or XHTML file
|
||||
$raf->Read($buff, 256) or return 0;
|
||||
$buff =~ /^(\xef\xbb\xbf)?\s*<(!DOCTYPE\s+HTML|HTML|\?xml)/i or return 0;
|
||||
$buff =~ /<(!DOCTYPE\s+)?HTML/i or return 0 if $2 eq '?xml';
|
||||
$et->SetFileType();
|
||||
|
||||
$raf->Seek(0,0) or $et->Warn('Seek error'), return 1;
|
||||
|
||||
local $/ = Image::ExifTool::PostScript::GetInputRecordSeparator($raf);
|
||||
$/ or $et->Warn('Invalid HTML data'), return 1;
|
||||
|
||||
# extract header information
|
||||
my $doc;
|
||||
while ($raf->ReadLine($buff)) {
|
||||
if (not defined $doc) {
|
||||
# look for 'head' element
|
||||
next unless $buff =~ /<head\b/ig;
|
||||
$doc = substr($buff, pos($buff));
|
||||
next;
|
||||
}
|
||||
$doc .= $buff;
|
||||
last if $buff =~ m{</head>}i;
|
||||
}
|
||||
return 1 unless defined $doc;
|
||||
|
||||
# process all elements in header
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::HTML::Main');
|
||||
for (;;) {
|
||||
last unless $doc =~ m{<([\w:.-]+)(.*?)>}sg;
|
||||
my ($tagName, $attrs) = ($1, $2);
|
||||
my $tag = lc($tagName);
|
||||
my ($val, $grp);
|
||||
if ($attrs =~ m{/$}) { # self-contained XHTML tags end in '/>'
|
||||
$val = '';
|
||||
} else {
|
||||
# look for element close
|
||||
my $pos = pos($doc);
|
||||
my $close = "</$tagName>";
|
||||
# the following doesn't work on Solaris Perl 5.6.1 due to Perl bug:
|
||||
# if ($doc =~ m{(.*?)</$tagName>}sg) {
|
||||
# $val = $1;
|
||||
if ($doc =~ m{$close}sg) {
|
||||
$val = substr($doc, $pos, pos($doc)-$pos-length($close));
|
||||
} else {
|
||||
pos($doc) = $pos;
|
||||
next unless $tag eq 'meta'; # META tags don't need to be closed
|
||||
$val = '';
|
||||
}
|
||||
}
|
||||
my $table = $tagTablePtr;
|
||||
if ($tag eq 'meta') {
|
||||
# parse HTML META element
|
||||
undef $tag;
|
||||
# tag name is in NAME or HTTP-EQUIV attribute
|
||||
if ($attrs =~ /\bname\s*=\s*['"]?([\w:.-]+)/si) {
|
||||
$tagName = $1;
|
||||
} elsif ($attrs =~ /\bhttp-equiv\s*=\s*['"]?([\w:.-]+)/si) {
|
||||
$tagName = "HTTP-equiv.$1";
|
||||
} else {
|
||||
next; # no name
|
||||
}
|
||||
$tag = lc($tagName) or next;
|
||||
# tag value is in CONTENT attribute
|
||||
if ($attrs =~ /\bcontent\s*=\s*(['"])(.*?)\1/si or
|
||||
$attrs =~ /\bcontent\s*=\s*(['"]?)([\w:.-]+)/si)
|
||||
{
|
||||
$val = $2;
|
||||
} else {
|
||||
next unless length $val;
|
||||
}
|
||||
# isolate group name (separator is '.' in HTML, but ':' in ref 2)
|
||||
if ($tag =~ /^([\w-]+)[:.]([\w-]+)/) {
|
||||
($grp, $tag) = ($1, $2);
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, $grp);
|
||||
if ($tagInfo and $$tagInfo{SubDirectory}) {
|
||||
$table = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
|
||||
} else {
|
||||
$tag = "$grp.$tag";
|
||||
}
|
||||
}
|
||||
} elsif ($tag eq 'xml') {
|
||||
$et->VPrint(0, "Parsing XML\n");
|
||||
# parse XML tags (quick-and-dirty)
|
||||
my $xml = $val;
|
||||
while ($xml =~ /<([\w-]+):([\w-]+)(\s.*?)?>([^<]*?)<\/\1:\2>/g) {
|
||||
($grp, $tag, $val) = ($1, $2, $4);
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, $grp);
|
||||
next unless $tagInfo and $$tagInfo{SubDirectory};
|
||||
$table = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
|
||||
unless ($$table{$tag}) {
|
||||
my $name = ucfirst $tag;
|
||||
$name =~ s/_x([0-9a-f]{4})_/chr(hex($1))/gie; # convert hex codes
|
||||
$name =~ s/\s(.)/\U$1/g; # capitalize all words in tag name
|
||||
$name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters (also hex code wide chars)
|
||||
AddTagToTable($table, $tag, { Name => $name });
|
||||
$et->VPrint(0, " [adding $tag '${name}']\n");
|
||||
}
|
||||
$val = $et->Decode($val, $$et{HTMLCharset}) if $$et{HTMLCharset};
|
||||
$et->HandleTag($table, $tag, UnescapeXML($val));
|
||||
}
|
||||
next;
|
||||
} else {
|
||||
# the only other element we process is TITLE
|
||||
next unless $tag eq 'title';
|
||||
}
|
||||
unless ($$table{$tag}) {
|
||||
my $name = $tagName;
|
||||
$name =~ s/\W+(\w)/\u$1/sg;
|
||||
my $info = { Name => $name, Groups => { 0 => 'HTML' } };
|
||||
$info->{Groups}->{1} = ($grp eq 'http-equiv' ? 'HTTP-equiv' : "HTML-$grp") if $grp;
|
||||
AddTagToTable($table, $tag, $info);
|
||||
$et->VPrint(0, " [adding $tag '${tagName}']\n");
|
||||
}
|
||||
# recode if necessary
|
||||
$val = $et->Decode($val, $$et{HTMLCharset}) if $$et{HTMLCharset};
|
||||
$val =~ s{\s*$/\s*}{ }sg; # replace linefeeds and indenting spaces
|
||||
$val = UnescapeHTML($val); # unescape HTML character references
|
||||
$et->HandleTag($table, $tag, $val);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::HTML - Read HTML meta information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains routines required by Image::ExifTool to extract
|
||||
meta information from HTML documents.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://www.w3.org/TR/html4/>
|
||||
|
||||
=item L<http://www.daisy.org/publications/specifications/daisy_202.html>
|
||||
|
||||
=item L<http://vancouver-webpages.com/META/metatags.detail.html>
|
||||
|
||||
=item L<http://www.html-reference.com/META.htm>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/HTML Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,898 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: HtmlDump.pm
|
||||
#
|
||||
# Description: Dump information in hex to HTML page
|
||||
#
|
||||
# Revisions: 12/05/2005 - P. Harvey Created
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::HtmlDump;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool; # only for FinishTiffDump()
|
||||
use Image::ExifTool::HTML qw(EscapeHTML);
|
||||
|
||||
$VERSION = '1.34';
|
||||
|
||||
sub DumpTable($$$;$$$$$);
|
||||
sub Open($$$;@);
|
||||
sub Write($@);
|
||||
|
||||
my ($bkgStart, $bkgEnd, @bkgSpan);
|
||||
|
||||
my $htmlHeader1 = <<_END_PART_1_;
|
||||
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
|
||||
"http://www.w3.org/TR/1998/REC-html40-19980424/loose.dtd">
|
||||
<html>
|
||||
<head>
|
||||
<title>
|
||||
_END_PART_1_
|
||||
|
||||
# Note: Don't change font-weight style because it can affect line height
|
||||
my $htmlHeader2 = <<_END_PART_2_;
|
||||
</title>
|
||||
<style type="text/css">
|
||||
<!--
|
||||
/* character style ID's */
|
||||
.D { color: #000000 } /* default color */
|
||||
.V { color: #ff0000 } /* duplicate block 1 */
|
||||
.W { color: #004400 } /* normal block 1 */
|
||||
.X { color: #ff4488 } /* duplicate block 2 */
|
||||
.Y { color: #448844 } /* normal block 2 */
|
||||
.U { color: #cc8844 } /* unused data block */
|
||||
.H { color: #0000ff } /* highlighted tag name */
|
||||
.F { color: #aa00dd } /* actual offset differs */
|
||||
.M { text-decoration: underline } /* maker notes data */
|
||||
.tt { /* tooltip text */
|
||||
visibility: hidden;
|
||||
position: absolute;
|
||||
white-space: nowrap;
|
||||
top: 0;
|
||||
left: 0;
|
||||
font-family: Verdana, sans-serif;
|
||||
font-size: .7em;
|
||||
padding: 2px 4px;
|
||||
border: 1px solid gray;
|
||||
z-index: 3;
|
||||
}
|
||||
.tb { /* tooltip background */
|
||||
visibility: hidden;
|
||||
position: absolute;
|
||||
background: #ffffdd;
|
||||
zoom: 1;
|
||||
-moz-opacity: 0.8;
|
||||
-khtml-opacity: 0.8;
|
||||
-ms-filter: 'progid:DXImageTransform.Microsoft.Alpha(Opacity=80)';
|
||||
filter: alpha(opacity=80);
|
||||
opacity: 0.8;
|
||||
z-index: 2;
|
||||
}
|
||||
/* table styles */
|
||||
table.dump {
|
||||
border-top: 1px solid gray;
|
||||
border-bottom: 1px solid gray;
|
||||
}
|
||||
table.dump td { padding: .2em .3em }
|
||||
td.c2 {
|
||||
border-left: 1px solid gray;
|
||||
border-right: 1px solid gray;
|
||||
}
|
||||
pre { margin: 0 }
|
||||
table { font-size: .9em }
|
||||
body { color: black; background: white }
|
||||
-->
|
||||
</style>
|
||||
<script language="JavaScript" type="text/JavaScript">
|
||||
<!-- Begin
|
||||
// tooltip positioning constants
|
||||
var TMAR = 4; // top/left margins
|
||||
var BMAR = 16; // bottom/right margins (scrollbars may overhang inner dimensions)
|
||||
var XOFF = 10; // x offset from cursor
|
||||
var YOFF = 40; // y offset
|
||||
var YMIN = 10; // minimum y offset
|
||||
var YTOP = 20; // y offset when above cursor
|
||||
// common variables
|
||||
var safari1 = navigator.userAgent.indexOf("Safari/312.6") >= 0;
|
||||
var ie6 = navigator.userAgent.toLowerCase().indexOf('msie 6') >= 0;
|
||||
var mspan = new Array;
|
||||
var hlist, tt, tb;
|
||||
|
||||
function GetElementsByClass(classname, tagname) {
|
||||
var found = new Array();
|
||||
var list = document.getElementsByTagName(tagname);
|
||||
var len = list.length;
|
||||
for (var i=0, j=0; i<len; ++i) {
|
||||
var classes = list[i].className.split(' ');
|
||||
for (var k=0; k<classes.length; ++k) {
|
||||
if (classes[k] == classname) {
|
||||
found[j++] = list[i];
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
delete list;
|
||||
return found;
|
||||
}
|
||||
|
||||
// move tooltip
|
||||
function move(e)
|
||||
{
|
||||
if (!tt) return;
|
||||
if (ie6 && (tt.style.top == '' || tt.style.top == 0) &&
|
||||
(tt.style.left == '' || tt.style.left == 0))
|
||||
{
|
||||
tt.style.width = tt.offsetWidth + 'px';
|
||||
tt.style.height = tt.offsetHeight + 'px';
|
||||
}
|
||||
var w, h;
|
||||
// browser inconsistencies make getting window size more complex than it should be,
|
||||
// and even then we don't know if it is smaller due to scrollbar width
|
||||
if (typeof(window.innerWidth) == 'number') {
|
||||
w = window.innerWidth;
|
||||
h = window.innerHeight;
|
||||
} else if (document.documentElement && document.documentElement.clientWidth) {
|
||||
w = document.documentElement.clientWidth;
|
||||
h = document.documentElement.clientHeight;
|
||||
} else {
|
||||
w = document.body.clientWidth;
|
||||
h = document.body.clientHeight;
|
||||
}
|
||||
var x = e.clientX + XOFF;
|
||||
var y = e.clientY + YOFF;
|
||||
if (safari1) { // patch for people still using OS X 10.3.9
|
||||
x -= document.body.scrollLeft + document.documentElement.scrollLeft;
|
||||
y -= document.body.scrollTop + document.documentElement.scrollTop;
|
||||
}
|
||||
var mx = w - BMAR - tt.offsetWidth;
|
||||
var my = h - BMAR - tt.offsetHeight;
|
||||
if (y > my + YOFF - YMIN) y = e.clientY - YTOP - tt.offsetHeight;
|
||||
if (x > mx) x = mx;
|
||||
if (y > my) y = my;
|
||||
if (x < TMAR) x = TMAR;
|
||||
if (y < TMAR) y = TMAR;
|
||||
x += document.body.scrollLeft + document.documentElement.scrollLeft;
|
||||
y += document.body.scrollTop + document.documentElement.scrollTop;
|
||||
tb.style.width = tt.offsetWidth + 'px';
|
||||
tb.style.height = tt.offsetHeight + 'px';
|
||||
tt.style.top = tb.style.top = y + 'px';
|
||||
tt.style.left = tb.style.left = x + 'px';
|
||||
tt.style.visibility = tb.style.visibility = 'visible';
|
||||
}
|
||||
|
||||
// highlight/unhighlight text
|
||||
function high(e,on) {
|
||||
var targ;
|
||||
if (e.target) targ = e.target;
|
||||
else if (e.srcElement) targ = e.srcElement;
|
||||
if (targ.nodeType == 3) targ = targ.parentNode; // defeat Safari bug
|
||||
if (!targ.name) targ = targ.parentNode; // go up another level if necessary
|
||||
if (targ.name && document.getElementsByName) {
|
||||
// un-highlight current objects
|
||||
if (hlist) {
|
||||
for (var i=0; i<hlist.length; ++i) {
|
||||
hlist[i].style.background = 'transparent';
|
||||
}
|
||||
hlist = null;
|
||||
}
|
||||
if (tt) {
|
||||
// hide old tooltip
|
||||
tt.style.visibility = tb.style.visibility = 'hidden';
|
||||
tt = null;
|
||||
}
|
||||
if (on) {
|
||||
if (targ.name.substring(0,1) == 't') {
|
||||
// show our tooltip (ID is different than name to avoid confusing IE)
|
||||
tt = document.getElementById('p' + targ.name.substring(1));
|
||||
if (tt) {
|
||||
tb = document.getElementById('tb');
|
||||
move(e);
|
||||
}
|
||||
}
|
||||
// highlight anchor elements with the same name
|
||||
hlist = document.getElementsByName(targ.name);
|
||||
// use class name to highlight span elements if necessary
|
||||
for (var i=0; i<mspan.length; ++i) {
|
||||
if (mspan[i] != targ.name) continue;
|
||||
var slist = GetElementsByClass(targ.name, 'span');
|
||||
// add elements from hlist collection to our array
|
||||
for (var j=0; j<hlist.length; ++j) {
|
||||
slist[slist.length] = hlist[j];
|
||||
}
|
||||
hlist = slist;
|
||||
break;
|
||||
}
|
||||
for (var j=0; j<hlist.length; ++j) {
|
||||
hlist[j].style.background = '#ffcc99';
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
_END_PART_2_
|
||||
|
||||
my $htmlHeader3 = q[
|
||||
// End --->
|
||||
</script></head>
|
||||
<body><noscript><b class=V>-->
|
||||
Enable JavaScript for active highlighting and information tool tips!
|
||||
</b></noscript>
|
||||
<table class=dump cellspacing=0 cellpadding=2>
|
||||
<tr><td valign='top'><pre>];
|
||||
|
||||
my $preMouse = q(<pre onmouseover="high(event,1)" onmouseout="high(event,0)" onmousemove="move(event)">);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# 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)
|
||||
# Bits: 0x01 - print at start of line
|
||||
# 0x02 - print red address
|
||||
# 0x04 - maker notes data ('M'-class span)
|
||||
# 0x08 - limit block length
|
||||
# 0x10 - allow double references
|
||||
# 0x100 - (reserved)
|
||||
# Notes: Block will be shown in 'unused' color if comment string begins with '['
|
||||
sub Add($$$$;$)
|
||||
{
|
||||
my ($self, $start, $size, $msg, $tip, $flag) = @_;
|
||||
my $block = $$self{Block};
|
||||
$$block{$start} or $$block{$start} = [ ];
|
||||
my $htip;
|
||||
if ($tip and $tip eq 'SAME') {
|
||||
$htip = '';
|
||||
} else {
|
||||
# use message as first line of tip, and make bold unless in brackets
|
||||
$htip = ($msg =~ /^[[(]/) ? $msg : "<b>$msg</b>";
|
||||
if (defined $tip) {
|
||||
($tip = EscapeHTML($tip)) =~ s/\n/<br>/g; # HTML-ize tooltip text
|
||||
$htip .= '<br>' . $tip;
|
||||
}
|
||||
# add size if not already done
|
||||
$htip .= "<br>($size bytes)" unless $htip =~ /<br>Size:/;
|
||||
++$self->{TipNum};
|
||||
}
|
||||
push @{$$block{$start}}, [ $size, $msg, $htip, $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
|
||||
# Note: The "Error" member may be set externally to print a specific error
|
||||
# message instead of doing the dump.
|
||||
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 $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;
|
||||
undef @bkgSpan;
|
||||
my $index = 0; # initialize tooltip index
|
||||
my (@names, $wasUnused, @starts);
|
||||
# only do dump if we didn't have a serious error
|
||||
@starts = sort { $a <=> $b } keys %$block unless $$self{Error};
|
||||
for ($i=0; $i<=@starts; ++$i) {
|
||||
my $start = $starts[$i];
|
||||
my $parmList;
|
||||
if (defined $start) {
|
||||
$parmList = $$block{$start};
|
||||
} elsif ($bkgEnd and $pos < $bkgEnd and not defined $wasUnused) {
|
||||
$start = $bkgEnd; # finish last bkg block
|
||||
} else {
|
||||
last;
|
||||
}
|
||||
my $len = $start - $pos;
|
||||
if ($len > 0 and not $wasUnused) {
|
||||
# we have a unused bytes before this data block
|
||||
--$i; # dump the data block next time around
|
||||
# split unused data into 2 blocks if it spans end of a bkg block
|
||||
my ($nextBkgEnd, $bkg);
|
||||
if (not defined $wasUnused and $bkgEnd) {
|
||||
foreach $bkg (@bkgSpan) {
|
||||
next if $pos >= $$bkg{End} + $dataPos or $pos + $len <= $$bkg{End} + $dataPos;
|
||||
$nextBkgEnd = $$bkg{End} unless $nextBkgEnd and $nextBkgEnd < $$bkg{End};
|
||||
}
|
||||
}
|
||||
if ($nextBkgEnd) {
|
||||
$start = $pos;
|
||||
$len = $nextBkgEnd + $dataPos - $pos;
|
||||
$wasUnused = 0;
|
||||
} else {
|
||||
$start = $pos; # dump the unused bytes now
|
||||
$wasUnused = 1; # avoid re-dumping unused bytes if we get a read error
|
||||
}
|
||||
my $str = ($len > 1) ? "unused $len bytes" : 'pad byte';
|
||||
$parmList = [ [ $len, "[$str]", undef, 0x108 ] ];
|
||||
} 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 & 0x14) {
|
||||
my %bkg = (
|
||||
Class => $flag & 0x04 ? "$name M" : $name,
|
||||
Start => $start - $dataPos,
|
||||
End => $start - $dataPos + $len,
|
||||
);
|
||||
push @bkgSpan, \%bkg;
|
||||
$bkgStart = $bkg{Start} unless $bkgStart and $bkgStart < $bkg{Start};
|
||||
$bkgEnd = $bkg{End} unless $bkgEnd and $bkgEnd > $bkg{End};
|
||||
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
|
||||
# (read 32 more bytes than necessary just in case there
|
||||
# is only one skipped line that we decide to print)
|
||||
my $size = ($len > $limit + 32) ? $limit / 2 + 16 : $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 .= "<br>Error: Only $len bytes available!" if $tip;
|
||||
next;
|
||||
}
|
||||
$buff .= $buf2;
|
||||
undef $buf2;
|
||||
}
|
||||
} else {
|
||||
$err = $msg;
|
||||
$len = length $buff;
|
||||
$tip .= "<br>Error: Only $len bytes available!" if $tip;
|
||||
}
|
||||
}
|
||||
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));
|
||||
}
|
||||
Write($outfile, $htmlHeader3, $self->{Cols}->[0]);
|
||||
Write($outfile, '</pre></td><td valign="top">',
|
||||
$preMouse, $self->{Cols}->[1]);
|
||||
Write($outfile, '</pre></td><td class=c2 valign="top">',
|
||||
$preMouse, $self->{Cols}->[2]);
|
||||
Write($outfile, '</pre></td><td valign="top">',
|
||||
$preMouse, $self->{Cols}->[3]);
|
||||
Write($outfile, "</pre></td></tr></table>\n<div id=tb class=tb> </div>\n");
|
||||
my $tips = \@{$$self{TipList}};
|
||||
for ($i=0; $i<@$tips; ++$i) {
|
||||
my $tip = $$tips[$i];
|
||||
Write($outfile, "<div id=p$i class=tt>$tip</div>\n") if defined $tip;
|
||||
}
|
||||
delete $$self{TipList};
|
||||
$rtnVal = 1;
|
||||
} else {
|
||||
my $err = $$self{Error} || 'No EXIF or TIFF information found in image';
|
||||
Write($outfile, "$title</title></head><body>\n$err\n");
|
||||
$rtnVal = 0;
|
||||
}
|
||||
Write($outfile, "</body></html>\n");
|
||||
for ($i=0; $i<4; ++$i) {
|
||||
$self->{Cols}->[$i] = ''; # free memory
|
||||
}
|
||||
if ($err) {
|
||||
$err =~ tr/()//d;
|
||||
$$self{ERROR} = $err;
|
||||
return -1;
|
||||
}
|
||||
return $rtnVal;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Open or close a specified html element
|
||||
# Inputs: 0) HtmlDump object ref, 1) element id, 2) element string,
|
||||
# 3-N) list of column numbers (empty for all columns)
|
||||
# - element id may be '' to close all elements
|
||||
# - element string may be '' to close element by ID (or 0 to close without reopening)
|
||||
# - element id and string may both be 1 to reopen temporarily closed elements
|
||||
sub Open($$$;@)
|
||||
{
|
||||
my ($self, $id, $element, @colNums) = @_;
|
||||
|
||||
# loop through specified columns
|
||||
@colNums or @colNums = (0 .. $#{$self->{Open}});
|
||||
my $col;
|
||||
foreach $col (@colNums) {
|
||||
# get information about open elements in this column
|
||||
my $opHash = $self->{Open}->[$col];
|
||||
my $opElem = $$opHash{Element};
|
||||
if ($element) {
|
||||
# next if already open
|
||||
next if $$opElem{$id} and $$opElem{$id} eq $element;
|
||||
} elsif ($id and not $$opElem{$id}) {
|
||||
# next if already closed and nothing to reopen
|
||||
next unless $element eq '' and @{$self->{Closed}->[$col]->{ID}};
|
||||
}
|
||||
my $opID = $$opHash{ID};
|
||||
my $clHash = $self->{Closed}->[$col];
|
||||
my $clID = $$clHash{ID};
|
||||
my $clElem = $$clHash{Element};
|
||||
# get reference to output column list (use temp list if available)
|
||||
my $cols = $$self{TmpCols} || $$self{Cols};
|
||||
# close everything down to this element if necessary
|
||||
if ($$opElem{$id} or not $id) {
|
||||
while (@$opID) {
|
||||
my $tid = pop @$opID;
|
||||
my $e = $$opElem{$tid};
|
||||
$e =~ s/^<(\S+).*/<\/$1>/s;
|
||||
$$cols[$col] .= $e;
|
||||
if ($id eq $tid or not $id) {
|
||||
delete $$opElem{$tid};
|
||||
last if $id;
|
||||
next;
|
||||
}
|
||||
# add this to the temporarily closed list
|
||||
# (because we really didn't want to close it)
|
||||
push @$clID, $tid;
|
||||
$$clElem{$tid} = $$opElem{$tid};
|
||||
delete $$opElem{$tid};
|
||||
}
|
||||
unless ($id) {
|
||||
# forget all temporarily closed elements
|
||||
$clID = $$clHash{ID} = [ ];
|
||||
$clElem = $$clHash{Element} = { };
|
||||
}
|
||||
} elsif ($$clElem{$id}) {
|
||||
# delete from the list of temporarily closed elements
|
||||
delete $$clElem{$id};
|
||||
@$clID = grep !/^$id$/, @$clID;
|
||||
}
|
||||
next if $element eq '0'; # 0 = don't reopen temporarily closed elements
|
||||
|
||||
# re-open temporarily closed elements
|
||||
while (@$clID) {
|
||||
my $tid = pop @$clID;
|
||||
$$cols[$col] .= $$clElem{$tid};
|
||||
push @$opID, $tid;
|
||||
$$opElem{$tid} = $$clElem{$tid};
|
||||
delete $$clElem{$tid};
|
||||
}
|
||||
# open specified element
|
||||
if ($element and $element ne '1') {
|
||||
$$cols[$col] .= $element;
|
||||
push @$opID, $id;
|
||||
$$opElem{$id} = $element;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Dump a block of data in HTML table form
|
||||
# Inputs: 0) HtmlDump object ref, 1) data position, 2) block pointer,
|
||||
# 3) message, 4) object name, 5) flag, 6) full block length (actual
|
||||
# data may be shorter), 7) data end position
|
||||
sub DumpTable($$$;$$$$$)
|
||||
{
|
||||
my ($self, $pos, $blockPt, $msg, $name, $flag, $len, $endPos) = @_;
|
||||
$len = length $$blockPt unless defined $len;
|
||||
$endPos = 0 unless $endPos;
|
||||
my ($f0, $dblRef, $id);
|
||||
my $skipped = 0;
|
||||
if (($endPos and $pos < $endPos) or $flag & 0x02) {
|
||||
# display double-reference addresses in red
|
||||
$f0 = "<span class=V>";
|
||||
$dblRef = 1 if $endPos and $pos < $endPos;
|
||||
} else {
|
||||
$f0 = '';
|
||||
}
|
||||
my @c = ('','','','');
|
||||
$$self{TmpCols} = \@c;
|
||||
if ($name) {
|
||||
if ($msg and $msg =~ /^\[/) {
|
||||
$id = 'U';
|
||||
} else {
|
||||
if ($$self{A}) {
|
||||
$id = 'X';
|
||||
$$self{A} = 0;
|
||||
} else {
|
||||
$id = 'V';
|
||||
$$self{A} = 1;
|
||||
}
|
||||
++$id unless $dblRef;
|
||||
}
|
||||
$name = "<a name=$name class=$id>";
|
||||
$msg and $msg = "$name$msg</a>";
|
||||
} else {
|
||||
$name = '';
|
||||
}
|
||||
# use base-relative offsets from now on
|
||||
my $cols = 0;
|
||||
my $p = $pos;
|
||||
if ($$self{Cont}) {
|
||||
$cols = $pos & 0x0f;
|
||||
$c[1] .= ($cols == 8) ? ' ' : ' ';
|
||||
} else {
|
||||
my $addr = $pos < 0 ? sprintf("-%.4x",-$pos) : sprintf("%5.4x",$pos);
|
||||
$self->Open('fgd', $f0, 0);
|
||||
$self->Open('fgd', '', 3);
|
||||
$c[0] .= "$addr";
|
||||
$p -= $pos & 0x0f unless $flag & 0x01;
|
||||
if ($p < $pos) {
|
||||
$self->Open('bkg', '', 1, 2); # don't underline white space
|
||||
$cols = $pos - $p;
|
||||
my $n = 3 * $cols;
|
||||
++$n if $cols > 7;
|
||||
$c[1] .= ' ' x $n;
|
||||
$c[2] .= ' ' x $cols;
|
||||
$p = $pos;
|
||||
}
|
||||
}
|
||||
# loop through each column of hex numbers
|
||||
for (;;) {
|
||||
my (@spanClass, @spanCont, $spanClose, $bkg);
|
||||
if ($p >= $bkgStart and $p < $bkgEnd) {
|
||||
foreach $bkg (@bkgSpan) {
|
||||
next unless $p >= $$bkg{Start} and $p < $$bkg{End};
|
||||
push @spanClass, $$bkg{Class};
|
||||
if ($p + 1 == $$bkg{End}) {
|
||||
$spanClose = 1;
|
||||
} else {
|
||||
push @spanCont, $$bkg{Class}; # this span continues
|
||||
}
|
||||
}
|
||||
$self->Open('bkg', @spanClass ? "<span class='@spanClass'>" : '', 1, 2);
|
||||
} else {
|
||||
$self->Open('bkg', '', 1, 2);
|
||||
}
|
||||
$self->Open('a', $name, 1, 2);
|
||||
my $ch = substr($$blockPt,$p-$pos-$skipped,1);
|
||||
$c[1] .= sprintf("%.2x", ord($ch));
|
||||
# make the character HTML-friendly
|
||||
$ch =~ tr/\x00-\x1f\x7f-\xff/./;
|
||||
$ch =~ s/&/&/g;
|
||||
$ch =~ s/>/>/g;
|
||||
$ch =~ s/</</g;
|
||||
$c[2] .= $ch;
|
||||
++$p;
|
||||
++$cols;
|
||||
# close necessary elements
|
||||
if ($spanClose) {
|
||||
my $spanCont = @spanCont ? "<span class='@spanCont'>" : '';
|
||||
# close without reopening if closing anchor later
|
||||
my $arg = ($p - $pos >= $len) ? 0 : $spanCont;
|
||||
$self->Open('bkg', $arg, 1, 2);
|
||||
}
|
||||
if ($dblRef and $p >= $endPos) {
|
||||
$dblRef = 0;
|
||||
++$id;
|
||||
$name =~ s/class=\w\b/class=$id/;
|
||||
$f0 = '';
|
||||
$self->Open('fgd', $f0, 0);
|
||||
}
|
||||
if ($p - $pos >= $len) {
|
||||
$self->Open('a', '', 1, 2); # close our anchor
|
||||
last;
|
||||
}
|
||||
if ($cols < 16) {
|
||||
$c[1] .= ($cols == 8 ? ' ' : ' ');
|
||||
next;
|
||||
} elsif ($flag & 0x01 and $cols < $len) {
|
||||
$c[1] .= ' ';
|
||||
next; # put it all on one line
|
||||
}
|
||||
unless ($$self{Msg}) {
|
||||
$c[3] .= $msg;
|
||||
$msg = '';
|
||||
}
|
||||
$_ .= "\n" foreach @c; # add CR to all lines
|
||||
$$self{Msg} = 0;
|
||||
# limit data length if specified
|
||||
if ($$self{Limit}) {
|
||||
my $div = ($flag & 0x08) ? 4 : 1;
|
||||
my $lim = $$self{Limit} / (2 * $div) - 16;
|
||||
if ($p - $pos > $lim and $len - $p + $pos > $lim) {
|
||||
my $n = ($len - $p + $pos - $lim) & ~0x0f;
|
||||
if ($n > 16) { # (no use just cutting out one line)
|
||||
$self->Open('bkg', '', 1, 2); # no underline
|
||||
my $note = sprintf "[snip %d lines]", $n / 16;
|
||||
$note = (' ' x (24-length($note)/2)) . $note;
|
||||
$c[0] .= " ...\n";
|
||||
$c[1] .= $note . (' ' x (48-length($note))) . "\n";
|
||||
$c[2] .= " [snip] \n";
|
||||
$c[3] .= "\n";
|
||||
$p += $n;
|
||||
$skipped += $len - length $$blockPt;
|
||||
}
|
||||
}
|
||||
}
|
||||
$c[0] .= ($p < 0 ? sprintf("-%.4x",-$p) : sprintf("%5.4x",$p));
|
||||
$cols = 0;
|
||||
}
|
||||
if ($msg) {
|
||||
$msg = " $msg" if $$self{Msg};
|
||||
$c[3] .= $msg;
|
||||
}
|
||||
if ($flag & 0x100 and $cols < 16) { # continue on same line?
|
||||
$$self{Cont} = 1;
|
||||
$$self{Msg} = 1 if $msg;
|
||||
} else {
|
||||
$_ .= "\n" foreach @c;
|
||||
$$self{Msg} = 0;
|
||||
$$self{Cont} = 0;
|
||||
}
|
||||
# add temporary column data to our real columns
|
||||
my $i;
|
||||
for ($i=0; $i<4; ++$i) {
|
||||
$self->{Cols}->[$i] .= $c[$i];
|
||||
}
|
||||
delete $$self{TmpCols};
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Finish dumping of TIFF image data
|
||||
# Inputs: 0) HtmlDump object ref, 1) ExifTool object ref, 2) length of file
|
||||
# (this really belongs in Image::ExifTool::Exif, but is placed here so it
|
||||
# is only compiled when needed)
|
||||
sub FinishTiffDump($$$)
|
||||
{
|
||||
my ($self, $et, $size) = @_;
|
||||
my ($tag, $key, $start, $blockInfo, $i);
|
||||
|
||||
# list of all indirectly referenced TIFF data tags
|
||||
my %offsetPair = (
|
||||
StripOffsets => 'StripByteCounts',
|
||||
TileOffsets => 'TileByteCounts',
|
||||
FreeOffsets => 'FreeByteCounts',
|
||||
ThumbnailOffset => 'ThumbnailLength',
|
||||
PreviewImageStart => 'PreviewImageLength',
|
||||
JpgFromRawStart => 'JpgFromRawLength',
|
||||
OtherImageStart => 'OtherImageLength',
|
||||
ImageOffset => 'ImageByteCount',
|
||||
AlphaOffset => 'AlphaByteCount',
|
||||
MPImageStart => 'MPImageLength',
|
||||
IDCPreviewStart => 'IDCPreviewLength',
|
||||
SamsungRawPointersOffset => 'SamsungRawPointersLength',
|
||||
);
|
||||
|
||||
# add TIFF data to html dump
|
||||
foreach $tag (keys %offsetPair) {
|
||||
my $info = $et->GetInfo($tag);
|
||||
next unless %$info;
|
||||
# Panasonic hack: StripOffsets is not valid for Panasonic RW2 files,
|
||||
# and StripRowBytes is not valid for some RAW images
|
||||
if ($tag eq 'StripOffsets' and $$et{TAG_INFO}{$tag}{PanasonicHack}) {
|
||||
# use RawDataOffset instead if available since it is valid in RW2
|
||||
my $info2 = $et->GetInfo('RawDataOffset');
|
||||
$info2 = $info unless %$info2;
|
||||
my @keys = keys %$info2;
|
||||
my $offset = $$info2{$keys[0]};
|
||||
my $raf = $$et{RAF};
|
||||
# ignore StripByteCounts and assume raw data runs to the end of file
|
||||
if (@keys == 1 and $offset =~ /^\d+$/ and $raf) {
|
||||
my $pos = $raf->Tell();
|
||||
$raf->Seek(0, 2); # seek to end
|
||||
my $len = $raf->Tell() - $offset;
|
||||
$raf->Seek($pos, 0);
|
||||
if ($len > 0) {
|
||||
$self->Add($offset, $len, "(Panasonic raw data)", "Size: $len bytes", 0x08);
|
||||
next;
|
||||
}
|
||||
}
|
||||
}
|
||||
# loop through all offsets tags
|
||||
foreach $key (keys %$info) {
|
||||
my $name = Image::ExifTool::GetTagName($key);
|
||||
my $grp1 = $et->GetGroup($key, 1);
|
||||
my $info2 = $et->GetInfo($offsetPair{$tag}, { Group1 => $grp1 });
|
||||
my $key2 = $offsetPair{$tag};
|
||||
$key2 .= $1 if $key =~ /( .*)/; # use same instance number as $tag
|
||||
next unless $$info2{$key2};
|
||||
my $offsets = $$info{$key};
|
||||
my $byteCounts = $$info2{$key2};
|
||||
# ignore primary MPImage (this is the whole JPEG)
|
||||
next if $tag eq 'MPImageStart' and $offsets eq '0';
|
||||
# (long lists may be SCALAR references)
|
||||
my @offsets = split ' ', (ref $offsets ? $$offsets : $offsets);
|
||||
my @byteCounts = split ' ', (ref $byteCounts ? $$byteCounts : $byteCounts);
|
||||
my $num = scalar @offsets;
|
||||
my $li = 0;
|
||||
my $padBytes = 0;
|
||||
for ($i=0; @offsets and @byteCounts; ++$i) {
|
||||
my $offset = shift @offsets;
|
||||
my $byteCount = shift @byteCounts;
|
||||
my $end = $offset + $byteCount;
|
||||
if (@offsets and @byteCounts) {
|
||||
# show data as contiguous if only normal pad bytes between blocks
|
||||
if ($end & 0x01 and $end + 1 == $offsets[0]) {
|
||||
$end += 1;
|
||||
++$padBytes; # count them
|
||||
}
|
||||
if ($end == $offsets[0]) {
|
||||
# combine these two blocks
|
||||
$byteCounts[0] += $offsets[0] - $offset;
|
||||
$offsets[0] = $offset;
|
||||
next;
|
||||
}
|
||||
}
|
||||
my $msg = $et->GetGroup($key, 1) . ':' . $tag;
|
||||
$msg =~ s/(Offsets?|Start)$/ /;
|
||||
if ($num > 1) {
|
||||
$msg .= "$li-" if $li != $i;
|
||||
$msg .= "$i ";
|
||||
$li = $i + 1;
|
||||
}
|
||||
$msg .= "data";
|
||||
my $tip = "Size: $byteCount bytes";
|
||||
$tip .= ", incl. $padBytes pad bytes" if $padBytes;
|
||||
$self->Add($offset, $byteCount, "($msg)", $tip, 0x08);
|
||||
}
|
||||
}
|
||||
}
|
||||
# find offset of last dumped information, and dump any unknown trailer
|
||||
my $last = 0;
|
||||
my $block = $$self{Block};
|
||||
foreach $start (keys %$block) {
|
||||
foreach $blockInfo (@{$$block{$start}}) {
|
||||
my $end = $start + $$blockInfo[0];
|
||||
$last = $end if $last < $end;
|
||||
}
|
||||
}
|
||||
my $diff = $size - $last;
|
||||
if ($diff > 0 and ($last or $et->Options('Unknown'))) {
|
||||
if ($diff > 1 or $size & 0x01) {
|
||||
$self->Add($last, $diff, "[unknown data]", "Size: $diff bytes", 0x08);
|
||||
} else {
|
||||
$self->Add($last, $diff, "[trailing pad byte]", undef, 0x08);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# utility routine to write to file or memory
|
||||
# Inputs: 0) file or scalar reference, 1-N) list of stuff to write
|
||||
# Returns: true on success
|
||||
sub Write($@)
|
||||
{
|
||||
my $outfile = shift;
|
||||
if (UNIVERSAL::isa($outfile,'GLOB')) {
|
||||
return print $outfile @_;
|
||||
} elsif (ref $outfile eq 'SCALAR') {
|
||||
$$outfile .= join('', @_);
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::HtmlDump - Dump information in hex to HTML page
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Image::ExifTool::HtmlDump;
|
||||
my $dump = new Image::ExifTool::HtmlDump;
|
||||
$dump->Add($start, $size, $comment);
|
||||
$dump->Print($dumpInfo, $raf, $dataPt, $dataPos, $outfile);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains code used to generate an HTML-based hex dump of
|
||||
information for debugging purposes. This is code is called when the
|
||||
ExifTool 'HtmlDump' option is used.
|
||||
|
||||
Currently, only EXIF/TIFF and JPEG information is dumped.
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
Due to a memory allocation bug in ActivePerl 5.8.x for Windows, this code
|
||||
may run extremely slowly when processing large files with this version of
|
||||
Perl.
|
||||
|
||||
An HTML 4 compliant browser is needed to properly display the generated HTML
|
||||
page.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,206 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: ISO.pm
|
||||
#
|
||||
# Description: Read information from ISO 9660 disk images
|
||||
#
|
||||
# Revisions: 2016-04-07 - P. Harvey created
|
||||
#
|
||||
# References: 1) http://wiki.osdev.org/ISO_9660
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::ISO;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.01';
|
||||
|
||||
# trim trailing spaces and ignore tag if empty
|
||||
my %rawStr = (
|
||||
RawConv => sub {
|
||||
my $val = shift;
|
||||
$val =~ s/ +$//;
|
||||
return length($val) ? $val : undef;
|
||||
},
|
||||
);
|
||||
|
||||
# tag info for date/time tags
|
||||
my %dateInfo = (
|
||||
Format => 'undef[17]',
|
||||
Groups => { 2 => 'Time' },
|
||||
ValueConv => q{
|
||||
return undef if $val !~ /[^0\0 ]/; # ignore if empty
|
||||
if ($val =~ s/(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(.)/$1:$2:$3 $4:$5:$6.$7/s) {
|
||||
$val .= TimeZoneString(unpack('c', $8) * 15);
|
||||
}
|
||||
return $val;
|
||||
},
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
);
|
||||
|
||||
# lookup for volume descriptor types
|
||||
my %volumeDescriptorType = (
|
||||
0 => 'Boot Record',
|
||||
1 => 'Primary Volume',
|
||||
2 => 'Supplementary Volume',
|
||||
3 => 'Volume Partition',
|
||||
255 => 'Terminator',
|
||||
);
|
||||
|
||||
# ISO tags
|
||||
%Image::ExifTool::ISO::Main = (
|
||||
GROUPS => { 2 => 'Other' },
|
||||
NOTES => 'Tags extracted from ISO 9660 disk images.',
|
||||
0 => {
|
||||
Name => 'BootRecord',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::ISO::BootRecord' },
|
||||
},
|
||||
1 => {
|
||||
Name => 'PrimaryVolume',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::ISO::PrimaryVolume' },
|
||||
},
|
||||
);
|
||||
|
||||
%Image::ExifTool::ISO::BootRecord = (
|
||||
GROUPS => { 2 => 'Other' },
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
# 0 => { Name => 'VolumeType', PrintConv => \%volumeDescriptorType }, # (0 for boot record)
|
||||
# 1 => { Name => 'Identifier', Format => 'undef[5]' }, # (always "CD001")
|
||||
# 6 => 'VolumeDesriptorVersion', # (always 1)
|
||||
# always extract BootSystem, even if empty, as an indication that this is bootable
|
||||
7 => { Name => 'BootSystem', Format => 'string[32]', ValueConv => '$val=~s/ +$//; $val' },
|
||||
39 => { Name => 'BootIdentifier', Format => 'string[32]', %rawStr },
|
||||
);
|
||||
|
||||
%Image::ExifTool::ISO::PrimaryVolume = (
|
||||
GROUPS => { 2 => 'Other' },
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
# 0 => { Name => 'VolumeType', PrintConv => \%volumeDescriptorType }, # (1 for primary volume)
|
||||
# 1 => { Name => 'Identifier', Format => 'undef[5]' }, # (always "CD001")
|
||||
# 6 => 'VolumeDesriptorVersion', # (always 1)
|
||||
8 => { Name => 'System', Format => 'string[32]', %rawStr },
|
||||
40 => { Name => 'VolumeName', Format => 'string[32]', %rawStr },
|
||||
80 => { Name => 'VolumeBlockCount', Format => 'int32u' },
|
||||
120 => { Name => 'VolumeSetDiskCount', Format => 'int16u', Unknown => 1 },
|
||||
124 => { Name => 'VolumeSetDiskNumber', Format => 'int16u', Unknown => 1 },
|
||||
128 => { Name => 'VolumeBlockSize', Format => 'int16u' },
|
||||
132 => { Name => 'PathTableSize', Format => 'int32u', Unknown => 1 },
|
||||
140 => { Name => 'PathTableLocation', Format => 'int32u', Unknown => 1 },
|
||||
174 => {
|
||||
Name => 'RootDirectoryCreateDate',
|
||||
Format => 'undef[7]',
|
||||
Groups => { 2 => 'Time' },
|
||||
ValueConv => q{
|
||||
my @a = unpack('C6c', $val);
|
||||
$a[0] += 1900;
|
||||
$a[6] = TimeZoneString($a[6] * 15);
|
||||
return sprintf('%.4d:%.2d:%.2d %.2d:%.2d:%.2d%s', @a);
|
||||
},
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
190 => { Name => 'VolumeSetName', Format => 'string[128]', %rawStr },
|
||||
318 => { Name => 'Publisher', Format => 'string[128]', %rawStr },
|
||||
446 => { Name => 'DataPreparer', Format => 'string[128]', %rawStr },
|
||||
574 => { Name => 'Software', Format => 'string[128]', %rawStr },
|
||||
702 => { Name => 'CopyrightFileName', Format => 'string[38]', %rawStr },
|
||||
740 => { Name => 'AbstractFileName', Format => 'string[36]', %rawStr },
|
||||
776 => { Name => 'BibligraphicFileName',Format => 'string[37]', %rawStr },
|
||||
813 => { Name => 'VolumeCreateDate', %dateInfo },
|
||||
830 => { Name => 'VolumeModifyDate', %dateInfo },
|
||||
847 => { Name => 'VolumeExpirationDate',%dateInfo },
|
||||
864 => { Name => 'VolumeEffectiveDate', %dateInfo },
|
||||
#881 => 'FileStructureVersion', # (always 1)
|
||||
);
|
||||
|
||||
# ISO Composite tags
|
||||
%Image::ExifTool::ISO::Composite = (
|
||||
GROUPS => { 2 => 'Other' },
|
||||
VolumeSize => {
|
||||
Require => {
|
||||
0 => 'ISO:VolumeBlockCount',
|
||||
1 => 'ISO:VolumeBlockSize',
|
||||
},
|
||||
ValueConv => '$val[0] * $val[1]',
|
||||
PrintConv => \&Image::ExifTool::ConvertFileSize,
|
||||
},
|
||||
);
|
||||
|
||||
# add our composite tags
|
||||
Image::ExifTool::AddCompositeTags('Image::ExifTool::ISO');
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Extract information from an ISO 9660 disk image
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
||||
# Returns: 1 on success, 0 if this wasn't a valid ISO 9660 image
|
||||
sub ProcessISO($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my ($buff, $tagTablePtr);
|
||||
|
||||
# verify this is a valid ISO file
|
||||
return 0 unless $raf->Seek(32768, 0);
|
||||
|
||||
while ($raf->Read($buff, 2048) == 2048) {
|
||||
last unless $buff =~ /^[\0-\x03\xff]CD001/;
|
||||
unless ($tagTablePtr) {
|
||||
$et->SetFileType(); # set the FileType tag
|
||||
SetByteOrder('II'); # read little-endian values only
|
||||
$tagTablePtr = GetTagTable('Image::ExifTool::ISO::Main');
|
||||
}
|
||||
my $type = unpack('C', $buff);
|
||||
$et->VPrint(0, "Volume descriptor type $type ($volumeDescriptorType{$type})\n");
|
||||
last if $type == 255; # stop at terminator
|
||||
next unless $$tagTablePtr{$type};
|
||||
my $subTablePtr = GetTagTable($$tagTablePtr{$type}{SubDirectory}{TagTable});
|
||||
my %dirInfo = (
|
||||
DataPt => \$buff,
|
||||
DataPos => $raf->Tell() - 2048,
|
||||
DirStart => 0,
|
||||
DirLen => length($buff),
|
||||
);
|
||||
$et->ProcessDirectory(\%dirInfo, $subTablePtr);
|
||||
}
|
||||
return $tagTablePtr ? 1 : 0;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::ISO - Read information from ISO 9660 disk images
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool to read
|
||||
information from ISO 9660 disk images.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://wiki.osdev.org/ISO_9660>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/ISO Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,215 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: ITC.pm
|
||||
#
|
||||
# Description: Read iTunes Cover Flow meta information
|
||||
#
|
||||
# Revisions: 01/12/2008 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://www.waldoland.com/dev/Articles/ITCFileFormat.aspx
|
||||
# 2) http://www.falsecognate.org/2007/01/deciphering_the_itunes_itc_fil/
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::ITC;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.02';
|
||||
|
||||
sub ProcessITC($$);
|
||||
|
||||
# tags used in ITC files
|
||||
%Image::ExifTool::ITC::Main = (
|
||||
NOTES => 'This information is found in iTunes Cover Flow data files.',
|
||||
itch => { SubDirectory => { TagTable => 'Image::ExifTool::ITC::Header' } },
|
||||
item => { SubDirectory => { TagTable => 'Image::ExifTool::ITC::Item' } },
|
||||
data => {
|
||||
Name => 'ImageData',
|
||||
Notes => 'embedded JPEG or PNG image, depending on ImageType',
|
||||
},
|
||||
);
|
||||
|
||||
# ITC header information
|
||||
%Image::ExifTool::ITC::Header = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 2 => 'Image' },
|
||||
0x10 => {
|
||||
Name => 'DataType',
|
||||
Format => 'undef[4]',
|
||||
PrintConv => { artw => 'Artwork' },
|
||||
},
|
||||
);
|
||||
|
||||
# ITC item information
|
||||
%Image::ExifTool::ITC::Item = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 2 => 'Image' },
|
||||
FORMAT => 'int32u',
|
||||
FIRST_ENTRY => 0,
|
||||
0 => {
|
||||
Name => 'LibraryID',
|
||||
Format => 'undef[8]',
|
||||
ValueConv => 'uc unpack "H*", $val',
|
||||
},
|
||||
2 => {
|
||||
Name => 'TrackID',
|
||||
Format => 'undef[8]',
|
||||
ValueConv => 'uc unpack "H*", $val',
|
||||
},
|
||||
4 => {
|
||||
Name => 'DataLocation',
|
||||
Format => 'undef[4]',
|
||||
PrintConv => {
|
||||
down => 'Downloaded Separately',
|
||||
locl => 'Local Music File',
|
||||
},
|
||||
},
|
||||
5 => {
|
||||
Name => 'ImageType',
|
||||
Format => 'undef[4]',
|
||||
ValueConv => { # (not PrintConv because the unconverted JPEG value is nasty)
|
||||
'PNGf' => 'PNG',
|
||||
"\0\0\0\x0d" => 'JPEG',
|
||||
},
|
||||
},
|
||||
7 => 'ImageWidth',
|
||||
8 => 'ImageHeight',
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process an iTunes Cover Flow (ITC) file
|
||||
# Inputs: 0) ExifTool object reference, 1) Directory information reference
|
||||
# Returns: 1 on success, 0 if this wasn't a valid ITC file
|
||||
sub ProcessITC($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $rtnVal = 0;
|
||||
my ($buff, $err, $pos, $tagTablePtr, %dirInfo);
|
||||
|
||||
# loop through all blocks in this image
|
||||
for (;;) {
|
||||
# read the block header
|
||||
my $n = $raf->Read($buff, 8);
|
||||
unless ($n == 8) {
|
||||
# no error if we reached the EOF normally
|
||||
undef $err unless $n;
|
||||
last;
|
||||
}
|
||||
my ($size, $tag) = unpack('Na4', $buff);
|
||||
if ($rtnVal) {
|
||||
last unless $size >= 8 and $size < 0x80000000;
|
||||
} else {
|
||||
# check to be sure this is a valid ITC image
|
||||
# (first block must be 'itch')
|
||||
last unless $tag eq 'itch';
|
||||
last unless $size >= 0x1c and $size < 0x10000;
|
||||
$et->SetFileType();
|
||||
SetByteOrder('MM');
|
||||
$rtnVal = 1; # this is an ITC file
|
||||
$err = 1; # format error unless we read to EOF
|
||||
}
|
||||
if ($tag eq 'itch') {
|
||||
$pos = $raf->Tell();
|
||||
$size -= 8; # size of remaining data in block
|
||||
$raf->Read($buff,$size) == $size or last;
|
||||
# extract header information
|
||||
%dirInfo = (
|
||||
DirName => 'ITC Header',
|
||||
DataPt => \$buff,
|
||||
DataPos => $pos,
|
||||
);
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::ITC::Header');
|
||||
$et->ProcessDirectory(\%dirInfo, $tagTablePtr);
|
||||
} elsif ($tag eq 'item') {
|
||||
# don't want to read the entire item data (includes image)
|
||||
$size > 12 or last;
|
||||
$raf->Read($buff, 4) == 4 or last;
|
||||
my $len = unpack('N', $buff);
|
||||
$len >= 0xd0 and $len <= $size or last;
|
||||
$size -= $len; # size of data after item header
|
||||
$len -= 12; # length of remaining item header
|
||||
# read in 4-byte blocks until we find the null terminator
|
||||
# (this is just a guess about how to parse this variable-length part)
|
||||
while ($len >= 4) {
|
||||
$raf->Read($buff, 4) == 4 or last;
|
||||
$len -= 4;
|
||||
last if $buff eq "\0\0\0\0";
|
||||
}
|
||||
last if $len < 4;
|
||||
$pos = $raf->Tell();
|
||||
$raf->Read($buff, $len) == $len or last;
|
||||
unless ($len >= 0xb4 and substr($buff, 0xb0, 4) eq 'data') {
|
||||
$et->Warn('Parsing error. Please submit this ITC file for testing');
|
||||
last;
|
||||
}
|
||||
%dirInfo = (
|
||||
DirName => 'ITC Item',
|
||||
DataPt => \$buff,
|
||||
DataPos => $pos,
|
||||
);
|
||||
$tagTablePtr = GetTagTable('Image::ExifTool::ITC::Item');
|
||||
$et->ProcessDirectory(\%dirInfo, $tagTablePtr);
|
||||
# extract embedded image
|
||||
$pos += $len;
|
||||
if ($size > 0) {
|
||||
$tagTablePtr = GetTagTable('Image::ExifTool::ITC::Main');
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, 'data');
|
||||
my $image = $et->ExtractBinary($pos, $size, $$tagInfo{Name});
|
||||
$et->FoundTag($tagInfo, \$image);
|
||||
# skip the rest of the block if necessary
|
||||
$raf->Seek($pos+$size, 0) or last
|
||||
} elsif ($size < 0) {
|
||||
last;
|
||||
}
|
||||
} else {
|
||||
$et->VPrint(0, "Unknown $tag block ($size bytes)\n");
|
||||
$raf->Seek($size-8, 1) or last;
|
||||
}
|
||||
}
|
||||
$err and $et->Warn('ITC file format error');
|
||||
return $rtnVal;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::ITC - Read iTunes Cover Flow meta information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains the routines required by Image::ExifTool to read meta
|
||||
information (including artwork images) from iTunes Cover Flow files.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://www.waldoland.com/dev/Articles/ITCFileFormat.aspx>
|
||||
|
||||
=item L<http://www.falsecognate.org/2007/01/deciphering_the_itunes_itc_fil/>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/ITC Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,357 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Import.pm
|
||||
#
|
||||
# Description: Import CSV and JSON database files
|
||||
#
|
||||
# Revisions: 2011-03-05 - P. Harvey Created
|
||||
#------------------------------------------------------------------------------
|
||||
package Image::ExifTool::Import;
|
||||
|
||||
use strict;
|
||||
require Exporter;
|
||||
|
||||
use vars qw($VERSION @ISA @EXPORT_OK);
|
||||
|
||||
$VERSION = '1.09';
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT_OK = qw(ReadCSV ReadJSON);
|
||||
|
||||
sub ReadJSONObject($;$);
|
||||
|
||||
my %unescapeJSON = ( 't'=>"\t", 'n'=>"\n", 'r'=>"\r" );
|
||||
my $charset;
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read CSV file
|
||||
# Inputs: 0) CSV file name, file ref or RAF ref, 1) database hash ref, 2) missing tag value
|
||||
# Returns: undef on success, or error string
|
||||
# Notes: There are various flavours of CSV, but here we assume that only
|
||||
# double quotes are escaped, and they are escaped by doubling them
|
||||
sub ReadCSV($$;$)
|
||||
{
|
||||
local ($_, $/);
|
||||
my ($file, $database, $missingValue) = @_;
|
||||
my ($buff, @tags, $found, $err, $raf, $openedFile);
|
||||
|
||||
if (UNIVERSAL::isa($file, 'File::RandomAccess')) {
|
||||
$raf = $file;
|
||||
$file = 'CSV file';
|
||||
} elsif (ref $file eq 'GLOB') {
|
||||
$raf = new File::RandomAccess($file);
|
||||
$file = 'CSV file';
|
||||
} else {
|
||||
open CSVFILE, $file or return "Error opening CSV file '${file}'";
|
||||
binmode CSVFILE;
|
||||
$openedFile = 1;
|
||||
$raf = new File::RandomAccess(\*CSVFILE);
|
||||
}
|
||||
# set input record separator by first newline found in the file
|
||||
# (safe because first line should contain only tag names)
|
||||
while ($raf->Read($buff, 65536)) {
|
||||
$buff =~ /(\x0d\x0a|\x0d|\x0a)/ and $/ = $1, last;
|
||||
}
|
||||
$raf->Seek(0,0);
|
||||
while ($raf->ReadLine($buff)) {
|
||||
my (@vals, $v, $i, %fileInfo);
|
||||
my @toks = split ',', $buff;
|
||||
while (@toks) {
|
||||
($v = shift @toks) =~ s/^ +//; # remove leading spaces
|
||||
if ($v =~ s/^"//) {
|
||||
# quoted value must end in an odd number of quotes
|
||||
while ($v !~ /("+)\s*$/ or not length($1) & 1) {
|
||||
if (@toks) {
|
||||
$v .= ',' . shift @toks;
|
||||
} else {
|
||||
# read another line from the file
|
||||
$raf->ReadLine($buff) or last;
|
||||
@toks = split ',', $buff;
|
||||
last unless @toks;
|
||||
$v .= shift @toks;
|
||||
}
|
||||
}
|
||||
$v =~ s/"\s*$//; # remove trailing quote and whitespace
|
||||
$v =~ s/""/"/g; # un-escape quotes
|
||||
} else {
|
||||
$v =~ s/[ \n\r]+$//;# remove trailing spaces/newlines
|
||||
}
|
||||
push @vals, $v;
|
||||
}
|
||||
if (@tags) {
|
||||
# save values for each tag
|
||||
for ($i=0; $i<@vals and $i<@tags; ++$i) {
|
||||
# ignore empty entries unless missingValue is empty too
|
||||
next unless length $vals[$i] or defined $missingValue and $missingValue eq '';
|
||||
# delete tag (set value to undef) if value is same as missing tag
|
||||
$fileInfo{$tags[$i]} =
|
||||
(defined $missingValue and $vals[$i] eq $missingValue) ? undef : $vals[$i];
|
||||
}
|
||||
# figure out the file name to use
|
||||
if ($fileInfo{SourceFile}) {
|
||||
$$database{$fileInfo{SourceFile}} = \%fileInfo;
|
||||
$found = 1;
|
||||
}
|
||||
} else {
|
||||
# the first row should be the tag names
|
||||
foreach (@vals) {
|
||||
# terminate at first blank tag name (eg. extra comma at end of line)
|
||||
last unless length $_;
|
||||
@tags or s/^\xef\xbb\xbf//; # remove UTF-8 BOM if it exists
|
||||
/^[-\w]+(:[-\w+]+)?#?$/ or $err = "Invalid tag name '${_}'", last;
|
||||
push(@tags, $_);
|
||||
}
|
||||
last if $err;
|
||||
@tags or $err = 'No tags found', last;
|
||||
# fix "SourceFile" case if necessary
|
||||
$tags[0] = 'SourceFile' if lc $tags[0] eq 'sourcefile';
|
||||
}
|
||||
}
|
||||
close CSVFILE if $openedFile;
|
||||
undef $raf;
|
||||
$err = 'No SourceFile column' unless $found or $err;
|
||||
return $err ? "$err in $file" : undef;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Convert unicode code point to UTF-8
|
||||
# Inputs: 0) integer Unicode character
|
||||
# Returns: UTF-8 bytes
|
||||
sub ToUTF8($)
|
||||
{
|
||||
require Image::ExifTool::Charset;
|
||||
return Image::ExifTool::Charset::Recompose(undef, [$_[0]], $charset);
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read JSON object from file
|
||||
# Inputs: 0) RAF reference or undef, 1) optional scalar reference for data
|
||||
# to read before reading from file (ie. the file read buffer)
|
||||
# Returns: JSON object (scalar, hash ref, or array ref), or undef on EOF or
|
||||
# empty object or array (and sets $$buffPt to empty string on EOF)
|
||||
# Notes: position in buffer is significant
|
||||
sub ReadJSONObject($;$)
|
||||
{
|
||||
my ($raf, $buffPt) = @_;
|
||||
# initialize buffer if necessary
|
||||
my ($pos, $readMore, $rtnVal, $tok, $key, $didBOM);
|
||||
if ($buffPt) {
|
||||
$pos = pos $$buffPt;
|
||||
$pos = pos($$buffPt) = 0 unless defined $pos;
|
||||
} else {
|
||||
my $buff = '';
|
||||
$buffPt = \$buff;
|
||||
$pos = 0;
|
||||
}
|
||||
Tok: for (;;) {
|
||||
# (didn't spend the time to understand how $pos could be undef, but
|
||||
# put a test here to be safe because one user reported this problem)
|
||||
last unless defined $pos;
|
||||
if ($pos >= length $$buffPt or $readMore) {
|
||||
last unless defined $raf;
|
||||
# read another 64kB and add to unparsed data
|
||||
my $offset = length($$buffPt) - $pos;
|
||||
if ($offset) {
|
||||
my $buff;
|
||||
$raf->Read($buff, 65536) or $$buffPt = '', last;
|
||||
$$buffPt = substr($$buffPt, $pos) . $buff;
|
||||
} else {
|
||||
$raf->Read($$buffPt, 65536) or $$buffPt = '', last;
|
||||
}
|
||||
unless ($didBOM) {
|
||||
$$buffPt =~ s/^\xef\xbb\xbf//; # remove UTF-8 BOM if it exists
|
||||
$didBOM = 1;
|
||||
}
|
||||
$pos = pos($$buffPt) = 0;
|
||||
$readMore = 0;
|
||||
}
|
||||
unless ($tok) {
|
||||
# skip white space and find next character
|
||||
$$buffPt =~ /(\S)/g or $pos = length($$buffPt), next;
|
||||
$tok = $1;
|
||||
$pos = pos $$buffPt;
|
||||
}
|
||||
# see what type of object this is
|
||||
if ($tok eq '{') { # object (hash)
|
||||
$rtnVal = { } unless defined $rtnVal;
|
||||
for (;;) {
|
||||
# read "KEY":"VALUE" pairs
|
||||
unless (defined $key) {
|
||||
$key = ReadJSONObject($raf, $buffPt);
|
||||
$pos = pos $$buffPt;
|
||||
}
|
||||
# ($key may be undef for empty JSON object)
|
||||
if (defined $key) {
|
||||
# scan to delimiting ':'
|
||||
$$buffPt =~ /(\S)/g or $readMore = 1, next Tok;
|
||||
$1 eq ':' or return undef; # error if not a colon
|
||||
my $val = ReadJSONObject($raf, $buffPt);
|
||||
$pos = pos $$buffPt;
|
||||
return undef unless defined $val;
|
||||
$$rtnVal{$key} = $val;
|
||||
undef $key;
|
||||
}
|
||||
# scan to delimiting ',' or bounding '}'
|
||||
$$buffPt =~ /(\S)/g or $readMore = 1, next Tok;
|
||||
last if $1 eq '}'; # check for end of object
|
||||
$1 eq ',' or return undef; # error if not a comma
|
||||
}
|
||||
} elsif ($tok eq '[') { # array
|
||||
$rtnVal = [ ] unless defined $rtnVal;
|
||||
for (;;) {
|
||||
my $item = ReadJSONObject($raf, $buffPt);
|
||||
$pos = pos $$buffPt;
|
||||
# ($item may be undef for empty array)
|
||||
push @$rtnVal, $item if defined $item;
|
||||
# scan to delimiting ',' or bounding ']'
|
||||
$$buffPt =~ /(\S)/g or $readMore = 1, next Tok;
|
||||
last if $1 eq ']'; # check for end of array
|
||||
$1 eq ',' or return undef; # error if not a comma
|
||||
}
|
||||
} elsif ($tok eq '"') { # quoted string
|
||||
for (;;) {
|
||||
$$buffPt =~ /(\\*)"/g or $readMore = 1, next Tok;
|
||||
last unless length($1) & 1; # check for escaped quote
|
||||
}
|
||||
$rtnVal = substr($$buffPt, $pos, pos($$buffPt)-$pos-1);
|
||||
# unescape characters
|
||||
$rtnVal =~ s/\\u([0-9a-f]{4})/ToUTF8(hex $1)/ige;
|
||||
$rtnVal =~ s/\\(.)/$unescapeJSON{$1}||$1/sge;
|
||||
# decode base64 (binary data) values
|
||||
if ($rtnVal =~ /^base64:[A-Za-z0-9+\/]*={0,2}$/ and length($rtnVal) % 4 == 3) {
|
||||
require Image::ExifTool::XMP;
|
||||
$rtnVal = ${Image::ExifTool::XMP::DecodeBase64(substr($rtnVal,7))};
|
||||
}
|
||||
} elsif ($tok eq ']' or $tok eq '}' or $tok eq ',') {
|
||||
# return undef for empty object, array, or list item
|
||||
# (empty list item actually not valid JSON)
|
||||
pos($$buffPt) = pos($$buffPt) - 1;
|
||||
} else { # number, 'true', 'false', 'null'
|
||||
$$buffPt =~ /([\s:,\}\]])/g or $readMore = 1, next;
|
||||
pos($$buffPt) = pos($$buffPt) - 1;
|
||||
$rtnVal = $tok . substr($$buffPt, $pos, pos($$buffPt)-$pos);
|
||||
}
|
||||
last;
|
||||
}
|
||||
return $rtnVal;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read JSON file
|
||||
# Inputs: 0) JSON file name, file ref or RAF ref, 1) database hash ref,
|
||||
# 2) flag to delete "-" tags, 3) character set
|
||||
# Returns: undef on success, or error string
|
||||
sub ReadJSON($$;$$)
|
||||
{
|
||||
local $_;
|
||||
my ($file, $database, $missingValue, $chset) = @_;
|
||||
my ($raf, $openedFile);
|
||||
|
||||
# initialize character set for converting "\uHHHH" chars
|
||||
$charset = $chset || 'UTF8';
|
||||
if (UNIVERSAL::isa($file, 'File::RandomAccess')) {
|
||||
$raf = $file;
|
||||
$file = 'JSON file';
|
||||
} elsif (ref $file eq 'GLOB') {
|
||||
$raf = new File::RandomAccess($file);
|
||||
$file = 'JSON file';
|
||||
} else {
|
||||
open JSONFILE, $file or return "Error opening JSON file '${file}'";
|
||||
binmode JSONFILE;
|
||||
$openedFile = 1;
|
||||
$raf = new File::RandomAccess(\*JSONFILE);
|
||||
}
|
||||
my $obj = ReadJSONObject($raf);
|
||||
close JSONFILE if $openedFile;
|
||||
unless (ref $obj eq 'ARRAY') {
|
||||
ref $obj eq 'HASH' or return "Format error in JSON file '${file}'";
|
||||
$obj = [ $obj ];
|
||||
}
|
||||
my ($info, $found);
|
||||
foreach $info (@$obj) {
|
||||
next unless ref $info eq 'HASH';
|
||||
# fix "SourceFile" case, or assume '*' if SourceFile not specified
|
||||
unless (defined $$info{SourceFile}) {
|
||||
my ($key) = grep /^SourceFile$/i, keys %$info;
|
||||
if ($key) {
|
||||
$$info{SourceFile} = $$info{$key};
|
||||
delete $$info{$key};
|
||||
} else {
|
||||
$$info{SourceFile} = '*';
|
||||
}
|
||||
}
|
||||
if (defined $missingValue) {
|
||||
$$info{$_} eq $missingValue and $$info{$_} = undef foreach keys %$info;
|
||||
}
|
||||
$$database{$$info{SourceFile}} = $info;
|
||||
$found = 1;
|
||||
}
|
||||
return $found ? undef : "No valid JSON objects in '${file}'";
|
||||
}
|
||||
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::Import - Import CSV and JSON database files
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Image::ExifTool::Import qw(ReadCSV ReadJSON);
|
||||
|
||||
$err = ReadCSV($csvFile, \%database);
|
||||
|
||||
$err = ReadJSON($jsonfile, \%database);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains routines for importing tag information from CSV (Comma
|
||||
Separated Value) and JSON (JavaScript Object Notation) database files.
|
||||
|
||||
=head1 EXPORTS
|
||||
|
||||
Exports nothing by default, but ReadCSV and ReadJSON may be exported.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 ReadCSV / ReadJSON
|
||||
|
||||
Read CSV or JSON file into a database hash.
|
||||
|
||||
=over 4
|
||||
|
||||
=item Inputs:
|
||||
|
||||
0) CSV file name or file reference.
|
||||
|
||||
1) Hash reference for database object.
|
||||
|
||||
2) Optional string used to represent an undefined (missing) tag value.
|
||||
(Used for deleting tags.)
|
||||
|
||||
3) [ReadJSON only] Optional character set for converting Unicode escape
|
||||
sequences in strings. Defaults to "UTF8". See the ExifTool Charset option
|
||||
for a list of valid settings.
|
||||
|
||||
=item Return Value:
|
||||
|
||||
These functions return an error string, or undef on success and populate the
|
||||
database hash with entries from the CSV or JSON file. Entries are keyed
|
||||
based on the SourceFile column of the CSV or JSON information, and are
|
||||
stored as hash lookups of tag name/value for each SourceFile.
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,279 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: InDesign.pm
|
||||
#
|
||||
# Description: Read/write meta information in Adobe InDesign files
|
||||
#
|
||||
# Revisions: 2009-06-17 - P. Harvey Created
|
||||
#
|
||||
# References: 1) http://www.adobe.com/devnet/xmp/pdfs/XMPSpecificationPart3.pdf
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::InDesign;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.06';
|
||||
|
||||
# map for writing metadata to InDesign files (currently only write XMP)
|
||||
my %indMap = (
|
||||
XMP => 'IND',
|
||||
);
|
||||
|
||||
# GUID's used in InDesign files
|
||||
my $masterPageGUID = "\x06\x06\xed\xf5\xd8\x1d\x46\xe5\xbd\x31\xef\xe7\xfe\x74\xb7\x1d";
|
||||
my $objectHeaderGUID = "\xde\x39\x39\x79\x51\x88\x4b\x6c\x8E\x63\xee\xf8\xae\xe0\xdd\x38";
|
||||
my $objectTrailerGUID = "\xfd\xce\xdb\x70\xf7\x86\x4b\x4f\xa4\xd3\xc7\x28\xb3\x41\x71\x06";
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read or write meta information in an InDesign file
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
||||
# Returns: 1 on success, 0 if this wasn't a valid InDesign file, or -1 on write error
|
||||
sub ProcessIND($$)
|
||||
{
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $outfile = $$dirInfo{OutFile};
|
||||
my ($hdr, $buff, $buf2, $err, $writeLen, $foundXMP);
|
||||
|
||||
# validate the InDesign file
|
||||
return 0 unless $raf->Read($hdr, 16) == 16;
|
||||
return 0 unless $hdr eq $masterPageGUID;
|
||||
return 0 unless $raf->Read($buff, 8) == 8;
|
||||
$et->SetFileType($buff eq 'DOCUMENT' ? 'INDD' : 'IND'); # set the FileType tag
|
||||
|
||||
# read the master pages
|
||||
$raf->Seek(0, 0) or $err = 'Seek error', goto DONE;
|
||||
unless ($raf->Read($buff, 4096) == 4096 and
|
||||
$raf->Read($buf2, 4096) == 4096)
|
||||
{
|
||||
$err = 'Unexpected end of file';
|
||||
goto DONE; # (goto's can be our friend)
|
||||
}
|
||||
SetByteOrder('II');
|
||||
unless ($buf2 =~ /^\Q$masterPageGUID/) {
|
||||
$err = 'Second master page is invalid';
|
||||
goto DONE;
|
||||
}
|
||||
my $seq1 = Get64u(\$buff, 264);
|
||||
my $seq2 = Get64u(\$buf2, 264);
|
||||
# take the most current master page
|
||||
my $curPage = $seq2 > $seq1 ? \$buf2 : \$buff;
|
||||
# byte order of stream data may be different than headers
|
||||
my $streamInt32u = Get8u($curPage, 24);
|
||||
if ($streamInt32u == 1) {
|
||||
$streamInt32u = 'V'; # little-endian int32u
|
||||
} elsif ($streamInt32u == 2) {
|
||||
$streamInt32u = 'N'; # big-endian int32u
|
||||
} else {
|
||||
$err = 'Invalid stream byte order';
|
||||
goto DONE;
|
||||
}
|
||||
my $pages = Get32u($curPage, 280);
|
||||
$pages < 2 and $err = 'Invalid page count', goto DONE;
|
||||
my $pos = $pages * 4096;
|
||||
if ($pos > 0x7fffffff and not $et->Options('LargeFileSupport')) {
|
||||
$err = 'InDesign files larger than 2 GB not supported (LargeFileSupport not set)';
|
||||
goto DONE;
|
||||
}
|
||||
if ($outfile) {
|
||||
# make XMP the preferred group for writing
|
||||
$et->InitWriteDirs(\%indMap, 'XMP');
|
||||
|
||||
Write($outfile, $buff, $buf2) or $err = 1, goto DONE;
|
||||
my $result = Image::ExifTool::CopyBlock($raf, $outfile, $pos - 8192);
|
||||
unless ($result) {
|
||||
$err = defined $result ? 'Error reading InDesign database' : 1;
|
||||
goto DONE;
|
||||
}
|
||||
$writeLen = 0;
|
||||
} else {
|
||||
$raf->Seek($pos, 0) or $err = 'Seek error', goto DONE;
|
||||
}
|
||||
# scan through the contiguous objects for XMP
|
||||
my $verbose = $et->Options('Verbose');
|
||||
my $out = $et->Options('TextOut');
|
||||
for (;;) {
|
||||
$raf->Read($hdr, 32) or last;
|
||||
unless (length($hdr) == 32 and $hdr =~ /^\Q$objectHeaderGUID/) {
|
||||
# this must be null padding or we have an error
|
||||
$hdr =~ /^\0+$/ or $err = 'Corrupt file or unsupported InDesign version';
|
||||
last;
|
||||
}
|
||||
my $len = Get32u(\$hdr, 24);
|
||||
if ($verbose) {
|
||||
printf $out "Contiguous object at offset 0x%x (%d bytes):\n", $raf->Tell(), $len;
|
||||
if ($verbose > 2) {
|
||||
my $len2 = $len < 1024000 ? $len : 1024000;
|
||||
$raf->Seek(-$raf->Read($buff, $len2), 1) or $err = 1;
|
||||
$et->VerboseDump(\$buff, Addr => $raf->Tell());
|
||||
}
|
||||
}
|
||||
# check for XMP if stream data is long enough
|
||||
# (56 bytes is just enough for XMP header)
|
||||
if ($len > 56) {
|
||||
$raf->Read($buff, 56) == 56 or $err = 'Unexpected end of file', last;
|
||||
if ($buff =~ /^(....)<\?xpacket begin=(['"])\xef\xbb\xbf\2 id=(['"])W5M0MpCehiHzreSzNTczkc9d\3/s) {
|
||||
my $lenWord = $1; # save length word for writing later
|
||||
$len -= 4; # get length of XMP only
|
||||
$foundXMP = 1;
|
||||
# I have a sample where the XMP is 107 MB, and ActivePerl may run into
|
||||
# memory troubles (with its apparent 1 GB limit) if the XMP is larger
|
||||
# than about 400 MB, so guard against this
|
||||
if ($len > 300 * 1024 * 1024) {
|
||||
my $msg = sprintf('Insanely large XMP (%.0f MB)', $len / (1024 * 1024));
|
||||
if ($outfile) {
|
||||
$et->Error($msg, 2) and $err = 1, last;
|
||||
} elsif ($et->Options('IgnoreMinorErrors')) {
|
||||
$et->Warn($msg);
|
||||
} else {
|
||||
$et->Warn("$msg. Ignored.", 1);
|
||||
$err = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
# load and parse the XMP data
|
||||
unless ($raf->Seek(-52, 1) and $raf->Read($buff, $len) == $len) {
|
||||
$err = 'Error reading XMP stream';
|
||||
last;
|
||||
}
|
||||
my %dirInfo = (
|
||||
DataPt => \$buff,
|
||||
Parent => 'IND',
|
||||
NoDelete => 1, # do not allow this to be deleted when writing
|
||||
);
|
||||
# validate xmp data length (should be same as length in header - 4)
|
||||
my $xmpLen = unpack($streamInt32u, $lenWord);
|
||||
unless ($xmpLen == $len) {
|
||||
if ($xmpLen < $len) {
|
||||
$dirInfo{DirLen} = $xmpLen;
|
||||
} else {
|
||||
$err = 'Truncated XMP stream (missing ' . ($xmpLen - $len) . ' bytes)';
|
||||
}
|
||||
}
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
|
||||
if ($outfile) {
|
||||
last if $err;
|
||||
# make sure that XMP is writable
|
||||
my $classID = Get32u(\$hdr, 20);
|
||||
$classID & 0x40000000 or $err = 'XMP stream is not writable', last;
|
||||
my $xmp = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
|
||||
if ($xmp and length $xmp) {
|
||||
# write new xmp with leading length word
|
||||
$buff = pack($streamInt32u, length $xmp) . $xmp;
|
||||
# update header with new length and invalid checksum
|
||||
Set32u(length($buff), \$hdr, 24);
|
||||
Set32u(0xffffffff, \$hdr, 28);
|
||||
} else {
|
||||
$$et{CHANGED} = 0; # didn't change anything
|
||||
$et->Warn("Can't delete XMP as a block from InDesign file") if defined $xmp;
|
||||
# put length word back at start of stream
|
||||
$buff = $lenWord . $buff;
|
||||
}
|
||||
} else {
|
||||
$et->ProcessDirectory(\%dirInfo, $tagTablePtr);
|
||||
}
|
||||
$len = 0; # we got the full stream (nothing left to read)
|
||||
} else {
|
||||
$len -= 56; # we got 56 bytes of the stream
|
||||
}
|
||||
} else {
|
||||
$buff = ''; # must reset this for writing later
|
||||
}
|
||||
if ($outfile) {
|
||||
# write object header and data
|
||||
Write($outfile, $hdr, $buff) or $err = 1, last;
|
||||
my $result = Image::ExifTool::CopyBlock($raf, $outfile, $len);
|
||||
unless ($result) {
|
||||
$err = defined $result ? 'Truncated stream data' : 1;
|
||||
last;
|
||||
}
|
||||
$writeLen += 32 + length($buff) + $len;
|
||||
} elsif ($len) {
|
||||
# skip over remaining stream data
|
||||
$raf->Seek($len, 1) or $err = 'Seek error', last;
|
||||
}
|
||||
$raf->Read($buff, 32) == 32 or $err = 'Unexpected end of file', last;
|
||||
unless ($buff =~ /^\Q$objectTrailerGUID/) {
|
||||
$err = 'Invalid object trailer';
|
||||
last;
|
||||
}
|
||||
if ($outfile) {
|
||||
# make sure object UID and ClassID are the same in the trailer
|
||||
substr($hdr,16,8) eq substr($buff,16,8) or $err = 'Non-matching object trailer', last;
|
||||
# write object trailer
|
||||
Write($outfile, $objectTrailerGUID, substr($hdr,16)) or $err = 1, last;
|
||||
$writeLen += 32;
|
||||
}
|
||||
}
|
||||
if ($outfile) {
|
||||
# write null padding if necessary
|
||||
# (InDesign files must be an even number of 4096-byte blocks)
|
||||
my $part = $writeLen % 4096;
|
||||
Write($outfile, "\0" x (4096 - $part)) or $err = 1 if $part;
|
||||
}
|
||||
DONE:
|
||||
if (not $err) {
|
||||
$et->Warn('No XMP stream to edit') if $outfile and not $foundXMP;
|
||||
return 1; # success!
|
||||
} elsif (not $outfile) {
|
||||
# issue warning on read error
|
||||
$et->Warn($err) unless $err eq '1';
|
||||
} elsif ($err ne '1') {
|
||||
# set error and return success code
|
||||
$et->Error($err);
|
||||
} else {
|
||||
return -1; # write error
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::InDesign - Read/write meta information in Adobe InDesign files
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains routines required by Image::ExifTool to read XMP
|
||||
meta information from Adobe InDesign (.IND, .INDD and .INDT) files.
|
||||
|
||||
=head1 LIMITATIONS
|
||||
|
||||
1) Only XMP meta information is processed.
|
||||
|
||||
2) A new XMP stream may not be created, so XMP tags may only be written to
|
||||
InDesign files which previously contained XMP.
|
||||
|
||||
3) File sizes of greater than 2 GB are supported only if the system supports
|
||||
them and the LargeFileSupport option is enabled.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://www.adobe.com/devnet/xmp/pdfs/XMPSpecificationPart3.pdf>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,612 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: JPEG.pm
|
||||
#
|
||||
# Description: Definitions for uncommon JPEG segments
|
||||
#
|
||||
# Revisions: 10/06/2006 - P. Harvey Created
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::JPEG;
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.26';
|
||||
|
||||
sub ProcessOcad($$$);
|
||||
sub ProcessJPEG_HDR($$$);
|
||||
|
||||
# (this main JPEG table is for documentation purposes only)
|
||||
%Image::ExifTool::JPEG::Main = (
|
||||
NOTES => q{
|
||||
This table lists information extracted by ExifTool from JPEG images. See
|
||||
L<https://www.w3.org/Graphics/JPEG/jfif3.pdf> for the JPEG specification.
|
||||
},
|
||||
APP0 => [{
|
||||
Name => 'JFIF',
|
||||
Condition => '$$valPt =~ /^JFIF\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::JFIF::Main' },
|
||||
}, {
|
||||
Name => 'JFXX',
|
||||
Condition => '$$valPt =~ /^JFXX\0\x10/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::JFIF::Extension' },
|
||||
}, {
|
||||
Name => 'CIFF',
|
||||
Condition => '$$valPt =~ /^(II|MM).{4}HEAPJPGM/s',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::CanonRaw::Main' },
|
||||
}, {
|
||||
Name => 'AVI1',
|
||||
Condition => '$$valPt =~ /^AVI1/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::AVI1' },
|
||||
}, {
|
||||
Name => 'Ocad',
|
||||
Condition => '$$valPt =~ /^Ocad/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::Ocad' },
|
||||
}],
|
||||
APP1 => [{
|
||||
Name => 'EXIF',
|
||||
Condition => '$$valPt =~ /^Exif\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Exif::Main' },
|
||||
}, {
|
||||
Name => 'ExtendedXMP',
|
||||
Condition => '$$valPt =~ m{^http://ns.adobe.com/xmp/extension/\0}',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
|
||||
}, {
|
||||
Name => 'XMP',
|
||||
Condition => '$$valPt =~ /^http/ or $$valPt =~ /<exif:/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
|
||||
}, {
|
||||
Name => 'QVCI',
|
||||
Condition => '$$valPt =~ /^QVCI\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Casio::QVCI' },
|
||||
}, {
|
||||
Name => 'FLIR',
|
||||
Condition => '$$valPt =~ /^FLIR\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::FLIR::FFF' },
|
||||
}],
|
||||
APP2 => [{
|
||||
Name => 'ICC_Profile',
|
||||
Condition => '$$valPt =~ /^ICC_PROFILE\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main' },
|
||||
}, {
|
||||
Name => 'FPXR',
|
||||
Condition => '$$valPt =~ /^FPXR\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::FlashPix::Main' },
|
||||
}, {
|
||||
Name => 'MPF',
|
||||
Condition => '$$valPt =~ /^MPF\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::MPF::Main' },
|
||||
}, {
|
||||
Name => 'PreviewImage',
|
||||
Condition => '$$valPt =~ /^(|QVGA\0|BGTH)\xff\xd8\xff\xdb/',
|
||||
Notes => 'Samsung APP2 preview image', # (Samsung/GoPro="", BenQ="QVGA\0", Digilife="BGTH")
|
||||
}],
|
||||
APP3 => [{
|
||||
Name => 'Meta',
|
||||
Condition => '$$valPt =~ /^(Meta|META|Exif)\0\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Kodak::Meta' },
|
||||
}, {
|
||||
Name => 'Stim',
|
||||
Condition => '$$valPt =~ /^Stim\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Stim::Main' },
|
||||
}, {
|
||||
Name => 'PreviewImage', # (written by HP R837 and Samsung S1060)
|
||||
Condition => '$$valPt =~ /^\xff\xd8\xff\xdb/',
|
||||
Notes => 'Samsung/HP preview image', # (Samsung, HP, BenQ)
|
||||
}],
|
||||
APP4 => [{
|
||||
Name => 'Scalado',
|
||||
Condition => '$$valPt =~ /^SCALADO\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Scalado::Main' },
|
||||
}, {
|
||||
Name => 'FPXR', # (non-standard location written by some HP models)
|
||||
Condition => '$$valPt =~ /^FPXR\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::FlashPix::Main' },
|
||||
}, {
|
||||
Name => 'PreviewImage', # (eg. Samsung S1060)
|
||||
Notes => 'continued from APP3',
|
||||
}],
|
||||
APP5 => [{
|
||||
Name => 'RMETA',
|
||||
Condition => '$$valPt =~ /^RMETA\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Ricoh::RMETA' },
|
||||
}, {
|
||||
Name => 'PreviewImage', # (eg. BenQ DC E1050)
|
||||
Notes => 'continued from APP4',
|
||||
}],
|
||||
APP6 => [{
|
||||
Name => 'EPPIM',
|
||||
Condition => '$$valPt =~ /^EPPIM\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::EPPIM' },
|
||||
}, {
|
||||
Name => 'NITF',
|
||||
Condition => '$$valPt =~ /^NTIF\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::NITF' },
|
||||
}, {
|
||||
Name => 'HP_TDHD', # (written by R837)
|
||||
Condition => '$$valPt =~ /^TDHD\x01\0\0\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::HP::TDHD' },
|
||||
}, {
|
||||
Name => 'GoPro',
|
||||
Condition => '$$valPt =~ /^GoPro\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::GoPro::GPMF' },
|
||||
}],
|
||||
APP7 => [{
|
||||
Name => 'Pentax',
|
||||
Condition => '$$valPt =~ /^PENTAX \0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Pentax::Main' },
|
||||
}, {
|
||||
Name => 'Qualcomm',
|
||||
Condition => '$$valPt =~ /^\x1aQualcomm Camera Attributes/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Qualcomm::Main' },
|
||||
}],
|
||||
APP8 => {
|
||||
Name => 'SPIFF',
|
||||
Condition => '$$valPt =~ /^SPIFF\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::SPIFF' },
|
||||
},
|
||||
APP9 => {
|
||||
Name => 'MediaJukebox',
|
||||
Condition => '$$valPt =~ /^Media Jukebox\0/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::MediaJukebox' },
|
||||
},
|
||||
APP10 => {
|
||||
Name => 'Comment',
|
||||
Condition => '$$valPt =~ /^UNICODE\0/',
|
||||
Notes => 'PhotoStudio Unicode comment',
|
||||
},
|
||||
APP11 => {
|
||||
Name => 'JPEG-HDR',
|
||||
Condition => '$$valPt =~ /^HDR_RI /',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::HDR' },
|
||||
},
|
||||
APP12 => [{
|
||||
Name => 'PictureInfo',
|
||||
Condition => '$$valPt =~ /(\[picture info\]|Type=)/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::APP12::PictureInfo' },
|
||||
}, {
|
||||
Name => 'Ducky',
|
||||
Condition => '$$valPt =~ /^Ducky/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::APP12::Ducky' },
|
||||
}],
|
||||
APP13 => [{
|
||||
Name => 'Photoshop',
|
||||
Condition => '$$valPt =~ /^(Photoshop 3.0\0|Adobe_Photoshop2.5)/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Photoshop::Main' },
|
||||
}, {
|
||||
Name => 'Adobe_CM',
|
||||
Condition => '$$valPt =~ /^Adobe_CM/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::AdobeCM' },
|
||||
}],
|
||||
APP14 => {
|
||||
Name => 'Adobe',
|
||||
Condition => '$$valPt =~ /^Adobe/',
|
||||
Writable => 1, # (for docs only)
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::Adobe' },
|
||||
},
|
||||
APP15 => {
|
||||
Name => 'GraphicConverter',
|
||||
Condition => '$$valPt =~ /^Q\s*(\d+)/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::GraphConv' },
|
||||
},
|
||||
# APP15 - Also unknown "TEXT\0" segment stored by Casio/FujiFilm
|
||||
COM => {
|
||||
Name => 'Comment',
|
||||
# note: flag as writable for documentation, but it won't show up
|
||||
# in the TagLookup as writable because there is no WRITE_PROC
|
||||
Writable => 1,
|
||||
},
|
||||
SOF => {
|
||||
Name => 'StartOfFrame',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::JPEG::SOF' },
|
||||
},
|
||||
DQT => {
|
||||
Name => 'DefineQuantizationTable',
|
||||
Notes => 'used to calculate the Extra JPEGDigest tag value',
|
||||
},
|
||||
Trailer => [{
|
||||
Name => 'AFCP',
|
||||
Condition => '$$valPt =~ /AXS(!|\*).{8}$/s',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::AFCP::Main' },
|
||||
}, {
|
||||
Name => 'CanonVRD',
|
||||
Condition => '$$valPt =~ /CANON OPTIONAL DATA\0.{44}$/s',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::CanonVRD::Main' },
|
||||
}, {
|
||||
Name => 'FotoStation',
|
||||
Condition => '$$valPt =~ /\xa1\xb2\xc3\xd4$/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::FotoStation::Main' },
|
||||
}, {
|
||||
Name => 'PhotoMechanic',
|
||||
Condition => '$$valPt =~ /cbipcbbl$/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::PhotoMechanic::Main' },
|
||||
}, {
|
||||
Name => 'MIE',
|
||||
Condition => q{
|
||||
$$valPt =~ /~\0\x04\0zmie~\0\0\x06.{4}[\x10\x18]\x04$/s or
|
||||
$$valPt =~ /~\0\x04\0zmie~\0\0\x0a.{8}[\x10\x18]\x08$/s
|
||||
},
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::MIE::Main' },
|
||||
}, {
|
||||
Name => 'Samsung',
|
||||
Condition => '$$valPt =~ /QDIOBS$/',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Samsung::Trailer' },
|
||||
}, {
|
||||
Name => 'PreviewImage',
|
||||
Condition => '$$valPt =~ /^\xff\xd8\xff/',
|
||||
Writable => 1, # (for docs only)
|
||||
}],
|
||||
);
|
||||
|
||||
# EPPIM APP6 (Toshiba PrintIM) segment (ref PH, from PDR-M700 samples)
|
||||
%Image::ExifTool::JPEG::EPPIM = (
|
||||
GROUPS => { 0 => 'APP6', 1 => 'EPPIM', 2 => 'Image' },
|
||||
NOTES => q{
|
||||
APP6 is used in by the Toshiba PDR-M700 to store a TIFF structure containing
|
||||
PrintIM information.
|
||||
},
|
||||
0xc4a5 => {
|
||||
Name => 'PrintIM',
|
||||
# must set Writable here so this tag will be saved with MakerNotes option
|
||||
Writable => 'undef',
|
||||
Description => 'Print Image Matching',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::PrintIM::Main',
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
# APP8 SPIFF segment. Refs:
|
||||
# 1) http://www.fileformat.info/format/spiff/
|
||||
# 2) http://www.jpeg.org/public/spiff.pdf
|
||||
%Image::ExifTool::JPEG::SPIFF = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 0 => 'APP8', 1 => 'SPIFF', 2 => 'Image' },
|
||||
NOTES => q{
|
||||
This information is found in APP8 of SPIFF-style JPEG images (the "official"
|
||||
yet rarely used JPEG file format standard: Still Picture Interchange File
|
||||
Format). See L<http://www.jpeg.org/public/spiff.pdf> for the official
|
||||
specification.
|
||||
},
|
||||
0 => {
|
||||
Name => 'SPIFFVersion',
|
||||
Format => 'int8u[2]',
|
||||
PrintConv => '$val =~ tr/ /./; $val',
|
||||
},
|
||||
2 => {
|
||||
Name => 'ProfileID',
|
||||
PrintConv => {
|
||||
0 => 'Not Specified',
|
||||
1 => 'Continuous-tone Base',
|
||||
2 => 'Continuous-tone Progressive',
|
||||
3 => 'Bi-level Facsimile',
|
||||
4 => 'Continuous-tone Facsimile',
|
||||
},
|
||||
},
|
||||
3 => 'ColorComponents',
|
||||
6 => {
|
||||
Name => 'ImageHeight',
|
||||
Notes => q{
|
||||
at index 4 in specification, but there are 2 extra bytes here in my only
|
||||
SPIFF sample, version 1.2
|
||||
},
|
||||
Format => 'int32u',
|
||||
},
|
||||
10 => {
|
||||
Name => 'ImageWidth',
|
||||
Format => 'int32u',
|
||||
},
|
||||
14 => {
|
||||
Name => 'ColorSpace',
|
||||
PrintConv => {
|
||||
0 => 'Bi-level',
|
||||
1 => 'YCbCr, ITU-R BT 709, video',
|
||||
2 => 'No color space specified',
|
||||
3 => 'YCbCr, ITU-R BT 601-1, RGB',
|
||||
4 => 'YCbCr, ITU-R BT 601-1, video',
|
||||
8 => 'Gray-scale',
|
||||
9 => 'PhotoYCC',
|
||||
10 => 'RGB',
|
||||
11 => 'CMY',
|
||||
12 => 'CMYK',
|
||||
13 => 'YCCK',
|
||||
14 => 'CIELab',
|
||||
},
|
||||
},
|
||||
15 => 'BitsPerSample',
|
||||
16 => {
|
||||
Name => 'Compression',
|
||||
PrintConv => {
|
||||
0 => 'Uncompressed, interleaved, 8 bits per sample',
|
||||
1 => 'Modified Huffman',
|
||||
2 => 'Modified READ',
|
||||
3 => 'Modified Modified READ',
|
||||
4 => 'JBIG',
|
||||
5 => 'JPEG',
|
||||
},
|
||||
},
|
||||
17 => {
|
||||
Name => 'ResolutionUnit',
|
||||
PrintConv => {
|
||||
0 => 'None',
|
||||
1 => 'inches',
|
||||
2 => 'cm',
|
||||
},
|
||||
},
|
||||
18 => {
|
||||
Name => 'YResolution',
|
||||
Format => 'int32u',
|
||||
},
|
||||
22 => {
|
||||
Name => 'XResolution',
|
||||
Format => 'int32u',
|
||||
},
|
||||
);
|
||||
|
||||
# APP9 Media Jukebox segment (ref PH)
|
||||
%Image::ExifTool::JPEG::MediaJukebox = (
|
||||
GROUPS => { 0 => 'XML', 1 => 'MediaJukebox', 2 => 'Image' },
|
||||
VARS => { NO_ID => 1 },
|
||||
NOTES => 'Tags found in the XML metadata of the APP9 "Media Jukebox" segment.',
|
||||
Date => {
|
||||
Groups => { 2 => 'Time' },
|
||||
# convert from days since Dec 30, 1899 to seconds since Jan 1, 1970
|
||||
ValueConv => 'ConvertUnixTime(($val - (70 * 365 + 17 + 2)) * 24 * 3600)',
|
||||
PrintConv => '$self->ConvertDateTime($val)',
|
||||
},
|
||||
Album => { },
|
||||
Caption => { },
|
||||
Keywords => { },
|
||||
Name => { },
|
||||
People => { },
|
||||
Places => { },
|
||||
Tool_Name => { },
|
||||
Tool_Version => { },
|
||||
);
|
||||
|
||||
# JPEG-HDR APP11 information (ref PH, guessed from http://anyhere.com/gward/papers/cic05.pdf)
|
||||
%Image::ExifTool::JPEG::HDR = (
|
||||
GROUPS => { 0 => 'APP11', 1 => 'JPEG-HDR', 2 => 'Image' },
|
||||
PROCESS_PROC => \&ProcessJPEG_HDR,
|
||||
TAG_PREFIX => '', # (no prefix for unknown tags)
|
||||
NOTES => 'Information extracted from APP11 of a JPEG-HDR image.',
|
||||
ver => 'JPEG-HDRVersion',
|
||||
# (need names for the next 3 tags)
|
||||
ln0 => { Description => 'Ln0' },
|
||||
ln1 => { Description => 'Ln1' },
|
||||
s2n => { Description => 'S2n' },
|
||||
alp => { Name => 'Alpha' }, # (Alpha/Beta are saturation parameters)
|
||||
bet => { Name => 'Beta' },
|
||||
cor => { Name => 'CorrectionMethod' },
|
||||
RatioImage => {
|
||||
Groups => { 2 => 'Preview' },
|
||||
Notes => 'the embedded JPEG-compressed ratio image',
|
||||
Binary => 1,
|
||||
},
|
||||
);
|
||||
|
||||
# AdobeCM APP13 (no references)
|
||||
%Image::ExifTool::JPEG::AdobeCM = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 0 => 'APP13', 1 => 'AdobeCM', 2 => 'Image' },
|
||||
NOTES => q{
|
||||
The APP13 "Adobe_CM" segment presumably contains color management
|
||||
information, but the meaning of the data is currently unknown. If anyone
|
||||
has an idea about what this means, please let me know.
|
||||
},
|
||||
FORMAT => 'int16u',
|
||||
0 => 'AdobeCMType',
|
||||
);
|
||||
|
||||
# Adobe APP14 refs:
|
||||
# http://partners.adobe.com/public/developer/en/ps/sdk/5116.DCT_Filter.pdf
|
||||
# http://java.sun.com/j2se/1.5.0/docs/api/javax/imageio/metadata/doc-files/jpeg_metadata.html#color
|
||||
%Image::ExifTool::JPEG::Adobe = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 0 => 'APP14', 1 => 'Adobe', 2 => 'Image' },
|
||||
NOTES => q{
|
||||
The APP14 "Adobe" segment stores image encoding information for DCT filters.
|
||||
This segment may be copied or deleted as a block using the Extra "Adobe"
|
||||
tag, but note that it is not deleted by default when deleting all metadata
|
||||
because it may affect the appearance of the image.
|
||||
},
|
||||
FORMAT => 'int16u',
|
||||
0 => 'DCTEncodeVersion',
|
||||
1 => {
|
||||
Name => 'APP14Flags0',
|
||||
PrintConv => {
|
||||
0 => '(none)',
|
||||
BITMASK => {
|
||||
15 => 'Encoded with Blend=1 downsampling'
|
||||
},
|
||||
},
|
||||
},
|
||||
2 => {
|
||||
Name => 'APP14Flags1',
|
||||
PrintConv => {
|
||||
0 => '(none)',
|
||||
BITMASK => { },
|
||||
},
|
||||
},
|
||||
3 => {
|
||||
Name => 'ColorTransform',
|
||||
Format => 'int8u',
|
||||
PrintConv => {
|
||||
0 => 'Unknown (RGB or CMYK)',
|
||||
1 => 'YCbCr',
|
||||
2 => 'YCCK',
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
# GraphicConverter APP15 (ref PH)
|
||||
%Image::ExifTool::JPEG::GraphConv = (
|
||||
GROUPS => { 0 => 'APP15', 1 => 'GraphConv', 2 => 'Image' },
|
||||
NOTES => 'APP15 is used by GraphicConverter to store JPEG quality.',
|
||||
'Q' => 'Quality',
|
||||
);
|
||||
|
||||
# APP0 AVI1 segment (ref http://www.schnarff.com/file-formats/bmp/BMPDIB.TXT)
|
||||
%Image::ExifTool::JPEG::AVI1 = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 0 => 'APP0', 1 => 'AVI1', 2 => 'Image' },
|
||||
NOTES => 'This information may be found in APP0 of JPEG image data from AVI videos.',
|
||||
FIRST_ENTRY => 0,
|
||||
0 => {
|
||||
Name => 'InterleavedField',
|
||||
PrintConv => {
|
||||
0 => 'Not Interleaved',
|
||||
1 => 'Odd',
|
||||
2 => 'Even',
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
# APP0 Ocad segment (ref PH)
|
||||
%Image::ExifTool::JPEG::Ocad = (
|
||||
PROCESS_PROC => \&ProcessOcad,
|
||||
GROUPS => { 0 => 'APP0', 1 => 'Ocad', 2 => 'Image' },
|
||||
TAG_PREFIX => 'Ocad',
|
||||
FIRST_ENTRY => 0,
|
||||
NOTES => q{
|
||||
Tags extracted from the JPEG APP0 "Ocad" segment (found in Photobucket
|
||||
images).
|
||||
},
|
||||
Rev => {
|
||||
Name => 'OcadRevision',
|
||||
Format => 'string[6]',
|
||||
}
|
||||
);
|
||||
|
||||
# APP6 NITF segment (National Imagery Transmission Format)
|
||||
# ref http://www.gwg.nga.mil/ntb/baseline/docs/n010697/bwcguide25aug98.pdf
|
||||
%Image::ExifTool::JPEG::NITF = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 0 => 'APP6', 1 => 'NITF', 2 => 'Image' },
|
||||
NOTES => q{
|
||||
Information in APP6 used by the National Imagery Transmission Format. See
|
||||
L<http://www.gwg.nga.mil/ntb/baseline/docs/n010697/bwcguide25aug98.pdf> for
|
||||
the official specification.
|
||||
},
|
||||
0 => {
|
||||
Name => 'NITFVersion',
|
||||
Format => 'int8u[2]',
|
||||
ValueConv => 'sprintf("%d.%.2d", split(" ",$val))',
|
||||
},
|
||||
2 => {
|
||||
Name => 'ImageFormat',
|
||||
ValueConv => 'chr($val)',
|
||||
PrintConv => { B => 'IMode B' },
|
||||
},
|
||||
3 => {
|
||||
Name => 'BlocksPerRow',
|
||||
Format => 'int16u',
|
||||
},
|
||||
5 => {
|
||||
Name => 'BlocksPerColumn',
|
||||
Format => 'int16u',
|
||||
},
|
||||
7 => {
|
||||
Name => 'ImageColor',
|
||||
PrintConv => { 0 => 'Monochrome' },
|
||||
},
|
||||
8 => 'BitDepth',
|
||||
9 => {
|
||||
Name => 'ImageClass',
|
||||
PrintConv => {
|
||||
0 => 'General Purpose',
|
||||
4 => 'Tactical Imagery',
|
||||
},
|
||||
},
|
||||
10 => {
|
||||
Name => 'JPEGProcess',
|
||||
PrintConv => {
|
||||
1 => 'Baseline sequential DCT, Huffman coding, 8-bit samples',
|
||||
4 => 'Extended sequential DCT, Huffman coding, 12-bit samples',
|
||||
},
|
||||
},
|
||||
11 => 'Quality',
|
||||
12 => {
|
||||
Name => 'StreamColor',
|
||||
PrintConv => { 0 => 'Monochrome' },
|
||||
},
|
||||
13 => 'StreamBitDepth',
|
||||
14 => {
|
||||
Name => 'Flags',
|
||||
Format => 'int32u',
|
||||
PrintConv => 'sprintf("0x%x", $val)',
|
||||
},
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Extract information from the JPEG APP0 Ocad segment
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: 1 on success
|
||||
sub ProcessOcad($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
$et->VerboseDir('APP0 Ocad', undef, length $$dataPt);
|
||||
for (;;) {
|
||||
last unless $$dataPt =~ /\$(\w+):([^\0\$]+)/g;
|
||||
my ($tag, $val) = ($1, $2);
|
||||
$val =~ s/^\s+//; $val =~ s/\s+$//; # remove leading/trailing spaces
|
||||
AddTagToTable($tagTablePtr, $tag) unless $$tagTablePtr{$tag};
|
||||
$et->HandleTag($tagTablePtr, $tag, $val);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Extract information from the JPEG APP0 Ocad segment
|
||||
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||||
# Returns: 1 on success
|
||||
sub ProcessJPEG_HDR($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
$$dataPt =~ /~\0/g or $et->Warn('Unrecognized JPEG-HDR format'), return 0;
|
||||
my $pos = pos $$dataPt;
|
||||
my $meta = substr($$dataPt, 7, $pos-9);
|
||||
$et->VerboseDir('APP11 JPEG-HDR', undef, length $$dataPt);
|
||||
while ($meta =~ /(\w+)=([^,\s]*)/g) {
|
||||
my ($tag, $val) = ($1, $2);
|
||||
AddTagToTable($tagTablePtr, $tag) unless $$tagTablePtr{$tag};
|
||||
$et->HandleTag($tagTablePtr, $tag, $val);
|
||||
}
|
||||
$et->HandleTag($tagTablePtr, 'RatioImage', substr($$dataPt, $pos));
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::JPEG - Definitions for uncommon JPEG segments
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool for some
|
||||
uncommon JPEG segments. For speed reasons, definitions for more common JPEG
|
||||
segments are included in the Image::ExifTool module itself.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/JPEG Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,142 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: JSON.pm
|
||||
#
|
||||
# Description: Read JSON files
|
||||
#
|
||||
# Notes: Set ExifTool MissingTagValue to "null" to ignore JSON nulls
|
||||
#
|
||||
# Revisions: 2017/03/13 - P. Harvey Created
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::JSON;
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
use Image::ExifTool::Import;
|
||||
|
||||
$VERSION = '1.01';
|
||||
|
||||
sub ProcessTag($$$$%);
|
||||
|
||||
%Image::ExifTool::JSON::Main = (
|
||||
GROUPS => { 0 => 'JSON', 1 => 'JSON', 2 => 'Other' },
|
||||
NOTES => q{
|
||||
No JSON tags have been pre-defined, but ExifTool will read any existing
|
||||
tags from basic JSON-formatted files.
|
||||
},
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Store a tag value
|
||||
# Inputs: 0) ExifTool ref, 1) tag table, 2) tag ID, 3) value, 4) tagInfo flags
|
||||
sub FoundTag($$$$%)
|
||||
{
|
||||
my ($et, $tagTablePtr, $tag, $val, %flags) = @_;
|
||||
|
||||
# avoid conflict with special table entries
|
||||
$tag .= '!' if $Image::ExifTool::specialTags{$tag};
|
||||
|
||||
AddTagToTable($tagTablePtr, $tag, {
|
||||
Name => Image::ExifTool::MakeTagName($tag),
|
||||
%flags,
|
||||
}) unless $$tagTablePtr{$tag};
|
||||
|
||||
$et->HandleTag($tagTablePtr, $tag, $val);
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process a JSON tag
|
||||
# Inputs: 0) ExifTool ref, 1) tag table, 2) tag ID, 3) value, 4) tagInfo flags
|
||||
# - expands structures into flattened tags as required
|
||||
sub ProcessTag($$$$%)
|
||||
{
|
||||
local $_;
|
||||
my ($et, $tagTablePtr, $tag, $val, %flags) = @_;
|
||||
|
||||
if (ref $val eq 'HASH') {
|
||||
if ($et->Options('Struct')) {
|
||||
FoundTag($et, $tagTablePtr, $tag, $val, %flags, Struct => 1);
|
||||
return unless $et->Options('Struct') > 1;
|
||||
}
|
||||
foreach (sort keys %$val) {
|
||||
ProcessTag($et, $tagTablePtr, $tag . ucfirst, $$val{$_}, %flags, Flat => 1);
|
||||
}
|
||||
} elsif (ref $val eq 'ARRAY') {
|
||||
foreach (@$val) {
|
||||
ProcessTag($et, $tagTablePtr, $tag, $_, %flags, List => 1);
|
||||
}
|
||||
} elsif (defined $val) {
|
||||
FoundTag($et, $tagTablePtr, $tag, $val, %flags);
|
||||
}
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Extract meta information from a JSON file
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
||||
# Returns: 1 on success, 0 if this wasn't a recognized JSON file
|
||||
sub ProcessJSON($$)
|
||||
{
|
||||
local $_;
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $structOpt = $et->Options('Struct');
|
||||
my (%database, $key, $tag);
|
||||
|
||||
# read information from JSON file into database structure
|
||||
my $err = Image::ExifTool::Import::ReadJSON($raf, \%database,
|
||||
$et->Options('MissingTagValue'), $et->Options('Charset'));
|
||||
|
||||
return 0 if $err or not %database;
|
||||
|
||||
$et->SetFileType();
|
||||
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::JSON::Main');
|
||||
|
||||
# remove any old tag definitions in case they change flags
|
||||
foreach $key (TagTableKeys($tagTablePtr)) {
|
||||
delete $$tagTablePtr{$key};
|
||||
}
|
||||
|
||||
# extract tags from JSON database
|
||||
foreach $key (sort keys %database) {
|
||||
foreach $tag (sort keys %{$database{$key}}) {
|
||||
my $val = $database{$key}{$tag};
|
||||
# (ignore SourceFile if generated automatically by ReadJSON)
|
||||
next if $tag eq 'SourceFile' and defined $val and $val eq '*';
|
||||
ProcessTag($et, $tagTablePtr, $tag, $val);
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::JSON - Read JSON files
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains definitions required by Image::ExifTool read
|
||||
information from JSON files.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/JSON Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
@@ -0,0 +1,130 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: JVC.pm
|
||||
#
|
||||
# Description: JVC EXIF maker notes tags
|
||||
#
|
||||
# Revisions: 12/21/2005 - P. Harvey Created
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::JVC;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
use Image::ExifTool::Exif;
|
||||
|
||||
$VERSION = '1.03';
|
||||
|
||||
sub ProcessJVCText($$$);
|
||||
|
||||
# JVC EXIF-based maker notes
|
||||
%Image::ExifTool::JVC::Main = (
|
||||
WRITE_PROC => \&Image::ExifTool::Exif::WriteExif,
|
||||
CHECK_PROC => \&Image::ExifTool::Exif::CheckExif,
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
|
||||
NOTES => 'JVC EXIF maker note tags.',
|
||||
#0x0001 - almost always '2', but '3' for GR-DV700 samples
|
||||
0x0002 => { #PH
|
||||
Name => 'CPUVersions',
|
||||
# remove trailing nulls/spaces and split at remaining nulls/spaces
|
||||
ValueConv => '$_=$val; s/(\s*\0)+$//; s/(\s*\0)+/, /g; $_',
|
||||
},
|
||||
0x0003 => { #PH
|
||||
Name => 'Quality',
|
||||
PrintConv => {
|
||||
0 => 'Low',
|
||||
1 => 'Normal',
|
||||
2 => 'Fine',
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
# JVC text-based maker notes
|
||||
%Image::ExifTool::JVC::Text = (
|
||||
GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
|
||||
PROCESS_PROC => \&ProcessJVCText,
|
||||
NOTES => 'JVC/Victor text-based maker note tags.',
|
||||
VER => 'MakerNoteVersion', #PH
|
||||
QTY => { #PH
|
||||
Name => 'Quality',
|
||||
PrintConv => {
|
||||
STND => 'Normal',
|
||||
STD => 'Normal',
|
||||
FINE => 'Fine',
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process JVC text-based maker notes
|
||||
# Inputs: 0) ExifTool object reference
|
||||
# 1) Reference to directory information hash
|
||||
# 2) Pointer to tag table for this directory
|
||||
# Returns: 1 on success, otherwise returns 0 and sets a Warning
|
||||
sub ProcessJVCText($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dirStart = $$dirInfo{DirStart} || 0;
|
||||
my $dataLen = $$dirInfo{DataLen};
|
||||
my $dirLen = $$dirInfo{DirLen} || $dataLen - $dirStart;
|
||||
my $verbose = $et->Options('Verbose');
|
||||
|
||||
my $data = substr($$dataPt, $dirStart, $dirLen);
|
||||
# validate text maker notes
|
||||
unless ($data =~ /^VER:/) {
|
||||
$et->Warn('Bad JVC text maker notes');
|
||||
return 0;
|
||||
}
|
||||
while ($data =~ m/([A-Z]+):(.{3,4})/sg) {
|
||||
my ($tag, $val) = ($1, $2);
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
|
||||
$et->VerboseInfo($tag, $tagInfo,
|
||||
Table => $tagTablePtr,
|
||||
Value => $val,
|
||||
) if $verbose;
|
||||
unless ($tagInfo) {
|
||||
next unless $$et{OPTIONS}{Unknown};
|
||||
$tagInfo = {
|
||||
Name => "JVC_Text_$tag",
|
||||
Unknown => 1,
|
||||
PrintConv => 'length($val) > 60 ? substr($val,0,55) . "[...]" : $val',
|
||||
};
|
||||
# add tag information to table
|
||||
AddTagToTable($tagTablePtr, $tag, $tagInfo);
|
||||
}
|
||||
$et->FoundTag($tagInfo, $val);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::JVC - JVC EXIF maker notes tags
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is loaded automatically by Image::ExifTool when required.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains routines used by Image::ExifTool to interpret JVC maker
|
||||
notes.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/JVC Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
@@ -0,0 +1,898 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# File: Jpeg2000.pm
|
||||
#
|
||||
# Description: Read JPEG 2000 meta information
|
||||
#
|
||||
# Revisions: 02/11/2005 - P. Harvey Created
|
||||
# 06/22/2007 - PH Added write support (EXIF, IPTC and XMP only)
|
||||
#
|
||||
# References: 1) http://www.jpeg.org/public/fcd15444-2.pdf
|
||||
# 2) ftp://ftp.remotesensing.org/jpeg2000/fcd15444-1.pdf
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
package Image::ExifTool::Jpeg2000;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
use Image::ExifTool qw(:DataAccess :Utils);
|
||||
|
||||
$VERSION = '1.26';
|
||||
|
||||
sub ProcessJpeg2000Box($$$);
|
||||
|
||||
my %resolutionUnit = (
|
||||
-3 => 'km',
|
||||
-2 => '100 m',
|
||||
-1 => '10 m',
|
||||
0 => 'm',
|
||||
1 => '10 cm',
|
||||
2 => 'cm',
|
||||
3 => 'mm',
|
||||
4 => '0.1 mm',
|
||||
5 => '0.01 mm',
|
||||
6 => 'um',
|
||||
);
|
||||
|
||||
# map of where information is written in JPEG2000 image
|
||||
my %jp2Map = (
|
||||
IPTC => 'UUID-IPTC',
|
||||
IFD0 => 'UUID-EXIF',
|
||||
XMP => 'UUID-XMP',
|
||||
'UUID-IPTC' => 'JP2',
|
||||
'UUID-EXIF' => 'JP2',
|
||||
'UUID-XMP' => 'JP2',
|
||||
# jp2h => 'JP2', (not yet functional)
|
||||
# ICC_Profile => 'jp2h', (not yet functional)
|
||||
IFD1 => 'IFD0',
|
||||
EXIF => 'IFD0', # to write EXIF as a block
|
||||
ExifIFD => 'IFD0',
|
||||
GPS => 'IFD0',
|
||||
SubIFD => 'IFD0',
|
||||
GlobParamIFD => 'IFD0',
|
||||
PrintIM => 'IFD0',
|
||||
InteropIFD => 'ExifIFD',
|
||||
MakerNotes => 'ExifIFD',
|
||||
);
|
||||
|
||||
# UUID's for writable UUID directories (by tag name)
|
||||
my %uuid = (
|
||||
'UUID-EXIF' => 'JpgTiffExif->JP2',
|
||||
'UUID-EXIF2' => '', # (flags a warning when writing)
|
||||
'UUID-EXIF_bad' => '0', # (flags a warning when reading and writing)
|
||||
'UUID-IPTC' => "\x33\xc7\xa4\xd2\xb8\x1d\x47\x23\xa0\xba\xf1\xa3\xe0\x97\xad\x38",
|
||||
'UUID-XMP' => "\xbe\x7a\xcf\xcb\x97\xa9\x42\xe8\x9c\x71\x99\x94\x91\xe3\xaf\xac",
|
||||
# (can't yet write GeoJP2 information)
|
||||
# 'UUID-GeoJP2' => "\xb1\x4b\xf8\xbd\x08\x3d\x4b\x43\xa5\xae\x8c\xd7\xd5\xa6\xce\x03",
|
||||
);
|
||||
|
||||
# JPEG2000 codestream markers (ref ISO/IEC FCD15444-1/2)
|
||||
my %j2cMarker = (
|
||||
0x4f => 'SOC', # start of codestream
|
||||
0x51 => 'SIZ', # image and tile size
|
||||
0x52 => 'COD', # coding style default
|
||||
0x53 => 'COC', # coding style component
|
||||
0x55 => 'TLM', # tile-part lengths
|
||||
0x57 => 'PLM', # packet length, main header
|
||||
0x58 => 'PLT', # packet length, tile-part header
|
||||
0x5c => 'QCD', # quantization default
|
||||
0x5d => 'QCC', # quantization component
|
||||
0x5e => 'RGN', # region of interest
|
||||
0x5f => 'POD', # progression order default
|
||||
0x60 => 'PPM', # packed packet headers, main
|
||||
0x61 => 'PPT', # packed packet headers, tile-part
|
||||
0x63 => 'CRG', # component registration
|
||||
0x64 => 'CME', # comment and extension
|
||||
0x90 => 'SOT', # start of tile-part
|
||||
0x91 => 'SOP', # start of packet
|
||||
0x92 => 'EPH', # end of packet header
|
||||
0x93 => 'SOD', # start of data
|
||||
# extensions (ref ISO/IEC FCD15444-2)
|
||||
0x70 => 'DCO', # variable DC offset
|
||||
0x71 => 'VMS', # visual masking
|
||||
0x72 => 'DFS', # downsampling factor style
|
||||
0x73 => 'ADS', # arbitrary decomposition style
|
||||
# 0x72 => 'ATK', # arbitrary transformation kernels ?
|
||||
0x78 => 'CBD', # component bit depth
|
||||
0x74 => 'MCT', # multiple component transformation definition
|
||||
0x75 => 'MCC', # multiple component collection
|
||||
0x77 => 'MIC', # multiple component intermediate collection
|
||||
0x76 => 'NLT', # non-linearity point transformation
|
||||
);
|
||||
|
||||
# JPEG 2000 "box" (ie. atom) names
|
||||
# Note: only tags with a defined "Format" are extracted
|
||||
%Image::ExifTool::Jpeg2000::Main = (
|
||||
GROUPS => { 2 => 'Image' },
|
||||
PROCESS_PROC => \&ProcessJpeg2000Box,
|
||||
WRITE_PROC => \&ProcessJpeg2000Box,
|
||||
PREFERRED => 1, # always add these tags when writing
|
||||
NOTES => q{
|
||||
The tags below are extracted from JPEG 2000 images, however ExifTool
|
||||
currently writes only EXIF, IPTC and XMP tags in these images.
|
||||
},
|
||||
'jP ' => 'JP2Signature', # (ref 1)
|
||||
"jP\x1a\x1a" => 'JP2Signature', # (ref 2)
|
||||
prfl => 'Profile',
|
||||
ftyp => {
|
||||
Name => 'FileType',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::Jpeg2000::FileType' },
|
||||
},
|
||||
rreq => 'ReaderRequirements',
|
||||
jp2h => {
|
||||
Name => 'JP2Header',
|
||||
SubDirectory => { },
|
||||
},
|
||||
# JP2Header sub boxes...
|
||||
ihdr => {
|
||||
Name => 'ImageHeader',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::Jpeg2000::ImageHeader',
|
||||
},
|
||||
},
|
||||
bpcc => 'BitsPerComponent',
|
||||
colr => {
|
||||
Name => 'ColorSpecification',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::Jpeg2000::ColorSpec',
|
||||
},
|
||||
},
|
||||
pclr => 'Palette',
|
||||
cdef => 'ComponentDefinition',
|
||||
'res '=> {
|
||||
Name => 'Resolution',
|
||||
SubDirectory => { },
|
||||
},
|
||||
# Resolution sub boxes...
|
||||
resc => {
|
||||
Name => 'CaptureResolution',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::Jpeg2000::CaptureResolution',
|
||||
},
|
||||
},
|
||||
resd => {
|
||||
Name => 'DisplayResolution',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::Jpeg2000::DisplayResolution',
|
||||
},
|
||||
},
|
||||
jpch => {
|
||||
Name => 'CodestreamHeader',
|
||||
SubDirectory => { },
|
||||
},
|
||||
# CodestreamHeader sub boxes...
|
||||
'lbl '=> {
|
||||
Name => 'Label',
|
||||
Format => 'string',
|
||||
},
|
||||
cmap => 'ComponentMapping',
|
||||
roid => 'ROIDescription',
|
||||
jplh => {
|
||||
Name => 'CompositingLayerHeader',
|
||||
SubDirectory => { },
|
||||
},
|
||||
# CompositingLayerHeader sub boxes...
|
||||
cgrp => 'ColorGroup',
|
||||
opct => 'Opacity',
|
||||
creg => 'CodestreamRegistration',
|
||||
dtbl => 'DataReference',
|
||||
ftbl => {
|
||||
Name => 'FragmentTable',
|
||||
Subdirectory => { },
|
||||
},
|
||||
# FragmentTable sub boxes...
|
||||
flst => 'FragmentList',
|
||||
cref => 'Cross-Reference',
|
||||
mdat => 'MediaData',
|
||||
comp => 'Composition',
|
||||
copt => 'CompositionOptions',
|
||||
inst => 'InstructionSet',
|
||||
asoc => 'Association',
|
||||
nlst => 'NumberList',
|
||||
bfil => 'BinaryFilter',
|
||||
drep => 'DesiredReproductions',
|
||||
# DesiredReproductions sub boxes...
|
||||
gtso => 'GraphicsTechnologyStandardOutput',
|
||||
chck => 'DigitalSignature',
|
||||
mp7b => 'MPEG7Binary',
|
||||
free => 'Free',
|
||||
jp2c => 'ContiguousCodestream',
|
||||
jp2i => {
|
||||
Name => 'IntellectualProperty',
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
|
||||
},
|
||||
'xml '=> {
|
||||
Name => 'XML',
|
||||
Writable => 'undef',
|
||||
Flags => [ 'Binary', 'Protected', 'BlockExtract' ],
|
||||
List => 1,
|
||||
Notes => q{
|
||||
by default, the XML data in this tag is parsed using the ExifTool XMP module
|
||||
to to allow individual tags to be accessed when reading, but it may also be
|
||||
extracted as a block via the "XML" tag, which is also how this tag is
|
||||
written and copied. This is a List-type tag because multiple XML blocks may
|
||||
exist
|
||||
},
|
||||
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
|
||||
},
|
||||
uuid => [
|
||||
{
|
||||
Name => 'UUID-EXIF',
|
||||
# (this is the EXIF that we create)
|
||||
Condition => '$$valPt=~/^JpgTiffExif->JP2(?!Exif\0\0)/',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::Exif::Main',
|
||||
ProcessProc => \&Image::ExifTool::ProcessTIFF,
|
||||
WriteProc => \&Image::ExifTool::WriteTIFF,
|
||||
DirName => 'EXIF',
|
||||
Start => '$valuePtr + 16',
|
||||
},
|
||||
},
|
||||
{
|
||||
Name => 'UUID-EXIF2',
|
||||
# written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5
|
||||
Condition => '$$valPt=~/^\x05\x37\xcd\xab\x9d\x0c\x44\x31\xa7\x2a\xfa\x56\x1f\x2a\x11\x3e/',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::Exif::Main',
|
||||
ProcessProc => \&Image::ExifTool::ProcessTIFF,
|
||||
WriteProc => \&Image::ExifTool::WriteTIFF,
|
||||
DirName => 'EXIF',
|
||||
Start => '$valuePtr + 16',
|
||||
},
|
||||
},
|
||||
{
|
||||
Name => 'UUID-EXIF_bad',
|
||||
# written by Digikam
|
||||
Condition => '$$valPt=~/^JpgTiffExif->JP2/',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::Exif::Main',
|
||||
ProcessProc => \&Image::ExifTool::ProcessTIFF,
|
||||
WriteProc => \&Image::ExifTool::WriteTIFF,
|
||||
DirName => 'EXIF',
|
||||
Start => '$valuePtr + 22',
|
||||
},
|
||||
},
|
||||
{
|
||||
Name => 'UUID-IPTC',
|
||||
# (this is the IPTC that we create)
|
||||
Condition => '$$valPt=~/^\x33\xc7\xa4\xd2\xb8\x1d\x47\x23\xa0\xba\xf1\xa3\xe0\x97\xad\x38/',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::IPTC::Main',
|
||||
Start => '$valuePtr + 16',
|
||||
},
|
||||
},
|
||||
{
|
||||
Name => 'UUID-IPTC2',
|
||||
# written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5
|
||||
Condition => '$$valPt=~/^\x09\xa1\x4e\x97\xc0\xb4\x42\xe0\xbe\xbf\x36\xdf\x6f\x0c\xe3\x6f/',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::IPTC::Main',
|
||||
Start => '$valuePtr + 16',
|
||||
},
|
||||
},
|
||||
{
|
||||
Name => 'UUID-XMP',
|
||||
# ref http://www.adobe.com/products/xmp/pdfs/xmpspec.pdf
|
||||
Condition => '$$valPt=~/^\xbe\x7a\xcf\xcb\x97\xa9\x42\xe8\x9c\x71\x99\x94\x91\xe3\xaf\xac/',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::XMP::Main',
|
||||
Start => '$valuePtr + 16',
|
||||
},
|
||||
},
|
||||
{
|
||||
Name => 'UUID-GeoJP2',
|
||||
# ref http://www.remotesensing.org/jpeg2000/
|
||||
Condition => '$$valPt=~/^\xb1\x4b\xf8\xbd\x08\x3d\x4b\x43\xa5\xae\x8c\xd7\xd5\xa6\xce\x03/',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::Exif::Main',
|
||||
ProcessProc => \&Image::ExifTool::ProcessTIFF,
|
||||
Start => '$valuePtr + 16',
|
||||
},
|
||||
},
|
||||
{
|
||||
Name => 'UUID-Photoshop',
|
||||
# written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5
|
||||
Condition => '$$valPt=~/^\x2c\x4c\x01\x00\x85\x04\x40\xb9\xa0\x3e\x56\x21\x48\xd6\xdf\xeb/',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::Photoshop::Main',
|
||||
Start => '$valuePtr + 16',
|
||||
},
|
||||
},
|
||||
{
|
||||
Name => 'UUID-Unknown',
|
||||
},
|
||||
# also written by Adobe JPEG2000 plugin v1.5:
|
||||
# 3a 0d 02 18 0a e9 41 15 b3 76 4b ca 41 ce 0e 71 - 1 byte (01)
|
||||
# 47 c9 2c cc d1 a1 45 81 b9 04 38 bb 54 67 71 3b - 1 byte (01)
|
||||
# bc 45 a7 74 dd 50 4e c6 a9 f6 f3 a1 37 f4 7e 90 - 4 bytes (00 00 00 32)
|
||||
# d7 c8 c5 ef 95 1f 43 b2 87 57 04 25 00 f5 38 e8 - 4 bytes (00 00 00 32)
|
||||
],
|
||||
uinf => {
|
||||
Name => 'UUIDInfo',
|
||||
SubDirectory => { },
|
||||
},
|
||||
# UUIDInfo sub boxes...
|
||||
ulst => 'UUIDList',
|
||||
'url '=> {
|
||||
Name => 'URL',
|
||||
Format => 'string',
|
||||
},
|
||||
);
|
||||
|
||||
%Image::ExifTool::Jpeg2000::ImageHeader = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 2 => 'Image' },
|
||||
0 => {
|
||||
Name => 'ImageHeight',
|
||||
Format => 'int32u',
|
||||
},
|
||||
4 => {
|
||||
Name => 'ImageWidth',
|
||||
Format => 'int32u',
|
||||
},
|
||||
8 => {
|
||||
Name => 'NumberOfComponents',
|
||||
Format => 'int16u',
|
||||
},
|
||||
10 => {
|
||||
Name => 'BitsPerComponent',
|
||||
PrintConv => q{
|
||||
$val == 0xff and return 'Variable';
|
||||
my $sign = ($val & 0x80) ? 'Signed' : 'Unsigned';
|
||||
return (($val & 0x7f) + 1) . " Bits, $sign";
|
||||
},
|
||||
},
|
||||
11 => {
|
||||
Name => 'Compression',
|
||||
PrintConv => {
|
||||
0 => 'Uncompressed',
|
||||
1 => 'Modified Huffman',
|
||||
2 => 'Modified READ',
|
||||
3 => 'Modified Modified READ',
|
||||
4 => 'JBIG',
|
||||
5 => 'JPEG',
|
||||
6 => 'JPEG-LS',
|
||||
7 => 'JPEG 2000',
|
||||
8 => 'JBIG2',
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
# (ref fcd15444-1/2/6.pdf)
|
||||
# (also see http://developer.apple.com/mac/library/documentation/QuickTime/QTFF/QTFFChap1/qtff1.html)
|
||||
%Image::ExifTool::Jpeg2000::FileType = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 2 => 'Video' },
|
||||
FORMAT => 'int32u',
|
||||
0 => {
|
||||
Name => 'MajorBrand',
|
||||
Format => 'undef[4]',
|
||||
PrintConv => {
|
||||
'jp2 ' => 'JPEG 2000 Image (.JP2)', # image/jp2
|
||||
'jpm ' => 'JPEG 2000 Compound Image (.JPM)', # image/jpm
|
||||
'jpx ' => 'JPEG 2000 with extensions (.JPX)', # image/jpx
|
||||
},
|
||||
},
|
||||
1 => {
|
||||
Name => 'MinorVersion',
|
||||
Format => 'undef[4]',
|
||||
ValueConv => 'sprintf("%x.%x.%x", unpack("nCC", $val))',
|
||||
},
|
||||
2 => {
|
||||
Name => 'CompatibleBrands',
|
||||
Format => 'undef[$size-8]',
|
||||
# ignore any entry with a null, and return others as a list
|
||||
ValueConv => 'my @a=($val=~/.{4}/sg); @a=grep(!/\0/,@a); \@a',
|
||||
},
|
||||
);
|
||||
|
||||
%Image::ExifTool::Jpeg2000::CaptureResolution = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 2 => 'Image' },
|
||||
FORMAT => 'int8s',
|
||||
0 => {
|
||||
Name => 'CaptureYResolution',
|
||||
Format => 'rational32u',
|
||||
},
|
||||
4 => {
|
||||
Name => 'CaptureXResolution',
|
||||
Format => 'rational32u',
|
||||
},
|
||||
8 => {
|
||||
Name => 'CaptureYResolutionUnit',
|
||||
SeparateTable => 'ResolutionUnit',
|
||||
PrintConv => \%resolutionUnit,
|
||||
},
|
||||
9 => {
|
||||
Name => 'CaptureXResolutionUnit',
|
||||
SeparateTable => 'ResolutionUnit',
|
||||
PrintConv => \%resolutionUnit,
|
||||
},
|
||||
);
|
||||
|
||||
%Image::ExifTool::Jpeg2000::DisplayResolution = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 2 => 'Image' },
|
||||
FORMAT => 'int8s',
|
||||
0 => {
|
||||
Name => 'DisplayYResolution',
|
||||
Format => 'rational32u',
|
||||
},
|
||||
4 => {
|
||||
Name => 'DisplayXResolution',
|
||||
Format => 'rational32u',
|
||||
},
|
||||
8 => {
|
||||
Name => 'DisplayYResolutionUnit',
|
||||
SeparateTable => 'ResolutionUnit',
|
||||
PrintConv => \%resolutionUnit,
|
||||
},
|
||||
9 => {
|
||||
Name => 'DisplayXResolutionUnit',
|
||||
SeparateTable => 'ResolutionUnit',
|
||||
PrintConv => \%resolutionUnit,
|
||||
},
|
||||
);
|
||||
|
||||
%Image::ExifTool::Jpeg2000::ColorSpec = (
|
||||
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
||||
GROUPS => { 2 => 'Image' },
|
||||
FORMAT => 'int8s',
|
||||
0 => {
|
||||
Name => 'ColorSpecMethod',
|
||||
RawConv => '$$self{ColorSpecMethod} = $val',
|
||||
PrintConv => {
|
||||
1 => 'Enumerated',
|
||||
2 => 'Restricted ICC',
|
||||
3 => 'Any ICC',
|
||||
4 => 'Vendor Color',
|
||||
},
|
||||
},
|
||||
1 => 'ColorSpecPrecedence',
|
||||
2 => {
|
||||
Name => 'ColorSpecApproximation',
|
||||
PrintConv => {
|
||||
0 => 'Not Specified',
|
||||
1 => 'Accurate',
|
||||
2 => 'Exceptional Quality',
|
||||
3 => 'Reasonable Quality',
|
||||
4 => 'Poor Quality',
|
||||
},
|
||||
},
|
||||
3 => [
|
||||
{
|
||||
Name => 'ICC_Profile',
|
||||
Condition => q{
|
||||
$$self{ColorSpecMethod} == 2 or
|
||||
$$self{ColorSpecMethod} == 3
|
||||
},
|
||||
Format => 'undef[$size-3]',
|
||||
SubDirectory => {
|
||||
TagTable => 'Image::ExifTool::ICC_Profile::Main',
|
||||
},
|
||||
},
|
||||
{
|
||||
Name => 'ColorSpace',
|
||||
Condition => '$$self{ColorSpecMethod} == 1',
|
||||
Format => 'int32u',
|
||||
PrintConv => { # ref 15444-2 2002-05-15
|
||||
0 => 'Bi-level',
|
||||
1 => 'YCbCr(1)',
|
||||
3 => 'YCbCr(2)',
|
||||
4 => 'YCbCr(3)',
|
||||
9 => 'PhotoYCC',
|
||||
11 => 'CMY',
|
||||
12 => 'CMYK',
|
||||
13 => 'YCCK',
|
||||
14 => 'CIELab',
|
||||
15 => 'Bi-level(2)', # (incorrectly listed as 18 in 15444-2 2000-12-07)
|
||||
16 => 'sRGB',
|
||||
17 => 'Grayscale',
|
||||
18 => 'sYCC',
|
||||
19 => 'CIEJab',
|
||||
20 => 'e-sRGB',
|
||||
21 => 'ROMM-RGB',
|
||||
# incorrect in 15444-2 2000-12-07
|
||||
#22 => 'sRGB based YCbCr',
|
||||
#23 => 'YPbPr(1125/60)',
|
||||
#24 => 'YPbPr(1250/50)',
|
||||
22 => 'YPbPr(1125/60)',
|
||||
23 => 'YPbPr(1250/50)',
|
||||
24 => 'e-sYCC',
|
||||
},
|
||||
},
|
||||
{
|
||||
Name => 'ColorSpecData',
|
||||
Format => 'undef[$size-3]',
|
||||
Binary => 1,
|
||||
},
|
||||
],
|
||||
);
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Create new JPEG 2000 boxes when writing
|
||||
# (Currently only supports adding top-level Writable JPEG2000 tags and certain UUID boxes)
|
||||
# Inputs: 0) ExifTool object ref, 1) Output file or scalar ref
|
||||
# Returns: 1 on success
|
||||
sub CreateNewBoxes($$)
|
||||
{
|
||||
my ($et, $outfile) = @_;
|
||||
my $addTags = $$et{AddJp2Tags};
|
||||
my $addDirs = $$et{AddJp2Dirs};
|
||||
delete $$et{AddJp2Tags};
|
||||
delete $$et{AddJp2Dirs};
|
||||
my ($tag, $dirName);
|
||||
# add JPEG2000 tags
|
||||
foreach $tag (sort keys %$addTags) {
|
||||
my $tagInfo = $$addTags{$tag};
|
||||
my $nvHash = $et->GetNewValueHash($tagInfo);
|
||||
# (native JPEG2000 information is always preferred, so don't check IsCreating)
|
||||
next unless $$tagInfo{List} or $et->IsOverwriting($nvHash) > 0;
|
||||
next if $$nvHash{EditOnly};
|
||||
my @vals = $et->GetNewValue($nvHash);
|
||||
my $val;
|
||||
foreach $val (@vals) {
|
||||
my $boxhdr = pack('N', length($val) + 8) . $$tagInfo{TagID};
|
||||
Write($outfile, $boxhdr, $val) or return 0;
|
||||
++$$et{CHANGED};
|
||||
$et->VerboseValue("+ Jpeg2000:$$tagInfo{Name}", $val);
|
||||
}
|
||||
}
|
||||
# add UUID boxes
|
||||
foreach $dirName (sort keys %$addDirs) {
|
||||
next unless $uuid{$dirName};
|
||||
my $tagInfo;
|
||||
foreach $tagInfo (@{$Image::ExifTool::Jpeg2000::Main{uuid}}) {
|
||||
next unless $$tagInfo{Name} eq $dirName;
|
||||
my $subdir = $$tagInfo{SubDirectory};
|
||||
my $tagTable = GetTagTable($$subdir{TagTable});
|
||||
my %dirInfo = (
|
||||
DirName => $$subdir{DirName} || $dirName,
|
||||
Parent => 'JP2',
|
||||
);
|
||||
# remove "UUID-" from start of directory name to allow appropriate
|
||||
# directories to be written as a block
|
||||
$dirInfo{DirName} =~ s/^UUID-//;
|
||||
my $newdir = $et->WriteDirectory(\%dirInfo, $tagTable, $$subdir{WriteProc});
|
||||
if (defined $newdir and length $newdir) {
|
||||
my $boxhdr = pack('N', length($newdir) + 24) . 'uuid' . $uuid{$dirName};
|
||||
Write($outfile, $boxhdr, $newdir) or return 0;
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Process JPEG 2000 box
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference, 2) Pointer to tag table
|
||||
# Returns: 1 on success when reading, or -1 on write error
|
||||
# (or JP2 box or undef when writing from buffer)
|
||||
sub ProcessJpeg2000Box($$$)
|
||||
{
|
||||
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||||
my $dataPt = $$dirInfo{DataPt};
|
||||
my $dataLen = $$dirInfo{DataLen};
|
||||
my $dataPos = $$dirInfo{DataPos};
|
||||
my $dirLen = $$dirInfo{DirLen} || 0;
|
||||
my $dirStart = $$dirInfo{DirStart} || 0;
|
||||
my $base = $$dirInfo{Base} || 0;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $outfile = $$dirInfo{OutFile};
|
||||
my $dirEnd = $dirStart + $dirLen;
|
||||
my ($err, $outBuff, $verbose);
|
||||
|
||||
if ($outfile) {
|
||||
unless ($raf) {
|
||||
# buffer output to be used for return value
|
||||
$outBuff = '';
|
||||
$outfile = \$outBuff;
|
||||
}
|
||||
} else {
|
||||
# (must not set verbose flag when writing!)
|
||||
$verbose = $$et{OPTIONS}{Verbose};
|
||||
$et->VerboseDir($$dirInfo{DirName}) if $verbose;
|
||||
}
|
||||
# loop through all contained boxes
|
||||
my ($pos, $boxLen);
|
||||
for ($pos=$dirStart; ; $pos+=$boxLen) {
|
||||
my ($boxID, $buff, $valuePtr);
|
||||
my $hdrLen = 8; # the box header length
|
||||
if ($raf) {
|
||||
$dataPos = $raf->Tell() - $base;
|
||||
my $n = $raf->Read($buff,$hdrLen);
|
||||
unless ($n == $hdrLen) {
|
||||
$n and $err = '', last;
|
||||
if ($outfile) {
|
||||
CreateNewBoxes($et, $outfile) or $err = 1;
|
||||
}
|
||||
last;
|
||||
}
|
||||
$dataPt = \$buff;
|
||||
$dirLen = $dirEnd = $hdrLen;
|
||||
$pos = 0;
|
||||
} elsif ($pos >= $dirEnd - $hdrLen) {
|
||||
$err = '' unless $pos == $dirEnd;
|
||||
last;
|
||||
}
|
||||
$boxLen = unpack("x$pos N",$$dataPt); # (length includes header and data)
|
||||
$boxID = substr($$dataPt, $pos+4, 4);
|
||||
$pos += $hdrLen; # move to end of box header
|
||||
if ($boxLen == 1) {
|
||||
# box header contains an additional 8-byte integer for length
|
||||
$hdrLen += 8;
|
||||
if ($raf) {
|
||||
my $buf2;
|
||||
if ($raf->Read($buf2,8) == 8) {
|
||||
$buff .= $buf2;
|
||||
$dirLen = $dirEnd = $hdrLen;
|
||||
}
|
||||
}
|
||||
$pos > $dirEnd - 8 and $err = '', last;
|
||||
my ($hi, $lo) = unpack("x$pos N2",$$dataPt);
|
||||
$hi and $err = "Can't currently handle JPEG 2000 boxes > 4 GB", last;
|
||||
$pos += 8; # move to end of extended-length box header
|
||||
$boxLen = $lo - $hdrLen; # length of remaining box data
|
||||
} elsif ($boxLen == 0) {
|
||||
if ($raf) {
|
||||
if ($outfile) {
|
||||
CreateNewBoxes($et, $outfile) or $err = 1;
|
||||
# copy over the rest of the file
|
||||
Write($outfile, $$dataPt) or $err = 1;
|
||||
while ($raf->Read($buff, 65536)) {
|
||||
Write($outfile, $buff) or $err = 1;
|
||||
}
|
||||
} elsif ($verbose) {
|
||||
my $msg = sprintf("offset 0x%.4x to end of file", $dataPos + $base + $pos);
|
||||
$et->VPrint(0, "$$et{INDENT}- Tag '${boxID}' ($msg)\n");
|
||||
}
|
||||
last; # (ignore the rest of the file when reading)
|
||||
}
|
||||
$boxLen = $dirEnd - $pos; # data runs to end of file
|
||||
} else {
|
||||
$boxLen -= $hdrLen; # length of remaining box data
|
||||
}
|
||||
$boxLen < 0 and $err = 'Invalid JPEG 2000 box length', last;
|
||||
my $tagInfo = $et->GetTagInfo($tagTablePtr, $boxID);
|
||||
unless (defined $tagInfo or $verbose) {
|
||||
# no need to process this box
|
||||
if ($raf) {
|
||||
if ($outfile) {
|
||||
Write($outfile, $$dataPt) or $err = 1;
|
||||
$raf->Read($buff,$boxLen) == $boxLen or $err = '', last;
|
||||
Write($outfile, $buff) or $err = 1;
|
||||
} else {
|
||||
$raf->Seek($boxLen, 1) or $err = 'Seek error', last;
|
||||
}
|
||||
} elsif ($outfile) {
|
||||
Write($outfile, substr($$dataPt, $pos-$hdrLen, $boxLen+$hdrLen)) or $err = '', last;
|
||||
}
|
||||
next;
|
||||
}
|
||||
if ($raf) {
|
||||
# read the box data
|
||||
$dataPos = $raf->Tell() - $base;
|
||||
$raf->Read($buff,$boxLen) == $boxLen or $err = '', last;
|
||||
$valuePtr = 0;
|
||||
$dataLen = $boxLen;
|
||||
} elsif ($pos + $boxLen > $dirEnd) {
|
||||
$err = '';
|
||||
last;
|
||||
} else {
|
||||
$valuePtr = $pos;
|
||||
}
|
||||
if (defined $tagInfo and not $tagInfo) {
|
||||
# GetTagInfo() required the value for a Condition
|
||||
my $tmpVal = substr($$dataPt, $valuePtr, $boxLen < 128 ? $boxLen : 128);
|
||||
$tagInfo = $et->GetTagInfo($tagTablePtr, $boxID, \$tmpVal);
|
||||
}
|
||||
# delete all UUID boxes and any writable box if deleting all information
|
||||
if ($outfile and $tagInfo) {
|
||||
if ($boxID eq 'uuid' and $$et{DEL_GROUP}{'*'}) {
|
||||
$et->VPrint(0, " Deleting $$tagInfo{Name}\n");
|
||||
++$$et{CHANGED};
|
||||
next;
|
||||
} elsif ($$tagInfo{Writable}) {
|
||||
my $isOverwriting;
|
||||
if ($$et{DEL_GROUP}{Jpeg2000}) {
|
||||
$isOverwriting = 1;
|
||||
} else {
|
||||
my $nvHash = $et->GetNewValueHash($tagInfo);
|
||||
$isOverwriting = $et->IsOverwriting($nvHash);
|
||||
}
|
||||
if ($isOverwriting) {
|
||||
my $val = substr($$dataPt, $valuePtr, $boxLen);
|
||||
$et->VerboseValue("- Jpeg2000:$$tagInfo{Name}", $val);
|
||||
++$$et{CHANGED};
|
||||
next;
|
||||
} elsif (not $$tagInfo{List}) {
|
||||
delete $$et{AddJp2Tags}{$boxID};
|
||||
}
|
||||
}
|
||||
}
|
||||
if ($verbose) {
|
||||
$et->VerboseInfo($boxID, $tagInfo,
|
||||
Table => $tagTablePtr,
|
||||
DataPt => $dataPt,
|
||||
Size => $boxLen,
|
||||
Start => $valuePtr,
|
||||
Addr => $valuePtr + $dataPos + $base,
|
||||
);
|
||||
next unless $tagInfo;
|
||||
}
|
||||
if ($$tagInfo{SubDirectory}) {
|
||||
my $subdir = $$tagInfo{SubDirectory};
|
||||
my $subdirStart = $valuePtr;
|
||||
if (defined $$subdir{Start}) {
|
||||
#### eval Start ($valuePtr)
|
||||
$subdirStart = eval($$subdir{Start});
|
||||
}
|
||||
my $subdirLen = $boxLen - ($subdirStart - $valuePtr);
|
||||
my %subdirInfo = (
|
||||
Parent => 'JP2',
|
||||
DataPt => $dataPt,
|
||||
DataPos => -$subdirStart, # (relative to Base)
|
||||
DataLen => $dataLen,
|
||||
DirStart => $subdirStart,
|
||||
DirLen => $subdirLen,
|
||||
DirName => $$subdir{DirName} || $$tagInfo{Name},
|
||||
OutFile => $outfile,
|
||||
Base => $base + $dataPos + $subdirStart,
|
||||
);
|
||||
my $uuid = $uuid{$$tagInfo{Name}};
|
||||
# remove "UUID-" prefix to allow appropriate directories to be written as a block
|
||||
$subdirInfo{DirName} =~ s/^UUID-//;
|
||||
my $subTable = GetTagTable($$subdir{TagTable}) || $tagTablePtr;
|
||||
if ($outfile) {
|
||||
# remove this directory from our create list
|
||||
delete $$et{AddJp2Dirs}{$$tagInfo{Name}};
|
||||
my $newdir;
|
||||
# only edit writable UUID boxes
|
||||
if ($uuid) {
|
||||
$newdir = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
|
||||
next if defined $newdir and not length $newdir; # next if deleting the box
|
||||
} elsif (defined $uuid) {
|
||||
$et->Warn("Not editing $$tagInfo{Name} box", 1);
|
||||
}
|
||||
# use old box data if not changed
|
||||
defined $newdir or $newdir = substr($$dataPt, $subdirStart, $subdirLen);
|
||||
my $prefixLen = $subdirStart - $valuePtr;
|
||||
my $boxhdr = pack('N', length($newdir) + 8 + $prefixLen) . $boxID;
|
||||
$boxhdr .= substr($$dataPt, $valuePtr, $prefixLen) if $prefixLen;
|
||||
Write($outfile, $boxhdr, $newdir) or $err = 1;
|
||||
} else {
|
||||
# extract as a block if specified
|
||||
$subdirInfo{BlockInfo} = $tagInfo if $$tagInfo{BlockExtract};
|
||||
$et->Warn("Reading non-standard $$tagInfo{Name} box") if defined $uuid and $uuid eq '0';
|
||||
unless ($et->ProcessDirectory(\%subdirInfo, $subTable, $$subdir{ProcessProc})) {
|
||||
if ($subTable eq $tagTablePtr) {
|
||||
$err = 'JPEG 2000 format error';
|
||||
last;
|
||||
}
|
||||
$et->Warn("Unrecognized $$tagInfo{Name} box");
|
||||
}
|
||||
}
|
||||
} elsif ($$tagInfo{Format} and not $outfile) {
|
||||
# only save tag values if Format was specified
|
||||
my $rational;
|
||||
my $val = ReadValue($dataPt, $valuePtr, $$tagInfo{Format}, undef, $boxLen, \$rational);
|
||||
if (defined $val) {
|
||||
my $key = $et->FoundTag($tagInfo, $val);
|
||||
# save Rational value
|
||||
$$et{RATIONAL}{$key} = $rational if defined $rational and defined $key;
|
||||
}
|
||||
} elsif ($outfile) {
|
||||
my $boxhdr = pack('N', $boxLen + 8) . $boxID;
|
||||
Write($outfile, $boxhdr, substr($$dataPt, $valuePtr, $boxLen)) or $err = 1;
|
||||
}
|
||||
}
|
||||
if (defined $err) {
|
||||
$err or $err = 'Truncated JPEG 2000 box';
|
||||
if ($outfile) {
|
||||
$et->Error($err) unless $err eq '1';
|
||||
return $raf ? -1 : undef;
|
||||
}
|
||||
$et->Warn($err);
|
||||
}
|
||||
return $outBuff if $outfile and not $raf;
|
||||
return 1;
|
||||
}
|
||||
|
||||
#------------------------------------------------------------------------------
|
||||
# Read/write meta information from a JPEG 2000 image
|
||||
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
||||
# Returns: 1 on success, 0 if this wasn't a valid JPEG 2000 file, or -1 on write error
|
||||
sub ProcessJP2($$)
|
||||
{
|
||||
local $_;
|
||||
my ($et, $dirInfo) = @_;
|
||||
my $raf = $$dirInfo{RAF};
|
||||
my $outfile = $$dirInfo{OutFile};
|
||||
my $hdr;
|
||||
|
||||
# check to be sure this is a valid JPG2000 file
|
||||
return 0 unless $raf->Read($hdr,12) == 12;
|
||||
unless ($hdr eq "\x00\x00\x00\x0cjP \x0d\x0a\x87\x0a" or # (ref 1)
|
||||
$hdr eq "\x00\x00\x00\x0cjP\x1a\x1a\x0d\x0a\x87\x0a") # (ref 2)
|
||||
{
|
||||
return 0 unless $hdr =~ /^\xff\x4f\xff\x51\0/; # check for JP2 codestream format
|
||||
if ($outfile) {
|
||||
$et->Error('Writing of J2C files is not yet supported');
|
||||
return 0
|
||||
}
|
||||
# add J2C markers if not done already
|
||||
unless ($Image::ExifTool::jpegMarker{0x4f}) {
|
||||
$Image::ExifTool::jpegMarker{$_} = $j2cMarker{$_} foreach keys %j2cMarker;
|
||||
}
|
||||
$et->SetFileType('J2C');
|
||||
$raf->Seek(0,0);
|
||||
return $et->ProcessJPEG($dirInfo); # decode with JPEG processor
|
||||
}
|
||||
if ($outfile) {
|
||||
Write($outfile, $hdr) or return -1;
|
||||
$et->InitWriteDirs(\%jp2Map);
|
||||
# save list of directories to create
|
||||
my %addDirs = %{$$et{ADD_DIRS}};
|
||||
$$et{AddJp2Dirs} = \%addDirs;
|
||||
$$et{AddJp2Tags} = $et->GetNewTagInfoHash(\%Image::ExifTool::Jpeg2000::Main);
|
||||
} else {
|
||||
my ($buff, $fileType);
|
||||
# recognize JPX and JPM as unique types of JP2
|
||||
if ($raf->Read($buff, 12) == 12 and $buff =~ /^.{4}ftyp(.{4})/s) {
|
||||
$fileType = 'JPX' if $1 eq 'jpx ';
|
||||
$fileType = 'JPM' if $1 eq 'jpm ';
|
||||
}
|
||||
$raf->Seek(-length($buff), 1) if defined $buff;
|
||||
$et->SetFileType($fileType);
|
||||
}
|
||||
SetByteOrder('MM'); # JPEG 2000 files are big-endian
|
||||
my %dirInfo = (
|
||||
RAF => $raf,
|
||||
DirName => 'JP2',
|
||||
OutFile => $$dirInfo{OutFile},
|
||||
);
|
||||
my $tagTablePtr = GetTagTable('Image::ExifTool::Jpeg2000::Main');
|
||||
return $et->ProcessDirectory(\%dirInfo, $tagTablePtr);
|
||||
}
|
||||
|
||||
1; # end
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Image::ExifTool::Jpeg2000 - Read JPEG 2000 meta information
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This module is used by Image::ExifTool
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains routines required by Image::ExifTool to read JPEG 2000
|
||||
files.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=head1 REFERENCES
|
||||
|
||||
=over 4
|
||||
|
||||
=item L<http://www.jpeg.org/public/fcd15444-2.pdf>
|
||||
|
||||
=item L<ftp://ftp.remotesensing.org/jpeg2000/fcd15444-1.pdf>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Image::ExifTool::TagNames/Jpeg2000 Tags>,
|
||||
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||||
|
||||
=cut
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user