exiftool_vendored 9.33.1 → 9.37.0

data/bin/Image-ExifTool-9.37/lib/Image/ExifTool/Torrent.pm

@@ -0,0 +1,317 @@
+#------------------------------------------------------------------------------
+# File:         Torrent.pm
+#
+# Description:  Read information from BitTorrent file
+#
+# Revisions:    2013/08/27 - P. Harvey Created
+#
+# References:   1) https://wiki.theory.org/BitTorrentSpecification
+#------------------------------------------------------------------------------
+
+package Image::ExifTool::Torrent;
+
+use strict;
+use vars qw($VERSION);
+use Image::ExifTool qw(:DataAccess :Utils);
+
+$VERSION = '1.01';
+
+sub ReadBencode($$);
+sub ExtractTags($$$;$$@);
+
+# tags extracted from BitTorrent files
+%Image::ExifTool::Torrent::Main = (
+    GROUPS => { 2 => 'Document' },
+    NOTES => q{
+        Below are tags commonly found in BitTorrent files.  As well as these tags,
+        any other existing tags will be extracted.  For convenience, list items are
+        expanded into individual tags with an index in the tag name, but only the
+        tags with index "1" are listed in the tables below.  See
+        L<https://wiki.theory.org/BitTorrentSpecification> for the BitTorrent
+        specification.
+    },
+    'announce'      => { },
+    'announce-list' => { Name => 'AnnounceList1' },
+    'comment'       => { },
+    'created by'    => { Name => 'Creator' }, # software used to create the torrent
+    'creation date' => {
+        Name => 'CreateDate',
+        Groups => { 2 => 'Time' },
+        ValueConv => 'ConvertUnixTime($val,1)',
+        PrintConv => '$self->ConvertDateTime($val)',
+    },
+    'encoding'      => { },
+    'info'          => { SubDirectory => { TagTable => 'Image::ExifTool::Torrent::Info' } },
+    'url-list'      => { Name => 'URLList1' },
+);
+
+%Image::ExifTool::Torrent::Info = (
+    GROUPS => { 2 => 'Document' },
+    'file-duration' => { Name => 'File1Duration' },
+    'file-media'    => { Name => 'File1Media' },
+    'files'         => { SubDirectory => { TagTable => 'Image::ExifTool::Torrent::Files' } },
+    'length'        => { },
+    'md5sum'        => { Name => 'MD5Sum' },
+    'name'          => { },
+    'name.utf-8'    => { Name => 'NameUTF-8' },
+    'piece length'  => { Name => 'PieceLength' },
+    'pieces'        => {
+        Name => 'Pieces',
+        Notes => 'concatenation of 20-byte SHA-1 digests for each piece',
+    },
+    'private'       => { },
+    'profiles'      => { SubDirectory => { TagTable => 'Image::ExifTool::Torrent::Profiles' } },
+);
+
+%Image::ExifTool::Torrent::Profiles = (
+    GROUPS => { 2 => 'Document' },
+    'width'         => { Name => 'Profile1Width' },
+    'height'        => { Name => 'Profile1Height' },
+    'acodec'        => { Name => 'Profile1AudioCodec' },
+    'vcodec'        => { Name => 'Profile1VideoCodec' },
+);
+
+%Image::ExifTool::Torrent::Files = (
+    GROUPS => { 2 => 'Document' },
+    'length'        => { Name => 'File1Length', PrintConv => 'ConvertFileSize($val)' },
+    'md5sum'        => { Name => 'File1MD5Sum'  },
+    'path'          => { Name => 'File1Path', JoinPath => 1 },
+    'path.utf-8'    => { Name => 'File1PathUTF-8', JoinPath => 1 },
+);
+
+#------------------------------------------------------------------------------
+# Read 64kB more data into buffer
+# Inputs: 0) RAF ref, 1) buffer ref
+# Returns: number of bytes read
+# Notes: Sets BencodeEOF element of RAF on end of file
+sub ReadMore($$)
+{
+    my ($raf, $dataPt) = @_;
+    my $buf2;
+    my $n = $raf->Read($buf2, 65536);
+    $$raf{BencodeEOF} = 1 if $n != 65536;
+    $$dataPt = substr($$dataPt, pos($$dataPt)) . $buf2 if $n;
+    return $n;
+}
+
+#------------------------------------------------------------------------------
+# Read bencoded value
+# Inputs: 0) input file, 1) buffer (pos must be set to current position)
+# Returns: HASH ref, ARRAY ref, SCALAR ref, SCALAR, or undef on error or end of data
+# Notes: Sets BencodeError element of RAF on any error
+sub ReadBencode($$)
+{
+    my ($raf, $dataPt) = @_;
+
+    # read more if necessary (keep a minimum of 64 bytes in the buffer)
+    my $pos = pos($$dataPt);
+    return undef unless defined $pos;
+    my $remaining = length($$dataPt) - $pos;
+    ReadMore($raf, $dataPt) if $remaining < 64 and not $$raf{BencodeEOF};
+
+    # read next token
+    $$dataPt =~ /(.)/sg or return undef;
+    
+    my $val;
+    my $tok = $1;
+    if ($tok eq 'i') {      # integer
+        $$dataPt =~ /\G(-?\d+)e/g or return $val;
+        $val = $1;
+    } elsif ($tok eq 'd') { # dictionary
+        $val = { };
+        for (;;) {
+            my $k = ReadBencode($raf, $dataPt);
+            last unless defined $k;
+            # the key must be a byte string
+            if (ref $k) {
+                ref $k ne 'SCALAR' and $$raf{BencodeError} = 'Bad dictionary key', last;
+                $k = $$k;
+            }
+            my $v = ReadBencode($raf, $dataPt);
+            last unless defined $v;
+            $$val{$k} = $v;
+        }
+    } elsif ($tok eq 'l') { # list
+        $val = [ ];
+        for (;;) {
+            my $v = ReadBencode($raf, $dataPt);
+            last unless defined $v;
+            push @$val, $v;
+        }
+    } elsif ($tok eq 'e') { # end of dictionary or list
+        # return undef (no error)
+    } elsif ($tok =~ /^\d$/ and $$dataPt =~ /\G(\d*):/g) { # byte string
+        my $len = $tok . $1;
+        my $more = $len - (length($$dataPt) - pos($$dataPt));
+        my $value;
+        if ($more <= 0) {
+            $value = substr($$dataPt,pos($$dataPt),$len);
+            pos($$dataPt) = pos($$dataPt) + $len;
+        } elsif ($more > 10000000) {
+            # just skip over really long values
+            $val = \ "(Binary data $len bytes)" if $raf->Seek($more, 1);
+        } else {
+            # need to read more from file
+            my $buff;
+            my $n = $raf->Read($buff, $more);
+            if ($n == $more) {
+                $value = substr($$dataPt,pos($$dataPt)) . $buff;
+                $$dataPt = '';
+                pos($$dataPt) = 0;
+            }
+        }
+        if (defined $value) {
+            # return as binary data unless it is a reasonable-length ASCII string
+            if (length($value) > 256 or $value =~ /[^\t\x20-\x7e]/) {
+                $val = \$value;
+            } else {
+                $val = $value;
+            }
+        } elsif (not defined $val) {
+            $$raf{BencodeError} = 'Truncated byte string';
+        }
+    } else {
+        $$raf{BencodeError} = 'Bad format';
+    }
+    return $val;
+}
+
+#------------------------------------------------------------------------------
+# Extract tags from dictionary hash
+# Inputs: 0) ExifTool ref, 1) dictionary hash reference, 2) tag table ref,
+#         3) parent hash ID, 4) parent hash name, 5-N) list indices
+# Returns: number of tags extracted
+sub ExtractTags($$$;$$@)
+{
+    my ($exifTool, $hashPtr, $tagTablePtr, $baseID, $baseName, @index) = @_;
+    my $count = 0;
+    my $tag;
+    foreach $tag (sort keys %$hashPtr) {
+        my $val = $$hashPtr{$tag};
+        my ($i, $j, @more);
+        for (; defined $val; $val = shift @more) {
+            my $id = defined $baseID ? "$baseID/$tag" : $tag;
+            unless ($$tagTablePtr{$id}) {
+                my $name = ucfirst $tag;
+                # capitalize all words in tag name and remove illegal characters
+                $name =~ s/[^-_a-zA-Z0-9]+(.?)/\U$1/g;
+                $name = "Tag$name" if length($name) < 2 or $name !~ /^[A-Z]/;
+                $name = $baseName . $name if defined $baseName; # add base name if necessary
+                AddTagToTable($tagTablePtr, $id, { Name => $name });
+                $exifTool->VPrint(0, "  [adding $id '$name']\n");
+            }
+            my $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $id) or next;
+            if (ref $val eq 'ARRAY') {
+                if ($$tagInfo{JoinPath}) {
+                    $val = join '/', @$val;
+                } else {
+                    push @more, @$val;
+                    next if ref $more[0] eq 'ARRAY'; # continue expanding nested lists
+                    $val = shift @more;
+                    $i or $i = 0, push(@index, $i);
+                }
+            }
+            $index[-1] = ++$i if defined $i;
+            if (@index) {
+                $id .= join '_', @index;  # add instance number(s) to tag ID
+                unless ($$tagTablePtr{$id}) {
+                    my $name = $$tagInfo{Name};
+                    # embed indices at position of '1' in tag name
+                    my $n = ($name =~ tr/1/#/);
+                    for ($j=0; $j<$n; ++$j) {
+                        my $idx = $index[$j] || '';
+                        $name =~ s/#/$idx/;
+                    }
+                    # put remaining indices at end of tag name
+                    for (; $j<@index; ++$j) {
+                        $name .= '_' if $name =~ /\d$/;
+                        $name .= $index[$j];
+                    }
+                    AddTagToTable($tagTablePtr, $id, { %$tagInfo, Name => $name });
+                }
+                $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $id) or next;
+            }
+            if (ref $val eq 'HASH') {
+                # extract tags from this dictionary
+                my ($table, $rootID, $rootName);
+                if ($$tagInfo{SubDirectory}) {
+                    $table = GetTagTable($$tagInfo{SubDirectory}{TagTable});
+                } else {
+                    $table = $tagTablePtr;
+                    # use hash ID and Name as base for contained tags to avoid conflicts
+                    $rootID = $id;
+                    $rootName = $$tagInfo{Name};
+                }
+                $count += ExtractTags($exifTool, $val, $table, $rootID, $rootName, @index);
+            } else {
+                # handle this simple tag value
+                $exifTool->HandleTag($tagTablePtr, $id, $val);
+                ++$count;
+            }
+        }
+        pop @index if defined $i;
+    }
+    return $count;
+}
+
+#------------------------------------------------------------------------------
+# Process BitTorrent file
+# Inputs: 0) ExifTool object reference, 1) dirInfo reference (with RAF set)
+# Returns: 1 on success, 0 if this wasn't a valid BitTorrent file
+sub ProcessTorrent($$)
+{
+    my ($exifTool, $dirInfo) = @_;
+    my $success = 0;
+    my $raf = $$dirInfo{RAF};
+    my $buff = '';
+    pos($buff) = 0;
+    my $dict = ReadBencode($raf, \$buff);
+    my $err = $$raf{BencodeError};
+    $exifTool->Warn("Bencode error: $err") if $err;
+    if (ref $dict eq 'HASH' and $$dict{announce}) {
+        $exifTool->SetFileType('TORRENT');
+        my $tagTablePtr = GetTagTable('Image::ExifTool::Torrent::Main');
+        ExtractTags($exifTool, $dict, $tagTablePtr) and $success = 1;
+    }
+    return $success;
+}
+
+1;  # end
+
+__END__
+
+=head1 NAME
+
+Image::ExifTool::Torrent - Read information from BitTorrent file
+
+=head1 SYNOPSIS
+
+This module is used by Image::ExifTool
+
+=head1 DESCRIPTION
+
+This module contains definitions required by Image::ExifTool to read
+bencoded information from BitTorrent files.
+
+=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<https://wiki.theory.org/BitTorrentSpecification>
+
+=back
+
+=head1 SEE ALSO
+
+L<Image::ExifTool::TagNames/Torrent Tags>,
+L<Image::ExifTool(3pm)|Image::ExifTool>
+
+=cut
+

