exiftool_vendored 12.61.0 → 12.62.0

data/bin/lib/Image/ExifTool/WPG.pm

@@ -0,0 +1,296 @@
+#------------------------------------------------------------------------------
+# File:         WPG.pm
+#
+# Description:  Read WordPerfect Graphics meta information
+#
+# Revisions:    2023-05-01 - P. Harvey Created
+#
+# References:   1) https://www.fileformat.info/format/wpg/egff.htm
+#               2) https://archive.org/details/mac_Graphics_File_Formats_Second_Edition_1996/page/n991/mode/2up
+#               3) http://libwpg.sourceforge.net/
+#------------------------------------------------------------------------------
+
+package Image::ExifTool::WPG;
+
+use strict;
+use vars qw($VERSION);
+use Image::ExifTool qw(:DataAccess :Utils);
+
+$VERSION = '1.00';
+
+sub PrintRecord($$$);
+
+# WPG metadata
+%Image::ExifTool::WPG::Main = (
+    GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
+    VARS => { NO_ID => 1 },
+    NOTES => 'Tags extracted from WordPerfect Graphics (WPG) images.',
+    WPGVersion => { },
+    ImageWidthInches  => { PrintConv => 'sprintf("%.2f",$val)' },
+    ImageHeightInches => { PrintConv => 'sprintf("%.2f",$val)' },
+    Records => {
+        Notes => 'records for version 1.0 files',
+        List => 1,
+        PrintHex => 2,
+        PrintConvColumns => 2,
+        PrintConv => {
+            OTHER => \&PrintRecord,
+            0x01 => 'Fill Attributes',
+            0x02 => 'Line Attributes',
+            0x03 => 'Marker Attributes',
+            0x04 => 'Polymarker',
+            0x05 => 'Line',
+            0x06 => 'Polyline',
+            0x07 => 'Rectangle',
+            0x08 => 'Polygon',
+            0x09 => 'Ellipse',
+            0x0a => 'Reserved',
+            0x0b => 'Bitmap (Type 1)',
+            0x0c => 'Graphics Text (Type 1)',
+            0x0d => 'Graphics Text Attributes',
+            0x0e => 'Color Map',
+            0x0f => 'Start WPG (Type 1)',
+            0x10 => 'End WPG',
+            0x11 => 'PostScript Data (Type 1)',
+            0x12 => 'Output Attributes',
+            0x13 => 'Curved Polyline',
+            0x14 => 'Bitmap (Type 2)',
+            0x15 => 'Start Figure',
+            0x16 => 'Start Chart',
+            0x17 => 'PlanPerfect Data',
+            0x18 => 'Graphics Text (Type 2)',
+            0x19 => 'Start WPG (Type 2)',
+            0x1a => 'Graphics Text (Type 3)',
+            0x1b => 'PostScript Data (Type 2)',
+        },
+    },
+    RecordsV2 => {
+        Notes => 'records for version 2.0 files',
+        List => 1,
+        PrintHex => 2,
+        PrintConvColumns => 2,
+        PrintConv => {
+            OTHER => \&PrintRecord,
+            0x00 => 'End Marker',
+            0x01 => 'Start WPG',
+            0x02 => 'End WPG',
+            0x03 => 'Form Settings',
+            0x04 => 'Ruler Settings',
+            0x05 => 'Grid Settings',
+            0x06 => 'Layer',
+            0x08 => 'Pen Style Definition',
+            0x09 => 'Pattern Definition',
+            0x0a => 'Comment',
+            0x0b => 'Color Transfer',
+            0x0c => 'Color Palette',
+            0x0d => 'DP Color Palette',
+            0x0e => 'Bitmap Data',
+            0x0f => 'Text Data',
+            0x10 => 'Chart Style',
+            0x11 => 'Chart Data',
+            0x12 => 'Object Image',
+            0x15 => 'Polyline',
+            0x16 => 'Polyspline',
+            0x17 => 'Polycurve',
+            0x18 => 'Rectangle',
+            0x19 => 'Arc',
+            0x1a => 'Compound Polygon',
+            0x1b => 'Bitmap',
+            0x1c => 'Text Line',
+            0x1d => 'Text Block',
+            0x1e => 'Text Path',
+            0x1f => 'Chart',
+            0x20 => 'Group',
+            0x21 => 'Object Capsule',
+            0x22 => 'Font Settings',
+            0x25 => 'Pen Fore Color',
+            0x26 => 'DP Pen Fore Color',
+            0x27 => 'Pen Back Color',
+            0x28 => 'DP Pen Back Color',
+            0x29 => 'Pen Style',
+            0x2a => 'Pen Pattern',
+            0x2b => 'Pen Size',
+            0x2c => 'DP Pen Size',
+            0x2d => 'Line Cap',
+            0x2e => 'Line Join',
+            0x2f => 'Brush Gradient',
+            0x30 => 'DP Brush Gradient',
+            0x31 => 'Brush Fore Color',
+            0x32 => 'DP Brush Fore Color',
+            0x33 => 'Brush Back Color',
+            0x34 => 'DP Brush Back Color',
+            0x35 => 'Brush Pattern',
+            0x36 => 'Horizontal Line',
+            0x37 => 'Vertical Line',
+            0x38 => 'Poster Settings',
+            0x39 => 'Image State',
+            0x3a => 'Envelope Definition',
+            0x3b => 'Envelope',
+            0x3c => 'Texture Definition',
+            0x3d => 'Brush Texture',
+            0x3e => 'Texture Alignment',
+            0x3f => 'Pen Texture ',
+        }
+    },
+);
+
+#------------------------------------------------------------------------------
+# Print record type
+# Inputs: 0) record type and count, 1) inverse flag, 2) PrintConv hash ref
+# Returns: converted record name
+sub PrintRecord($$$)
+{
+    my ($val, $inv, $printConv) = @_;
+    my ($type, $count) = split 'x', $val;
+    my $prt = $$printConv{$type} || sprintf('Unknown (0x%.2x)', $type);
+    $prt .= " x $count" if $count;
+    return $prt;
+}
+
+#------------------------------------------------------------------------------
+# Read variable-length integer
+# Inputs: 0) RAF ref
+# Returns: integer value
+sub ReadVarInt($)
+{
+    my $raf = shift;
+    my $buff;
+    $raf->Read($buff, 1) or return 0;
+    my $val = ord($buff);
+    if ($val == 0xff) {
+        $raf->Read($buff, 2) == 2 or return 0;
+        $val = unpack('v', $buff);
+        if ($val & 0x8000) {
+            $raf->Read($buff, 2) == 2 or return 0;
+            $val = (($val & 0x7fff) << 16) | unpack('v', $buff);
+        }
+    }
+    return $val;
+}
+
+#------------------------------------------------------------------------------
+# Read WPG version 1 or 2 image
+# Inputs: 0) ExifTool object reference, 1) dirInfo reference
+# Returns: 1 on success, 0 if this wasn't a valid WPG file
+sub ProcessWPG($$)
+{
+    my ($et, $dirInfo) = @_;
+    my $raf = $$dirInfo{RAF};
+    my ($buff, $lastType, $count);
+
+    # verify this is a valid WPG file
+    return 0 unless $raf->Read($buff, 16) == 16;
+    return 0 unless $buff =~ /^\xff\x57\x50\x43/;
+    $et->SetFileType();
+    SetByteOrder('II');
+    my $tagTablePtr = GetTagTable('Image::ExifTool::WPG::Main');
+    my $offset = Get32u(\$buff, 4);
+    my ($ver, $rev) = unpack('x10CC', $buff);
+    $et->HandleTag($tagTablePtr, WPGVersion => "$ver.$rev");
+    if ($ver < 1 or $ver > 2) {
+        # currently support only version 1 and 2 formats
+        $et->Warn('Unsupported WPG version');
+        return 1;
+    }
+    my $tag = $ver == 1 ? 'Records' : 'RecordsV2';
+    $raf->Seek($offset - 16, 1) or return 1 if $offset > 16;
+    # loop through records
+    for (;;) {
+        my ($type, $len, $getSize);
+        if ($raf->Read($buff, $ver) == $ver) {  # read 1 or 2 bytes, based on version
+            if ($ver == 1) {
+                # read version 1 record header
+                $type = ord($buff);
+                $len = ReadVarInt($raf);
+                $getSize = 1 if $type == 0x0f;  # Start WPG (Type 1)
+            } else {
+                # read version 2 record header
+                $type = unpack('xC', $buff);
+                ReadVarInt($raf);   # skip extensions
+                $len = ReadVarInt($raf);
+                $getSize = 1 if $type == 0x01;  # Start WPG
+                undef $type if $type > 0x3f;
+            }
+            if ($getSize) {
+                # read Start record to obtain image size
+                $raf->Read($buff, $len) == $len or $et->Warn('File format error'), last;
+                my ($w, $h, $xres, $yres);
+                if ($ver == 1) {
+                    ($w, $h) = unpack('x2vv', $buff);
+                } else {
+                    my ($precision, $format);
+                    ($xres, $yres, $precision) = unpack('vvC', $buff);
+                    if ($precision == 0 and $len >= 21) {
+                        $format = 'int16s';
+                    } elsif ($precision == 1 and $len >= 29) {
+                        $format = 'int32s';
+                    } else {
+                        $et->Warn('Invalid integer precision');
+                        next;
+                    }
+                    my ($x1,$y1,$x2,$y2) = ReadValue(\$buff, 13, $format, 4, $len-13);
+                    $w = abs($x2 - $x1);
+                    $h = abs($y2 - $y1);
+                }
+                $et->HandleTag($tagTablePtr, ImageWidthInches  => $w / ($xres || 1200));
+                $et->HandleTag($tagTablePtr, ImageHeightInches => $h / ($yres || 1200));
+            } else {
+                $raf->Seek($len, 1) or last; # skip to the next record
+            }
+        }
+        # go to some trouble to collapse identical sequential entries in record list
+        # (trying to keep the length of the list managable for complex images)
+        $lastType and $type and $type == $lastType and ++$count, next;
+        if ($lastType) {
+            my $val = $count > 1 ? "${lastType}x$count" : $lastType;
+            $et->HandleTag($tagTablePtr, $tag => $val);
+        }
+        last unless $type;
+        $lastType = $type;
+        $count = 1;
+    }
+    return 1;
+}
+
+1;  # end
+
+__END__
+
+=head1 NAME
+
+Image::ExifTool::WPG - Read WPG meta information
+
+=head1 SYNOPSIS
+
+This module is used by Image::ExifTool
+
+=head1 DESCRIPTION
+
+This module contains definitions required by Image::ExifTool to read WPG
+(WordPerfect Graphics) images.
+
+=head1 AUTHOR
+
+Copyright 2003-2023, Phil Harvey (philharvey66 at gmail.com)
+
+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://www.fileformat.info/format/wpg/egff.htm>
+
+=item L<https://archive.org/details/mac_Graphics_File_Formats_Second_Edition_1996/page/n991/mode/2up>
+
+=item L<http://libwpg.sourceforge.net/>
+
+=back
+
+=head1 SEE ALSO
+
+L<Image::ExifTool::TagNames/WPG Tags>,
+L<Image::ExifTool(3pm)|Image::ExifTool>
+
+=cut

