exiftool-vendored.exe 12.82.0 → 12.84.0

package/bin/exiftool_files/lib/IO/String.pm

@@ -0,0 +1,425 @@
+package IO::String;
+
+# Copyright 1998-2005 Gisle Aas.
+#
+# This library is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+require 5.005_03;
+use strict;
+use vars qw($VERSION $DEBUG $IO_CONSTANTS);
+$VERSION = "1.08";  # $Date: 2005/12/05 12:00:47 $
+
+use Symbol ();
+
+sub new
+{
+    my $class = shift;
+    my $self = bless Symbol::gensym(), ref($class) || $class;
+    tie *$self, $self;
+    $self->open(@_);
+    return $self;
+}
+
+sub open
+{
+    my $self = shift;
+    return $self->new(@_) unless ref($self);
+
+    if (@_) {
+	my $bufref = ref($_[0]) ? $_[0] : \$_[0];
+	$$bufref = "" unless defined $$bufref;
+	*$self->{buf} = $bufref;
+    }
+    else {
+	my $buf = "";
+	*$self->{buf} = \$buf;
+    }
+    *$self->{pos} = 0;
+    *$self->{lno} = 0;
+    return $self;
+}
+
+sub pad
+{
+    my $self = shift;
+    my $old = *$self->{pad};
+    *$self->{pad} = substr($_[0], 0, 1) if @_;
+    return "\0" unless defined($old) && length($old);
+    return $old;
+}
+
+sub dump
+{
+    require Data::Dumper;
+    my $self = shift;
+    print Data::Dumper->Dump([$self], ['*self']);
+    print Data::Dumper->Dump([*$self{HASH}], ['$self{HASH}']);
+    return;
+}
+
+sub TIEHANDLE
+{
+    print "TIEHANDLE @_\n" if $DEBUG;
+    return $_[0] if ref($_[0]);
+    my $class = shift;
+    my $self = bless Symbol::gensym(), $class;
+    $self->open(@_);
+    return $self;
+}
+
+sub DESTROY
+{
+    print "DESTROY @_\n" if $DEBUG;
+}
+
+sub close
+{
+    my $self = shift;
+    delete *$self->{buf};
+    delete *$self->{pos};
+    delete *$self->{lno};
+    undef *$self if $] eq "5.008";  # workaround for some bug
+    return 1;
+}
+
+sub opened
+{
+    my $self = shift;
+    return defined *$self->{buf};
+}
+
+sub binmode
+{
+    my $self = shift;
+    return 1 unless @_;
+    # XXX don't know much about layers yet :-(
+    return 0;
+}
+
+sub getc
+{
+    my $self = shift;
+    my $buf;
+    return $buf if $self->read($buf, 1);
+    return undef;
+}
+
+sub ungetc
+{
+    my $self = shift;
+    $self->setpos($self->getpos() - 1);
+    return 1;
+}
+
+sub eof
+{
+    my $self = shift;
+    return length(${*$self->{buf}}) <= *$self->{pos};
+}
+
+sub print
+{
+    my $self = shift;
+    if (defined $\) {
+	if (defined $,) {
+	    $self->write(join($,, @_).$\);
+	}
+	else {
+	    $self->write(join("",@_).$\);
+	}
+    }
+    else {
+	if (defined $,) {
+	    $self->write(join($,, @_));
+	}
+	else {
+	    $self->write(join("",@_));
+	}
+    }
+    return 1;
+}
+*printflush = \*print;
+
+sub printf
+{
+    my $self = shift;
+    print "PRINTF(@_)\n" if $DEBUG;
+    my $fmt = shift;
+    $self->write(sprintf($fmt, @_));
+    return 1;
+}
+
+
+my($SEEK_SET, $SEEK_CUR, $SEEK_END);
+
+sub _init_seek_constants
+{
+    if ($IO_CONSTANTS) {
+	require IO::Handle;
+	$SEEK_SET = &IO::Handle::SEEK_SET;
+	$SEEK_CUR = &IO::Handle::SEEK_CUR;
+	$SEEK_END = &IO::Handle::SEEK_END;
+    }
+    else {
+	$SEEK_SET = 0;
+	$SEEK_CUR = 1;
+	$SEEK_END = 2;
+    }
+}
+
+
+sub seek
+{
+    my($self,$off,$whence) = @_;
+    my $buf = *$self->{buf} || return 0;
+    my $len = length($$buf);
+    my $pos = *$self->{pos};
+
+    _init_seek_constants() unless defined $SEEK_SET;
+
+    if    ($whence == $SEEK_SET) { $pos = $off }
+    elsif ($whence == $SEEK_CUR) { $pos += $off }
+    elsif ($whence == $SEEK_END) { $pos = $len + $off }
+    else                         { die "Bad whence ($whence)" }
+    print "SEEK(POS=$pos,OFF=$off,LEN=$len)\n" if $DEBUG;
+
+    $pos = 0 if $pos < 0;
+    $self->truncate($pos) if $pos > $len;  # extend file
+    *$self->{pos} = $pos;
+    return 1;
+}
+
+sub pos
+{
+    my $self = shift;
+    my $old = *$self->{pos};
+    if (@_) {
+	my $pos = shift || 0;
+	my $buf = *$self->{buf};
+	my $len = $buf ? length($$buf) : 0;
+	$pos = $len if $pos > $len;
+	*$self->{pos} = $pos;
+    }
+    return $old;
+}
+
+sub getpos { shift->pos; }
+
+*sysseek = \&seek;
+*setpos  = \&pos;
+*tell    = \&getpos;
+
+
+
+sub getline
+{
+    my $self = shift;
+    my $buf  = *$self->{buf} || return;
+    my $len  = length($$buf);
+    my $pos  = *$self->{pos};
+    return if $pos >= $len;
+
+    unless (defined $/) {  # slurp
+	*$self->{pos} = $len;
+	return substr($$buf, $pos);
+    }
+
+    unless (length $/) {  # paragraph mode
+	# XXX slow&lazy implementation using getc()
+	my $para = "";
+	my $eol = 0;
+	my $c;
+	while (defined($c = $self->getc)) {
+	    if ($c eq "\n") {
+		$eol++;
+		next if $eol > 2;
+	    }
+	    elsif ($eol > 1) {
+		$self->ungetc($c);
+		last;
+	    }
+	    else {
+		$eol = 0;
+	    }
+	    $para .= $c;
+	}
+	return $para;   # XXX wantarray
+    }
+
+    my $idx = index($$buf,$/,$pos);
+    if ($idx < 0) {
+	# return rest of it
+	*$self->{pos} = $len;
+	$. = ++ *$self->{lno};
+	return substr($$buf, $pos);
+    }
+    $len = $idx - $pos + length($/);
+    *$self->{pos} += $len;
+    $. = ++ *$self->{lno};
+    return substr($$buf, $pos, $len);
+}
+
+sub getlines
+{
+    die "getlines() called in scalar context\n" unless wantarray;
+    my $self = shift;
+    my($line, @lines);
+    push(@lines, $line) while defined($line = $self->getline);
+    return @lines;
+}
+
+sub READLINE
+{
+    goto &getlines if wantarray;
+    goto &getline;
+}
+
+sub input_line_number
+{
+    my $self = shift;
+    my $old = *$self->{lno};
+    *$self->{lno} = shift if @_;
+    return $old;
+}
+
+sub truncate
+{
+    my $self = shift;
+    my $len = shift || 0;
+    my $buf = *$self->{buf};
+    if (length($$buf) >= $len) {
+	substr($$buf, $len) = '';
+	*$self->{pos} = $len if $len < *$self->{pos};
+    }
+    else {
+	$$buf .= ($self->pad x ($len - length($$buf)));
+    }
+    return 1;
+}
+
+sub read
+{
+    my $self = shift;
+    my $buf = *$self->{buf};
+    return undef unless $buf;
+
+    my $pos = *$self->{pos};
+    my $rem = length($$buf) - $pos;
+    my $len = $_[1];
+    $len = $rem if $len > $rem;
+    return undef if $len < 0;
+    if (@_ > 2) { # read offset
+	substr($_[0],$_[2]) = substr($$buf, $pos, $len);
+    }
+    else {
+	$_[0] = substr($$buf, $pos, $len);
+    }
+    *$self->{pos} += $len;
+    return $len;
+}
+
+sub write
+{
+    my $self = shift;
+    my $buf = *$self->{buf};
+    return unless $buf;
+
+    my $pos = *$self->{pos};
+    my $slen = length($_[0]);
+    my $len = $slen;
+    my $off = 0;
+    if (@_ > 1) {
+	$len = $_[1] if $_[1] < $len;
+	if (@_ > 2) {
+	    $off = $_[2] || 0;
+	    die "Offset outside string" if $off > $slen;
+	    if ($off < 0) {
+		$off += $slen;
+		die "Offset outside string" if $off < 0;
+	    }
+	    my $rem = $slen - $off;
+	    $len = $rem if $rem < $len;
+	}
+    }
+    substr($$buf, $pos, $len) = substr($_[0], $off, $len);
+    *$self->{pos} += $len;
+    return $len;
+}
+
+*sysread = \&read;
+*syswrite = \&write;
+
+sub stat
+{
+    my $self = shift;
+    return unless $self->opened;
+    return 1 unless wantarray;
+    my $len = length ${*$self->{buf}};
+
+    return (
+     undef, undef,  # dev, ino
+     0666,          # filemode
+     1,             # links
+     $>,            # user id
+     $),            # group id
+     undef,         # device id
+     $len,          # size
+     undef,         # atime
+     undef,         # mtime
+     undef,         # ctime
+     512,           # blksize
+     int(($len+511)/512)  # blocks
+    );
+}
+
+sub FILENO {
+    return undef;   # XXX perlfunc says this means the file is closed
+}
+
+sub blocking {
+    my $self = shift;
+    my $old = *$self->{blocking} || 0;
+    *$self->{blocking} = shift if @_;
+    return $old;
+}
+
+my $notmuch = sub { return };
+
+*fileno    = $notmuch;
+*error     = $notmuch;
+*clearerr  = $notmuch; 
+*sync      = $notmuch;
+*flush     = $notmuch;
+*setbuf    = $notmuch;
+*setvbuf   = $notmuch;
+
+*untaint   = $notmuch;
+*autoflush = $notmuch;
+*fcntl     = $notmuch;
+*ioctl     = $notmuch;
+
+*GETC   = \&getc;
+*PRINT  = \&print;
+*PRINTF = \&printf;
+*READ   = \&read;
+*WRITE  = \&write;
+*SEEK   = \&seek;
+*TELL   = \&getpos;
+*EOF    = \&eof;
+*CLOSE  = \&close;
+*BINMODE = \&binmode;
+
+
+sub string_ref
+{
+    my $self = shift;
+    return *$self->{buf};
+}
+*sref = \&string_ref;
+
+1;
+
+__END__
+
+#line 552

