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

Timestamp:

2021-02-26T19:39:51+13:00 (3 years ago)

Author:

anupama

Message:

Committing the improvements to EmbeddedMetaPlugin's processing of Keywords vs other metadata fields. Keywords were literally stored as arrays of words rather than phrases in PDFs (at least in Diego's sample PDF), whereas other meta fields like Subjects and Creators stored them as arrays of phrases. To get both to work, Kathy updated EXIF to a newer version, to retrieve the actual EXIF values stored in the PDF. And Kathy and Dr Bainbridge came up with a new option that I added called apply_join_before_split_to_metafields that's a regex which can list the metadata fields to apply the join_before_split to and whcih previously always got applied to all metadata fields. Now it's applied to any *Keywords metafields by default, as that's the metafield we have experience of that behaves differently to the others, as it stores by word instead of phrases. Tested on Diego's sample PDF. Diego has double-checked it to works on his sample PDF too, setting the split char to ; and turning on the join_before_split and leaving apply_join_before_split_to_metafields at its default of .*Keywords. File changes are strings.properties for the tooltip, the plugin introducing the option and working with it and Kathy's EXIF updates affecting cpan/File and cpan/Image.

File:

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

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

@@ -17 +17 @@
 #                            scalar with a multi-character newline
 #               01/24/2009 - PH Protect against reading too much at once
+#               10/04/2018 - PH Added NoBuffer option
 #
 # Notes:        Calls the normal file i/o routines unless SeekTest() fails, in
@@ -25 +26 @@
 #               May also be used for string i/o (just pass a scalar reference)
 #
-# Legal:        Copyright (c) 2003-2010 Phil Harvey (phil at owl.phy.queensu.ca)
+# Legal:        Copyright (c) 2003-2021 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.
@@ -37 +38 @@
 
 use vars qw($VERSION @ISA @EXPORT_OK);
-$VERSION = '1.10';
+$VERSION = '1.11';
 @ISA = qw(Exporter);
 
@@ -44 +45 @@
 # constants
 my $CHUNK_SIZE = 8192;  # size of chunks to read from file (must be power of 2)
+my $SKIP_SIZE = 65536;  # size to skip when fast-forwarding over sequential data
 my $SLURP_CHUNKS = 16;  # read this many chunks at a time when slurping
 
@@ -61 +63 @@
         $self = {
             BUFF_PT => $filePt,
+            BASE => 0,
             POS => 0,
             LEN => length($$filePt),
@@ -72 +75 @@
             FILE_PT => $filePt, # file pointer
             BUFF_PT => \$buff,  # reference to file data
-            POS => 0,           # current position in file
-            LEN => 0,           # data length
+            BASE => 0,          # location of start of buffer in file
+            POS => 0,           # current position in buffer
+            LEN => 0,           # length of data in buffer
             TESTED => 0,        # 0=untested, 1=passed, -1=failed (requires buffering)
         };
@@ -119 +123 @@
     my $rtnVal;
     if ($self->{TESTED} < 0) {
-        $rtnVal = $self->{POS};
+        $rtnVal = $self->{POS} + $self->{BASE};
     } else {
         $rtnVal = tell($self->{FILE_PT});
@@ -142 +146 @@
         my $newPos;
         if ($whence == 0) {
-            $newPos = $num;                 # from start of file
+            $newPos = $num - $self->{BASE}; # from start of file
         } elsif ($whence == 1) {
             $newPos = $num + $self->{POS};  # relative to current position
+        } elsif ($self->{NoBuffer} and $self->{FILE_PT}) {
+            $newPos = -1;   # (can't seek relative to end if no buffering)
         } else {
             $self->Slurp();                 # read whole file into buffer
@@ -193 +199 @@
     # read through our buffer if necessary
     if ($self->{TESTED} < 0) {
+        # purge old data before reading in NoBuffer mode
+        $self->Purge() or return 0 if $self->{NoBuffer};
         my $buff;
         my $newPos = $self->{POS} + $len;
@@ -245 +253 @@
     if ($self->{TESTED} < 0) {
         my ($num, $buff);
+        $self->Purge() or return 0 if $self->{NoBuffer};
         my $pos = $self->{POS};
         if ($fp) {
@@ -312 +321 @@
 }
 
-
-#------------------------------------------------------------------------------
-# set binary mode
+#------------------------------------------------------------------------------
+# Purge internal buffer [internal use only]
+# Inputs: 0) reference to RandomAccess object
+# Returns: 1 on success, or 0 if current buffer position is negative
+# Notes: This is called only in NoBuffer mode
+sub Purge($)
+{
+    my $self = shift;
+    return 1 unless $self->{FILE_PT};
+    return 0 if $self->{POS} < 0;   # error if we can't read from here
+    if ($self->{POS} > $CHUNK_SIZE) {
+        my $purge = $self->{POS} - ($self->{POS} % $CHUNK_SIZE);
+        if ($purge >= $self->{LEN}) {
+            # read up to current position in 64k chunks, discarding as we go
+            while ($self->{POS} > $self->{LEN}) {
+                $self->{BASE} += $self->{LEN};
+                $self->{POS} -= $self->{LEN};
+                ${$self->{BUFF_PT}} = '';
+                $self->{LEN} = read($self->{FILE_PT}, ${$self->{BUFF_PT}}, $SKIP_SIZE);
+                last if $self->{LEN} < $SKIP_SIZE;
+            }
+        } elsif ($purge > 0) {
+            ${$self->{BUFF_PT}} = substr ${$self->{BUFF_PT}}, $purge;
+            $self->{BASE} += $purge;
+            $self->{POS} -= $purge;
+            $self->{LEN} -= $purge;
+        }
+    }
+    return 1;
+}
+
+#------------------------------------------------------------------------------
+# Set binary mode
 # Inputs: 0) reference to RandomAccess object
 sub BinMode($)
@@ -323 +362 @@
 
 #------------------------------------------------------------------------------
-# close the file and free the buffer
+# Close the file and free the buffer
 # Inputs: 0) reference to RandomAccess object
 sub Close($)
@@ -371 +410 @@
     my $emptyBuff = '';
     $self->{BUFF_PT} = \$emptyBuff;
+    $self->{BASE} = 0;
     $self->{LEN} = 0;
     $self->{POS} = 0;