data/bin/lib/Image/ExifTool/Writer.pl

@@ -1302,6 +1302,7 @@ sub SetNewValuesFromFile($$;@)
         MDItemTags      => $$options{MDItemTags},
         MissingTagValue => $$options{MissingTagValue},
         NoPDFList       => $$options{NoPDFList},
+        NoWarning       => $$options{NoWarning},
         Password        => $$options{Password},
         PrintConv       => $$options{PrintConv},
         QuickTimeUTC    => $$options{QuickTimeUTC},
@@ -1569,10 +1570,17 @@ SET:    foreach $set (@setList) {
         # handle expressions
         if ($$opts{EXPR}) {
             my $val = $srcExifTool->InsertTagValues(\@tags, $$set[1], 'Error');
-            if ($$srcExifTool{VALUE}{Error}) {
-                # pass on any error as a warning
-                $tag = NextFreeTagKey(\%rtnInfo, 'Warning');
-                $rtnInfo{$tag} = $$srcExifTool{VALUE}{Error};
+            my $err = $$srcExifTool{VALUE}{Error};
+            if ($err) {
+                # pass on any error as a warning unless it is suppressed
+                my $noWarn = $$srcExifTool{OPTIONS}{NoWarning};
+                unless ($noWarn and (eval { $err =~ /$noWarn/ } or
+                    # (also apply expression to warning without "[minor] " prefix)
+                    ($err =~ s/^\[minor\] //i and eval { $err =~ /$noWarn/ })))
+                {
+                    $tag = NextFreeTagKey(\%rtnInfo, 'Warning');
+                    $rtnInfo{$tag} = $$srcExifTool{VALUE}{Error};
+                }
                 delete $$srcExifTool{VALUE}{Error};
                 next unless defined $val;
             }

data/bin/lib/Image/ExifTool/XMP.pm

@@ -50,7 +50,7 @@ use Image::ExifTool::Exif;
 use Image::ExifTool::GPS;
 require Exporter;
 
-$VERSION = '3.58';
+$VERSION = '3.59';
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(EscapeXML UnescapeXML);
 
@@ -2489,6 +2489,9 @@ my %sPantryItem = (
     EnhanceSuperResolutionAlreadyApplied => { Writable => 'boolean' },
     EnhanceSuperResolutionVersion   => { }, # integer?
     EnhanceSuperResolutionScale     => { Writable => 'rational' },
+    EnhanceDenoiseAlreadyApplied    => { Writable => 'boolean' }, #forum14760
+    EnhanceDenoiseVersion           => { }, #forum14760 integer?
+    EnhanceDenoiseLumaAmount        => { }, #forum14760 integer?
 );
 
 # IPTC Core namespace properties (Iptc4xmpCore) (ref 4)

data/bin/lib/Image/ExifTool/ZIP.pm

@@ -11,6 +11,7 @@
 #               4) http://DataCompression.info/ArchiveFormats/RAR202.txt
 #               5) https://jira.atlassian.com/browse/CONF-21706
 #               6) http://wwwimages.adobe.com/www.adobe.com/content/dam/Adobe/en/devnet/indesign/cs55-docs/IDML/idml-specification.pdf
+#               7) https://www.rarlab.com/technote.htm
 #------------------------------------------------------------------------------
 
 package Image::ExifTool::ZIP;
@@ -19,7 +20,7 @@ use strict;
 use vars qw($VERSION $warnString);
 use Image::ExifTool qw(:DataAccess :Utils);
 
-$VERSION = '1.28';
+$VERSION = '1.29';
 
 sub WarnProc($) { $warnString = $_[0]; }
 
@@ -191,7 +192,7 @@ my %iWorkType = (
     11 => 'Comment',
 );
 
-# RAR tags (ref 4)
+# RAR v4 tags (ref 4)
 %Image::ExifTool::ZIP::RAR = (
     PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
     GROUPS => { 2 => 'Other' },
@@ -254,8 +255,45 @@ my %iWorkType = (
     },
 );
 
+# RAR v5 tags (ref 7, github#203)
+%Image::ExifTool::ZIP::RAR5 = (
+    GROUPS => { 2 => 'Other' },
+    VARS => { NO_ID => 1 },
+    NOTES => 'These tags are extracted from RAR v5 archive files.',
+    RARVersion      => { },
+    CompressedSize  => { },
+    ModifyDate => {
+        Groups => { 2 => 'Time' },
+        ValueConv => 'ConvertUnixTime($val,1)',
+        PrintConv => '$self->ConvertDateTime($val)',
+    },
+    UncompressedSize => { },
+    OperatingSystem => {
+        PrintConv => { 0 => 'Win32', 1 => 'Unix' },
+    },
+    ArchivedFileName => { },
+);
+
+#------------------------------------------------------------------------------
+# Read unsigned LEB (Little Endian Base) from file
+# Inputs: 0) RAF ref
+# Returns: integer value
+sub ReadULEB($)
+{
+    my $raf = shift;
+    my ($i, $buff);
+    my $rtnVal = 0;
+    for ($i=0; ; ++$i) {
+        $raf->Read($buff, 1) or last;
+        my $num = ord($buff);
+        $rtnVal += ($num & 0x7f) << ($i * 7);
+        $num & 0x80 or last;
+    }
+    return $rtnVal;
+}
+
 #------------------------------------------------------------------------------
-# Extract information from a RAR file (ref 4)
+# Extract information from a RAR file
 # Inputs: 0) ExifTool object reference, 1) dirInfo reference
 # Returns: 1 on success, 0 if this wasn't a valid RAR file
 sub ProcessRAR($$)
@@ -263,51 +301,129 @@ sub ProcessRAR($$)
     my ($et, $dirInfo) = @_;
     my $raf = $$dirInfo{RAF};
     my ($flags, $buff);
+    my $docNum = 0;
 
-    return 0 unless $raf->Read($buff, 7) and $buff eq "Rar!\x1a\x07\0";
+    return 0 unless $raf->Read($buff, 7) and $buff =~ "Rar!\x1a\x07[\0\x01]";
 
-    $et->SetFileType();
-    SetByteOrder('II');
-    my $tagTablePtr = GetTagTable('Image::ExifTool::ZIP::RAR');
-    my $docNum = 0;
+    if ($buff eq "Rar!\x1a\x07\0") { # RARv4 (ref 4)
 
-    for (;;) {
-        # read block header
-        $raf->Read($buff, 7) == 7 or last;
-        my ($type, $flags, $size) = unpack('xxCvv', $buff);
-        $size -= 7;
-        if ($flags & 0x8000) {
-            $raf->Read($buff, 4) == 4 or last;
-            $size += unpack('V',$buff) - 4;
-        }
-        last if $size < 0;
-        next unless $size;  # ignore blocks with no data
-        # don't try to read very large blocks unless LargeFileSupport is enabled
-        if ($size >= 0x80000000 and not $et->Options('LargeFileSupport')) {
-            $et->Warn('Large block encountered. Aborting.');
-            last;
+        $et->SetFileType();
+        SetByteOrder('II');
+        my $tagTablePtr = GetTagTable('Image::ExifTool::ZIP::RAR5');
+        $et->HandleTag($tagTablePtr, 'RARVersion', 4);
+        $tagTablePtr = GetTagTable('Image::ExifTool::ZIP::RAR');
+
+        for (;;) {
+            # read block header
+            $raf->Read($buff, 7) == 7 or last;
+            my ($type, $flags, $size) = unpack('xxCvv', $buff);
+            $size -= 7;
+            if ($flags & 0x8000) {
+                $raf->Read($buff, 4) == 4 or last;
+                $size += unpack('V',$buff) - 4;
+            }
+            last if $size < 0;
+            next unless $size;  # ignore blocks with no data
+            # don't try to read very large blocks unless LargeFileSupport is enabled
+            if ($size >= 0x80000000 and not $et->Options('LargeFileSupport')) {
+                $et->Warn('Large block encountered. Aborting.');
+                last;
+            }
+            # process the block
+            if ($type == 0x74) { # file block
+                # read maximum 4 KB from a file block
+                my $n = $size > 4096 ? 4096 : $size;
+                $raf->Read($buff, $n) == $n or last;
+                # add compressed size to start of data so we can extract it with the other tags
+                $buff = pack('V',$size) . $buff;
+                $$et{DOC_NUM} = ++$docNum;
+                $et->ProcessDirectory({ DataPt => \$buff }, $tagTablePtr);
+                $size -= $n;
+            } elsif ($type == 0x75 and $size > 6) { # comment block
+                $raf->Read($buff, $size) == $size or last;
+                # save comment, only if "Stored" (this is untested)
+                if (Get8u(\$buff, 3) == 0x30) {
+                    $et->FoundTag('Comment', substr($buff, 6));
+                }
+                next;
+            }
+            # seek to the start of the next block
+            $raf->Seek($size, 1) or last if $size;
         }
-        # process the block
-        if ($type == 0x74) { # file block
-            # read maximum 4 KB from a file block
-            my $n = $size > 4096 ? 4096 : $size;
-            $raf->Read($buff, $n) == $n or last;
-            # add compressed size to start of data so we can extract it with the other tags
-            $buff = pack('V',$size) . $buff;
-            $$et{DOC_NUM} = ++$docNum;
-            $et->ProcessDirectory({ DataPt => \$buff }, $tagTablePtr);
-            $size -= $n;
-        } elsif ($type == 0x75 and $size > 6) { # comment block
-            $raf->Read($buff, $size) == $size or last;
-            # save comment, only if "Stored" (this is untested)
-            if (Get8u(\$buff, 3) == 0x30) {
-                $et->FoundTag('Comment', substr($buff, 6));
+
+    } else { # RARv5 (ref 7, github#203)
+
+        return 0 unless $raf->Read($buff, 1) and $buff eq "\0";
+        $et->SetFileType();
+        my $tagTablePtr = GetTagTable('Image::ExifTool::ZIP::RAR5');
+        $et->HandleTag($tagTablePtr, 'RARVersion', 5);
+        $$et{INDENT} .= '| ';
+
+        # loop through header blocks
+        for (;;) {
+            $raf->Seek(4, 1);                   # skip header CRC
+            my $headSize = ReadULEB($raf);
+            last if $headSize == 0;
+            # read the header and create new RAF object for reading it
+            my $header;
+            $raf->Read($header, $headSize) == $headSize or last;
+            my $rafHdr = new File::RandomAccess(\$header);
+            my $headType = ReadULEB($rafHdr);   # get header type
+
+            if ($headType == 4) {  # encryption block
+                $et->Warn("File is encrypted.", 0);
+                last;
             }
-            next;
+            # skip over all headers except file or service header
+            next unless $headType == 2 or $headType == 3;
+            $et->VerboseDir('RAR5 file', undef, $headSize) if $headType == 2;
+            
+            my $headFlag = ReadULEB($rafHdr);
+            ReadULEB($rafHdr);                  # skip extraSize
+            my $dataSize;
+            if ($headFlag & 0x0002) {
+                $dataSize = ReadULEB($rafHdr);  # compressed data size
+                if ($headType == 2) {
+                    $et->HandleTag($tagTablePtr, 'CompressedSize', $dataSize);
+                } else {
+                    $raf->Seek($dataSize, 1);   # skip service data section
+                    next;
+                }
+            } else {
+                next if $headType == 3;         # all done with service header
+                $dataSize = 0;
+            }
+            my $fileFlag = ReadULEB($rafHdr);
+            my $uncompressedSize = ReadULEB($rafHdr);
+            $et->HandleTag($tagTablePtr, 'UncompressedSize', $uncompressedSize) unless $fileFlag & 0x0008;
+            ReadULEB($rafHdr);                  # skip file attributes
+            if ($fileFlag & 0x0002) {
+                $rafHdr->Read($buff, 4) == 4 or last;
+                # (untested)
+                $et->HandleTag($tagTablePtr, 'ModifyDate', unpack('V', $buff));
+            }
+            $rafHdr->Seek(4, 1) if $fileFlag & 0x0004;  # skip CRC if present
+
+            ReadULEB($rafHdr);                  # skip compressionInfo
+
+            # get operating system
+            my $os = ReadULEB($rafHdr);
+            $et->HandleTag($tagTablePtr, 'OperatingSystem', $os);
+
+            # get filename
+            $rafHdr->Read($buff, 1) == 1 or last;
+            my $nameLen = ord($buff);
+            $rafHdr->Read($buff, $nameLen) == $nameLen or last;
+            $buff =~ s/\0+$//;  # remove trailing nulls (if any)
+            $et->HandleTag($tagTablePtr, 'ArchivedFileName', $buff);
+
+            $$et{DOC_NUM} = ++$docNum;
+
+            $raf->Seek($dataSize, 1);           # skip data section
         }
-        # seek to the start of the next block
-        $raf->Seek($size, 1) or last if $size;
+        $$et{INDENT} = substr($$et{INDENT}, 0, -2);
     }
+
     $$et{DOC_NUM} = 0;
     if ($docNum > 1 and not $et->Options('Duplicates')) {
         $et->Warn("Use the Duplicates option to extract tags for all $docNum files", 1);
@@ -735,6 +851,8 @@ under the same terms as Perl itself.
 
 =item L<http://DataCompression.info/ArchiveFormats/RAR202.txt>
 
+=item L<https://www.rarlab.com/technote.htm>
+
 =back
 
 =head1 SEE ALSO