data/bin/{Image-ExifTool-9.33 → Image-ExifTool-9.37}/lib/Image/ExifTool/WriteExif.pl

@@ -2036,12 +2036,16 @@ Entry:  for (;;) {
                         $suspect = 1 if $valuePtr < $dirEnd and $valuePtr+$oldSize > $dirStart;
                         # get value by seeking in file if we are allowed
                         if ($valuePtr < 0 or $valuePtr+$oldSize > $dataLen) {
-                            my ($pos, $tagStr, $invalidPreview, $tmpInfo);
+                            my ($pos, $tagStr, $invalidPreview, $tmpInfo, $leicaTrailer);
                             if ($oldInfo) {
                                 $tagStr = $$oldInfo{Name};
+                                $leicaTrailer = $$oldInfo{LeicaTrailer};
                             } elsif (defined $oldInfo) {
                                 $tmpInfo = $exifTool->GetTagInfo($tagTablePtr, $oldID, \ '', $oldFormName, $oldCount);
-                                $tagStr = $$tmpInfo{Name} if $tmpInfo;
+                                if ($tmpInfo) {
+                                    $tagStr = $$tmpInfo{Name};
+                                    $leicaTrailer = $$tmpInfo{LeicaTrailer};
+                                }
                             }
                             $tagStr or $tagStr = sprintf("tag 0x%.4x",$oldID);
                             # allow PreviewImage to run outside EXIF segment in JPEG images
@@ -2059,7 +2063,7 @@ Entry:  for (;;) {
                                     } else {
                                         $invalidPreview = 1;
                                     }
-                                } elsif ($tagStr eq 'MakerNoteLeica6') {
+                                } elsif ($leicaTrailer) {
                                     # save information about Leica makernote trailer
                                     $$exifTool{LeicaTrailer} = {
                                         TagInfo => $oldInfo || $tmpInfo,

data/bin/{Image-ExifTool-9.33 → Image-ExifTool-9.37}/lib/Image/ExifTool/Writer.pl

@@ -887,7 +887,7 @@ sub SetNewValue($;$$%)
                 }
             }
         } elsif ($permanent) {
-            $err = "Can't delete $wgrp1:$tag";
+            $err = "Can't delete Permanent tag $wgrp1:$tag";
             $verbose > 1 and print $out "$err\n";
             next;
         } elsif ($addValue or $options{DelValue}) {
@@ -1289,7 +1289,11 @@ sub SetNewValuesFromFile($$;@)
             }
             # set value(s) for this tag
             my ($rtn, $wrn) = $self->SetNewValue($dstTag, $val, %$opts);
