exiftool_vendored 9.33.0

data/bin/Image-ExifTool-9.33/lib/Image/ExifTool/Fixup.pm

@@ -0,0 +1,354 @@
+#------------------------------------------------------------------------------
+# 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).
+#------------------------------------------------------------------------------
+
+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-2013, 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

data/bin/Image-ExifTool-9.33/lib/Image/ExifTool/Flash.pm

@@ -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.09';
+
+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 => 'FileAttributes',
+        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 ($exifTool, $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);
+
+    $exifTool->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
+            $exifTool->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) {
+                    $exifTool->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) {
+                    $exifTool->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($exifTool, $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) });
+                    $exifTool->VPrint(1, "  | (adding $tag)\n");
+                }
+                $exifTool->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($exifTool, $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);
+            $exifTool->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';
+                $exifTool->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);
+                $exifTool->VPrint(1, "  | (ignored lone $t value '$val')\n");
+            }
+        }
+    }
+    if (not defined $val and defined $type) {
+        $exifTool->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 ($exifTool, $dirInfo) = @_;
+    my $verbose = $exifTool->Options('Verbose');
+    my $raf = $$dirInfo{RAF};
+    my $buff;
+
+    $raf->Read($buff, 9) == 9 or return 0;
+    $buff =~ /^FLV\x01/ or return 0;
+    SetByteOrder('MM');
+    $exifTool->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 = $exifTool->GetTagInfo($tagTablePtr, $type);
+        if ($verbose > 1) {
+            my $name = $tagInfo ? $$tagInfo{Name} : "type $type";
+            $exifTool->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 {
+                        $exifTool->Warn("Bad $$tagInfo{Name} packet");
+                        last;
+                    }
+                }
+            } elsif ($raf->Read($buff, $len) == $len) {
+                $len = 0;
+            } else {
+                $exifTool->Warn('Truncated Meta packet');
+                last;
+            }
+        }
+        if (defined $buff) {
+            $exifTool->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 ($exifTool, $tag, $val) = @_;
+    $exifTool->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 ($exifTool, $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');
+    $exifTool->SetFileType();
+    GetTagTable('Image::ExifTool::Flash::Main');  # make sure table is initialized
+
+    FoundFlashTag($exifTool, FlashVersion => $vers);
+    FoundFlashTag($exifTool, Compressed => $compressed);
+
+    # read the next 64 bytes of the file (and inflate if necessary)
+    $buff = '';
+    unless (ReadCompressed($raf, $buff, 64, $compressed)) {
+        $exifTool->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) {
+        $exifTool->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($exifTool, ImageWidth  => ($vals[1] - $vals[0]) / 20);
+    FoundFlashTag($exifTool, ImageHeight => ($vals[3] - $vals[2]) / 20);
+
+    # get frame rate and count
+    @vals = unpack("x${nBytes}v2", $buff);
+    FoundFlashTag($exifTool, FrameRate => $vals[0] / 256);
+    FoundFlashTag($exifTool, FrameCount => $vals[1]);
+    FoundFlashTag($exifTool, Duration => $vals[1] * 256 / $vals[0]) if $vals[0];
+
+    # scan through the tags to find FileAttributes 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;
+        $exifTool->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)) {
+                $exifTool->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)) {
+                    $exifTool->Warn($compressed) if $compressed;
+                    return 1;
+                }
+                $buffLen = length $buff;
+                last if $pos + $size > $buffLen;
+            }
+            $exifTool->VPrint(1, "  [extended size $size bytes]\n");
+        }
+        if ($tag == 69) {       # FileAttributes
+            last unless $size;
+            my $flags = Get8u(\$buff, $pos);
+            FoundFlashTag($exifTool, $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($exifTool, $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-2013, 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
+