Item14449: improved handling of numeric parameters

also, trying to use storage segments more efficiently

data/System/DBCacheContrib.txt

@@ -132,6 +132,7 @@ This code is based on an original development of Motorola Inc. and is protected
 ---++ Change History
 
 %TABLE{columnwidths="7em" tablewidth="100%"}%
+|  28 Jul 2017 | Foswikitask:Item14449: numeric operands may cause a perl warning when parameters aren't numeric; trying to fill archive segments in a more efficient way |
 |  16 Jan 2017 | Foswikitask:Item14270: oo-ify core; fixed parsing numbers |
 |  09 Jul 2016 | Foswikitask:Item14111: remove inline data images before indexing |
 |  18 Oct 2015 | Foswikitask:Item13824: fixed dbcache failing to update topics in subwebs under certain conditions |

lib/Foswiki/Contrib/DBCacheContrib.pm

@@ -41,8 +41,8 @@ FormQueryPlugin for an example of this.
 
 =cut
 
-our $VERSION = '4.11';
-our $RELEASE = '16 Jan 2017';
+our $VERSION = '4.20';
+our $RELEASE = '28 Jul 2017';
 our $SHORTDESCRIPTION =
   'Reusable code that treats forms as if they were table rows in a database';
 
@@ -643,9 +643,9 @@ sub uptodate {
 
     # SMELL: core API
     my $fileTime;
-    if ( $Foswiki::Plugins::SESSION->can('getApproxRevTime') ) {
+    if ( $Foswiki::Plugins::SESSION->{store}->can('getApproxRevTime') ) {
         $fileTime =
-          $Foswiki::Plugins::SESSION->getApproxRevTime( $web, $topic );
+          $Foswiki::Plugins::SESSION->{store}->getApproxRevTime( $web, $topic );
     }
     else {
 

lib/Foswiki/Contrib/DBCacheContrib/Archivist/Serializable.pm

@@ -114,7 +114,7 @@ sub getRoot {
         foreach my $cacheFile ( $this->_getCacheFiles ) {
             my $seg = $this->deserialize($cacheFile);
 
-            #print STDERR "loading segment $seg->{id}\n";
+           #print STDERR "loading segment $seg->{id} for $this->{_cacheName}\n";
             $this->{root}->addSegment($seg);
 
             # remember the time the file has been loaded

lib/Foswiki/Contrib/DBCacheContrib/MANIFEST

@@ -1,3 +1,4 @@
+!noci
 data/System/DBCacheContrib.txt 0644
 lib/CPAN/lib/Sereal.pm 0644
 lib/Foswiki/Contrib/DBCacheContrib/Archivable.pm 0644

lib/Foswiki/Contrib/DBCacheContrib/Search.pm

@@ -57,7 +57,7 @@ my %operators = (
     'OR'                 => { exec => \&OP_or,                 prec => 1 },
     'FALSE'              => { exec => \&OP_false,              prec => 0 },
     'NODE'               => { exec => \&OP_node,               prec => 0 },
-    'NUMBER'             => { exec => \&OP_string,             prec => 0 },
+    'NUMBER'             => { exec => \&OP_number,             prec => 0 },
     'REF'                => { exec => \&OP_ref,                prec => 0 },
     'STRING'             => { exec => \&OP_string,             prec => 0 },
     'TRUE'               => { exec => \&OP_true,               prec => 0 },
@@ -176,7 +176,7 @@ sub _parse {
                 )
             );
         }
-        elsif ( $string =~ s/^\s*(-?\d+(\.\d*)?(e-?\d+)?)\b//io ) {
+        elsif ( $string =~ s/^\s*([+-]?\d+(?:\.\d*)?(?:e[+-]?\d+)?)\b//io ) {
             push(
                 @opands,
                 new Foswiki::Contrib::DBCacheContrib::Search(
@@ -344,6 +344,9 @@ sub OP_length {
     elsif ( ref($rval) eq 'HASH' ) {
         return scalar( keys %$rval );
     }
+    elsif ( ref($rval) && UNIVERSAL::can( $rval, "size" ) ) {
+        return $rval->size();
+    }
     else {
         return length($rval);
     }
@@ -501,9 +504,15 @@ sub OP_greater {
     my $lval = $l->matches($map);
     return undef unless defined $lval;
 
+    ($lval) = $lval =~ /([+-]?\d+(?:\.\d*)?(?:e[+-]?\d+)?)/;
+    return undef unless defined $lval;
+
     my $rval = $r->matches($map);
     return undef unless defined $rval;
 
+    ($rval) = $rval =~ /([+-]?\d+(?:\.\d*)?(?:e[+-]?\d+)?)/;
+    return undef unless defined $rval;
+
     return ( $lval > $rval ) ? 1 : 0;
 }
 
@@ -515,9 +524,15 @@ sub OP_smaller {
     my $lval = $l->matches($map);
     return undef unless defined $lval;
 
+    ($lval) = $lval =~ /([+-]?\d+(?:\.\d*)?(?:e[+-]?\d+)?)/;
+    return undef unless defined $lval;
+
     my $rval = $r->matches($map);
     return undef unless defined $rval;
 
+    ($rval) = $rval =~ /([+-]?\d+(?:\.\d*)?(?:e[+-]?\d+)?)/;
+    return undef unless defined $rval;
+
     return ( $lval < $rval ) ? 1 : 0;
 }
 
@@ -529,9 +544,15 @@ sub OP_gtequal {
     my $lval = $l->matches($map);
     return undef unless defined $lval;
 
+    ($lval) = $lval =~ /([+-]?\d+(?:\.\d*)?(?:e[+-]?\d+)?)/;
+    return undef unless defined $lval;
+
     my $rval = $r->matches($map);
     return undef unless defined $rval;
 
+    ($rval) = $rval =~ /([+-]?\d+(?:\.\d*)?(?:e[+-]?\d+)?)/;
+    return undef unless defined $rval;
+
     return ( $lval >= $rval ) ? 1 : 0;
 }
 
@@ -543,9 +564,15 @@ sub OP_smequal {
     my $lval = $l->matches($map);
     return undef unless defined $lval;
 
+    ($lval) = $lval =~ /([+-]?\d+(?:\.\d*)?(?:e[+-]?\d+)?)/;
+    return undef unless defined $lval;
+
     my $rval = $r->matches($map);
     return undef unless defined $rval;
 
+    ($rval) = $rval =~ /([+-]?\d+(?:\.\d*)?(?:e[+-]?\d+)?)/;
+    return undef unless defined $rval;
+
     return ( $lval <= $rval ) ? 1 : 0;
 }
 

lib/Foswiki/Contrib/DBCacheContrib/SegmentMap.pm

@@ -48,9 +48,8 @@ sub addSegment {
 
     $this->{_segments}{ $seg->{id} } = $seg;
     $this->{_segmentOfKey}{$_} = $seg foreach $seg->getKeys();
-    $this->{_lastSegment} = $seg if $seg->size() < SEGMENT_SIZE;
-
- #print STDERR "segmentsOfKey=".join(", ", keys %{$this->{_segmentOfKey}})."\n";
+    $this->{_lastSegment} = $seg
+      unless $this->{_lastSegment} || $seg->size() >= SEGMENT_SIZE;
 }
 
 sub getSegments {
@@ -90,16 +89,12 @@ sub getSegment {
     my ( $this, $key ) = @_;
 
     my $seg = $this->getSegmentOfKey($key);
-
-    #print STDERR "segment of $key = $seg->{id}\n" if defined $seg;
-    #print STDERR "segment not found. key=$key\n" unless defined $seg;
     return $seg if defined $seg;
 
     my $lastSegment = $this->{_lastSegment};
     if ( !defined $lastSegment
         || $lastSegment->size() >= SEGMENT_SIZE )
     {
-
         $lastSegment = $this->{_lastSegment} = $this->{_segmentsImpl}->new();
         $lastSegment->{id} = $this->getNextSegmentId();