package/bin/exiftool_files/lib/IO/Uncompress/Adapter/Inflate.pm

@@ -4,11 +4,11 @@ use strict;
 use warnings;
 use bytes;
 
-use IO::Compress::Base::Common  2.086 qw(:Status);
-use Compress::Raw::Zlib  2.086 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS);
+use IO::Compress::Base::Common  2.100 qw(:Status);
+use Compress::Raw::Zlib  2.100 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS);
 
 our ($VERSION);
-$VERSION = '2.086';
+$VERSION = '2.100';
 
 
 
@@ -23,23 +23,23 @@ sub mkUncompObject
 
     if ($scan)
     {
-        ($inflate, $status) = new Compress::Raw::Zlib::InflateScan
+        ($inflate, $status) = Compress::Raw::Zlib::InflateScan->new(
                                     #LimitOutput  => 1,
                                     CRC32        => $crc32,
                                     ADLER32      => $adler32,
-                                    WindowBits   => - MAX_WBITS ;
+                                    WindowBits   => - MAX_WBITS );
     }
     else
     {
-        ($inflate, $status) = new Compress::Raw::Zlib::Inflate
+        ($inflate, $status) = Compress::Raw::Zlib::Inflate->new(
                                     AppendOutput => 1,
                                     LimitOutput  => 1,
                                     CRC32        => $crc32,
                                     ADLER32      => $adler32,
-                                    WindowBits   => - MAX_WBITS ;
+                                    WindowBits   => - MAX_WBITS );
     }
 