-            $$opts{Replace} = 0;    # accumulate values from tags matching a single argument
+            # this was added in version 9.14, and allowed actions like "-subject<all" to
+            # write values of multiple tags into a list, but it had the side effect of
+            # duplicating items if there were multiple list tags with the same name
+            # (ie. -use mwg "-creator<creator"), so disable this as of ExifTool 9.36:
+            # $$opts{Replace} = 0;    # accumulate values from tags matching a single argument
             if ($wrn and not $noWarn) {
                 # return this warning
                 $rtnInfo{NextFreeTagKey(\%rtnInfo, 'Warning')} = $wrn;
@@ -4813,7 +4817,7 @@ sub WriteJPEG($$)
                 # use this fixup to set the size too (sneaky)
                 my $trailSize = defined($dat) ? length($dat) - $junk : $$self{LeicaTrailer}{Size};
                 $fixup->{Start} -= 4;  $fixup->{Shift} += 4;
-                $fixup->SetMarkerPointers($outfile, 'LeicaTrailer', $trailSize);
+                $fixup->SetMarkerPointers($outfile, 'LeicaTrailer', $trailSize) if defined $trailSize;
                 $fixup->{Start} += 4;  $fixup->{Shift} -= 4;
                 # clean up and write the buffered data
                 $outfile = $oldOutfile;

data/bin/{Image-ExifTool-9.33 → Image-ExifTool-9.37}/lib/Image/ExifTool/XMP.pm

@@ -47,7 +47,7 @@ use Image::ExifTool qw(:Utils);
 use Image::ExifTool::Exif;
 require Exporter;
 
-$VERSION = '2.66';
+$VERSION = '2.68';
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(EscapeXML UnescapeXML);
 
@@ -1248,6 +1248,17 @@ my %sPantryItem = (
     DefringeGreenAmount                  => { Writable => 'integer' },
     DefringeGreenHueLo                   => { Writable => 'integer' },
     DefringeGreenHueHi                   => { Writable => 'integer' },
+    # new tags written by LR5
+    PerspectiveAspect                    => { Writable => 'integer' },
+    PerspectiveUpright                   => { Writable => 'integer' },
+    UprightVersion                       => { Writable => 'integer' },
+    UprightCenterMode                    => { Writable => 'integer' },
+    UprightCenterNormX                   => { Writable => 'real' },
+    UprightCenterNormY                   => { Writable => 'real' },
+    UprightFocalMode                     => { Writable => 'integer' },
+    UprightFocalLength35mm               => { Writable => 'real' },
+    UprightPreview                       => { Writable => 'boolean' },
+    UprightTransformCount                => { Writable => 'integer' },
 );
 
 # Tiff namespace properties (tiff)
@@ -1257,7 +1268,11 @@ my %sPantryItem = (
     NAMESPACE   => 'tiff',
     PRIORITY => 0, # not as reliable as actual TIFF tags
     TABLE_DESC => 'XMP TIFF',
-    NOTES => 'EXIF namespace for TIFF tags.',
+    NOTES => q{
+        EXIF namespace for TIFF tags.  See
+        L<http://www.cipa.jp/english/hyoujunka/kikaku/pdf/DC-010-2012_E.pdf> for the
+        specification.
+    },
     ImageWidth    => { Writable => 'integer' },
     ImageLength   => { Writable => 'integer', Name => 'ImageHeight' },
     BitsPerSample => { Writable => 'integer', List => 'Seq', AutoSplit => 1 },
@@ -1344,7 +1359,11 @@ my %sPantryItem = (
     GROUPS => { 1 => 'XMP-exif', 2 => 'Image' },
     NAMESPACE   => 'exif',
     PRIORITY => 0, # not as reliable as actual EXIF tags
-    NOTES => 'EXIF namespace for EXIF tags.',
+    NOTES => q{
+        EXIF namespace for EXIF tags.  See
+        L<http://www.cipa.jp/english/hyoujunka/kikaku/pdf/DC-010-2012_E.pdf> for the
+        specification.
+    },
     ExifVersion     => { },
     FlashpixVersion => { },
     ColorSpace => {
@@ -3032,6 +3051,17 @@ sub ParseXMPElement($$$;$$$$)
         $start = pos($$dataPt);         # start from here the next time around
         my $parseResource;
         if ($prop eq 'rdf:li') {
+            # impose a reasonable maximum on the number of items in a list
+            if ($nItems > 999) {
+                my ($tg,$ns);
+                ($tg, $ns) = GetXMPTagID($propListPt) if $nItems == 1000;
+                if ($isWriting) {
+                    $exifTool->Warn("Excessive number of items for $ns:$tg. Processing may be slow.", 1) if $tg;
+                } elsif (not $$exifTool{OPTIONS}{IgnoreMinorErrors}) {
+                    $exifTool->Warn("Excessive number of items for $ns:$tg. Extracted only the first 1000.", 2) if $tg;
+                    last;
+                }
+            }
             # add index to list items so we can keep them in order
             # (this also enables us to keep structure elements grouped properly
             # for lists of structures, like JobRef)