Changeset 24107 for main/trunk/greenstone2/perllib/cpan/File/RandomAccess.pm

Timestamp:

2011-06-01T12:33:42+12:00 (13 years ago)

Author:

sjm84

Message:

Updating the ExifTool perl modules

File:

• main/trunk/greenstone2/perllib/cpan/File/RandomAccess.pm (modified) (13 diffs)

main/trunk/greenstone2/perllib/cpan/File/RandomAccess.pm

@@ -4 +4 @@
 # Description:  Buffer to support random access reading of sequential file
 #
-# Revisions:    02/11/04 - P. Harvey Created
-#               02/20/04 - P. Harvey Added flag to disable SeekTest in new()
-#               11/18/04 - P. Harvey Fixed bug with seek relative to end of file
-#               01/02/05 - P. Harvey Added DEBUG code
-#               01/09/06 - P. Harvey Fixed bug in ReadLine() when using
-#                          multi-character EOL sequences
-#               02/20/06 - P. Harvey Fixed bug where seek past end of file could
-#                          generate "substr outside string" warning
-#               06/10/06 - P. Harvey Decreased $CHUNK_SIZE from 64k to 8k
-#               11/23/06 - P. Harvey Limit reads to < 0x80000000 bytes
+# Revisions:    02/11/2004 - P. Harvey Created
+#               02/20/2004 - P. Harvey Added flag to disable SeekTest in new()
+#               11/18/2004 - P. Harvey Fixed bug with seek relative to end of file
+#               01/02/2005 - P. Harvey Added DEBUG code
+#               01/09/2006 - P. Harvey Fixed bug in ReadLine() when using
+#                            multi-character EOL sequences
+#               02/20/2006 - P. Harvey Fixed bug where seek past end of file could
+#                            generate "substr outside string" warning
+#               06/10/2006 - P. Harvey Decreased $CHUNK_SIZE from 64k to 8k
+#               11/23/2006 - P. Harvey Limit reads to < 0x80000000 bytes
+#               11/26/2008 - P. Harvey Fixed bug in ReadLine when reading from a
+#                            scalar with a multi-character newline
+#               01/24/2009 - PH Protect against reading too much at once
 #
 # Notes:        Calls the normal file i/o routines unless SeekTest() fails, in
@@ -22 +25 @@
 #               May also be used for string i/o (just pass a scalar reference)
 #
-# Legal:        Copyright (c) 2004-2006 Phil Harvey (phil at owl.phy.queensu.ca)
+# Legal:        Copyright (c) 2003-2010 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.
@@ -34 +37 @@
 
 use vars qw($VERSION @ISA @EXPORT_OK);
-$VERSION = '1.07';
+$VERSION = '1.10';
 @ISA = qw(Exporter);
+
+sub Read($$$);
 
 # constants
@@ -64 +69 @@
         # file i/o
         my $buff = '';
-        $self = { 
+        $self = {
             FILE_PT => $filePt, # file pointer
             BUFF_PT => \$buff,  # reference to file data
@@ -156 +161 @@
 #------------------------------------------------------------------------------
 # Read from the file
-# Inputs: 0) reference to RandomAccess object
-#         1) buffer, 2) bytes to read
+# Inputs: 0) reference to RandomAccess object, 1) buffer, 2) bytes to read
 # Returns: Number of bytes read
 sub Read($$$)
@@ -165 +169 @@
     my $rtnVal;
 
-    # avoid dying with "Negative length" error
-    return 0 if $len & 0x80000000;
-
+    # protect against reading too much at once
+    # (also from dying with a "Negative length" error)
+    if ($len & 0xf8000000) {
+        return 0 if $len < 0;
+        # read in smaller blocks because Windows attempts to pre-allocate
+        # memory for the full size, which can lead to an out-of-memory error
+        my $maxLen = 0x4000000; # (MUST be less than bitmask in "if" above)
+        my $num = Read($self, $_[0], $maxLen);
+        return $num if $num < $maxLen;
+        for (;;) {
+            $len -= $maxLen;
+            last if $len <= 0;
+            my $l = $len < $maxLen ? $len : $maxLen;
+            my $buff;
+            my $n = Read($self, $buff, $l);
+            last unless $n;
+            $_[0] .= $buff;
+            $num += $n;
+            last if $n < $l;
+        }
+        return $num;
+    }
+    # read through our buffer if necessary
     if ($self->{TESTED} < 0) {
         my $buff;
@@ -196 +220 @@
         $self->{POS} += $rtnVal;
     } else {
+        # read directly from file
         $_[0] = '' unless defined $_[0];
         $rtnVal = read($self->{FILE_PT}, $_[0], $len) || 0;
@@ -204 +229 @@
             $self->{DEBUG}->{$pos} = $rtnVal;
         }
-    } 
+    }
     return $rtnVal;
 }
@@ -217 +242 @@
     my $rtnVal;
     my $fp = $self->{FILE_PT};
-    
+
     if ($self->{TESTED} < 0) {
         my ($num, $buff);
@@ -231 +256 @@
             # scan and read until we find the EOL (or hit EOF)
             for (;;) {
-                $pos = index(${$self->{BUFF_PT}}, $/, $pos) + length($/);
-                last if $pos > 0;
+                $pos = index(${$self->{BUFF_PT}}, $/, $pos);
+                if ($pos >= 0) {
+                    $pos += length($/);
+                    last;
+                }
                 $pos = $self->{LEN};    # have scanned to end of buffer
                 $num = read($fp, $buff, $CHUNK_SIZE) or last;
@@ -240 +268 @@
         } else {
             # string i/o
-            $pos = index(${$self->{BUFF_PT}}, $/, $pos) + length($/);
-            $pos <= 0 and $pos = $self->{LEN};
+            $pos = index(${$self->{BUFF_PT}}, $/, $pos);
+            if ($pos < 0) {
+                $pos = $self->{LEN};
+                $self->{POS} = $pos if $self->{POS} > $pos;
+            } else {
+                $pos += length($/);
+            }
         }
         # read the line from our buffer
@@ -260 +293 @@
             $self->{DEBUG}->{$pos} = $rtnVal;
         }
-    } 
-    return $rtnVal;  
+    }
+    return $rtnVal;
 }
 
@@ -295 +328 @@
 {
     my $self = shift;
-    
+
     if ($self->{DEBUG}) {
         local $_;