-    return (undef, "Could not create Inflation object: $status", $status) 
+    return (undef, "Could not create Inflation object: $status", $status)
         if $status != Z_OK ;
 
     return bless {'Inf'        => $inflate,
@@ -47,8 +47,8 @@ sub mkUncompObject
                   'UnCompSize' => 0,
                   'Error'      => '',
                   'ConsumesInput' => 1,
-                 } ;     
-    
+                 } ;
+
 }
 
 sub uncompr
@@ -67,7 +67,7 @@ sub uncompr
         $self->{Error} = "Inflation Error: $status";
         return STATUS_ERROR;
     }
-            
+
     return STATUS_OK        if $status == Z_BUF_ERROR ; # ???
     return STATUS_OK        if $status == Z_OK ;
     return STATUS_ENDSTREAM if $status == Z_STREAM_END ;
@@ -115,8 +115,8 @@ sub adler32
 sub sync
 {
     my $self = shift ;
-    ( $self->{Inf}->inflateSync(@_) == Z_OK) 
-            ? STATUS_OK 
+    ( $self->{Inf}->inflateSync(@_) == Z_OK)
+            ? STATUS_OK
             : STATUS_ERROR ;
 }
 
@@ -154,4 +154,3 @@ sub createDeflateStream
 
 
 __END__
-