[tools 1/2] testbot: Allow for more complex Collection filtering.

Francois Gouget fgouget at codeweavers.com
Thu Mar 4 07:23:26 CST 2021


The previous scheme used an implicit AND between all the property
filters, with no way of replacing it with an OR.
The new scheme makes it possible to create almost any where clause
(excluding joins).
For instance this makes it possible to get all the Jobs that were
submitted or completed recently:
$Jobs->AddFilter(FilterOr(FilterValue("Submitted", ">=", [$Recent]]),
                          FilterValue("Ended", ">=", [$Recent])));

Signed-off-by: Francois Gouget <fgouget at codeweavers.com>
---
 testbot/lib/ObjectModel/Collection.pm |  98 ++++++++++++++--
 testbot/lib/ObjectModel/DBIBackEnd.pm | 158 ++++++++++++++++++--------
 2 files changed, 201 insertions(+), 55 deletions(-)

diff --git a/testbot/lib/ObjectModel/Collection.pm b/testbot/lib/ObjectModel/Collection.pm
index 1fe1481f6..782f32c23 100644
--- a/testbot/lib/ObjectModel/Collection.pm
+++ b/testbot/lib/ObjectModel/Collection.pm
@@ -1,6 +1,6 @@
 # -*- Mode: Perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
 # Copyright 2009 Ge van Geldorp
-# Copyright 2012-2014 Francois Gouget
+# Copyright 2012-2014, 2021 Francois Gouget
 #
 # This library is free software; you can redistribute it and/or
 # modify it under the terms of the GNU Lesser General Public
@@ -38,6 +38,7 @@ criteria.
 =cut
 
 use Exporter 'import';
+our @EXPORT = qw(FilterValue FilterNull FilterNotNull FilterAnd FilterOr FilterNot);
 our @EXPORT_OK = qw(new ComputeMasterKey);
 
 use Scalar::Util qw(blessed weaken);
@@ -90,7 +91,7 @@ sub new($$$$$;$$@)
               MasterColNames      => $MasterColNames,
               MasterColValues     => $MasterColValues,
               MasterKey           => ComputeMasterKey($MasterColValues),
-              Filters             => {},
+              Filter              => undef,
               AllScopeItems       => $AllScopeItems || {},
               Items               => undef};
   if ($AllScopeItems)
@@ -692,18 +693,99 @@ sub DeleteAll($)
   return undef;
 }
 
-sub AddFilter($$$;$)
+
+#
+# Item filtering
+#
+
+my %FilterTypes = (
+  'value'    => 1,
+  'null'     => 1,
+  'not null' => 1,
+  'and'      => 1,
+  'or'       => 1,
+  'not'      => 1,
+);
+
+my %ValueComparators = (
+  '='        => 1,
+  '<>'       => 1,
+  '<'        => 1,
+  '<='       => 1,
+  '>'        => 1,
+  '>='       => 1,
+  'LIKE'     => 1,
+  'NOT LIKE' => 1,
+);
+
+sub FilterValue($$$)
 {
-  my ($self, $PropertyName, $Values, $Type) = @_;
+  my ($PropertyName, $Comparator, $Values) = @_;
 
-  $self->{Filters}{$PropertyName} = [($Type || "="), $Values];
+  die "unknown '$Comparator' comparator" if (!$ValueComparators{$Comparator});
+  return { Type => 'value',
+           Property => $PropertyName,
+           Comparator => $Comparator,
+           Values => $Values,
+  };
 }
 
-sub GetFilters($)
+sub FilterNull($)
 {
-  my ($self) = @_;
+  my ($PropertyName) = @_;
+
+  return { Type => 'null', Property => $PropertyName };
+}
+
+sub FilterNotNull($)
+{
+  my ($PropertyName) = @_;
+
+  return { Type => 'not null', Property => $PropertyName };
+}
+
+sub FilterAnd(@)
+{
+  return { Type => 'and', Terms => [@_] };
+}
+
+sub FilterOr(@)
+{
+
+  return { Type => 'or', Terms => [@_] };
+}
+
+sub FilterNot($)
+{
+  my ($Term) = @_;
+
+  return { Type => 'not', Term => $Term };
+}
+
+sub AddFilter($$;$$)
+{
+  my $self = shift;
+  my $Filter = @_ == 1 ? $_[0] : FilterValue($_[0], $_[2] || "=", $_[1]);
+
+  if (!$self->{Filter})
+  {
+    $self->{Filter} = $Filter;
+  }
+  elsif ($self->{Filter}->{Type} eq 'and')
+  {
+    push @{$self->{Filter}->{Terms}}, $Filter;
+  }
+  else
+  {
+    $self->{Filter} = FilterAnd($self->{Filter}, $Filter);
+  }
+}
+
+sub GetFilter($)
+{
+  my ($self, $PropertyName, $Values, $Type) = @_;
 
-  return $self->{Filters};
+  return $self->{Filter};
 }
 
 1;
diff --git a/testbot/lib/ObjectModel/DBIBackEnd.pm b/testbot/lib/ObjectModel/DBIBackEnd.pm
index 88ecf8521..10cc1f3c3 100644
--- a/testbot/lib/ObjectModel/DBIBackEnd.pm
+++ b/testbot/lib/ObjectModel/DBIBackEnd.pm
@@ -1,6 +1,6 @@
 # -*- Mode: Perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
 # Copyright 2009 Ge van Geldorp
-# Copyright 2012, 2014 Francois Gouget
+# Copyright 2012, 2014, 2018 Francois Gouget
 #
 # This library is free software; you can redistribute it and/or
 # modify it under the terms of the GNU Lesser General Public
@@ -174,15 +174,108 @@ sub BuildFieldList($$)
   return $Fields;
 }
 
-my %_AllowedFilterTypes = (
-  "="    => 1,
-  "<>"   => 1,
-  "<"    => 1,
-  "<="   => 1,
-  ">"    => 1,
-  ">="   => 1,
-  "LIKE" => 1,
-);
+sub ColNameToDb($)
+{
+  my ($PropertyDescriptor) = @_;
+
+  my $ColNames = $PropertyDescriptor->GetColNames();
+  if (@$ColNames != 1)
+  {
+    die "cannot filter on Itemref with more than one column name: @$ColNames";
+  }
+  return $ColNames->[0];
+}
+
+=pod
+=over 12
+
+=item C<GetFilterWhere()>
+
+Builds the WHERE clause and its associated data parameter from the specified
+collection and filter tree.
+
+Returns a triplet composed of a boolean which is true if the returned WHERE
+clause is composite, that is if it should be enclosed in parentheses before
+being combined with other filters ; the WHERE clause string ; and a reference
+to the data array.
+
+=back
+=cut
+
+sub GetFilterWhere($$$);
+sub GetFilterWhere($$$)
+{
+  my ($self, $Collection, $Filter) = @_;
+
+  if ($Filter->{Type} eq 'value')
+  {
+    my $Values = $Filter->{Values};
+    if (!$Values or @$Values == 0)
+    {
+      die "no values for the $Filter->{Property} $Filter->{Comparator} property filter";
+    }
+
+    my $PropertyDescriptor = $Collection->GetPropertyDescriptorByName($Filter->{Property});
+    my (@Wheres, @Data);
+    foreach my $ColValue (@$Values)
+    {
+      my $ColName = ColNameToDb($PropertyDescriptor);
+      push @Wheres, "$ColName $Filter->{Comparator} ?";
+
+      if ($PropertyDescriptor->GetClass() eq "Itemref")
+      {
+        $ColValue = $ColValue->GetKey();
+      }
+      push @Data, $self->ToDb($ColValue, $PropertyDescriptor);
+    }
+    return (@$Values > 1, join(" OR ", @Wheres), \@Data);
+  }
+
+  if ($Filter->{Type} eq 'and' or $Filter->{Type} eq 'or')
+  {
+    my $Terms = $Filter->{Terms};
+    if (!$Terms or !@$Terms)
+    {
+      die "no terms for the $Filter->{Type} filter";
+    }
+    if (@$Terms == 1)
+    {
+      return GetFilterWhere($self, $Collection, $Terms->[0]);
+    }
+
+    my (@Wheres, @Data);
+    foreach my $Term (@$Terms)
+    {
+      my ($Composite, $TermWhere, $TermData) = GetFilterWhere($self, $Collection, $Term);
+      push @Wheres, ($Composite ? "($TermWhere)" : $TermWhere);
+      push @Data, @$TermData;
+    }
+
+    my $Operator = ($Filter->{Type} eq 'and' ? " AND " : " OR ");
+    return (1, join($Operator, @Wheres), \@Data);
+  }
+
+  if ($Filter->{Type} eq 'null' or $Filter->{Type} eq 'not null')
+  {
+    my $PropertyDescriptor = $Collection->GetPropertyDescriptorByName($Filter->{Property});
+    my $ColName = ColNameToDb($PropertyDescriptor);
+    my $Operator = ($Filter->{Type} eq 'null' ? "IS NULL" : "IS NOT NULL");
+    return (0, "$ColName $Operator", []);
+  }
+
+  if ($Filter->{Type} eq 'not')
+  {
+    if (!$Filter->{Term})
+    {
+      die "no term for the not filter";
+    }
+    my ($Composite, $TermWhere, $TermData) = GetFilterWhere($self, $Collection, $Filter->{Term});
+    # To avoid confusion add parentheses even it the term is not composite
+    return (0, "NOT ($TermWhere)", $TermData);
+  }
+
+  die "unsupported '$Filter->{Type}' filter type";
+}
 
 sub LoadCollection($$)
 {
@@ -199,48 +292,19 @@ sub LoadCollection($$)
     push @Data, @{$MasterColValues};
   }
 
-  my $Filters = $Collection->GetFilters();
-  foreach my $FilterProperty (keys %$Filters)
+  my $Filter = $Collection->GetFilter();
+  if ($Filter)
   {
+    my ($Composite, $FilterWhere, $FilterData) = GetFilterWhere($self, $Collection, $Filter);
     if ($Where ne "")
     {
-      $Where .= " AND ";
-    }
-    my $PropertyDescriptor = $Collection->GetPropertyDescriptorByName($FilterProperty);
-    my ($FilterType, $FilterValues) = @{$Filters->{$FilterProperty}};
-    if (!$_AllowedFilterTypes{$FilterType})
-    {
-      die "unknown '$FilterType' filter type";
-    }
-    if (!@$FilterValues)
-    {
-      die "no values for the '$FilterType' filter";
-    }
-
-    if (@$FilterValues != 1)
-    {
-      $Where .= "(";
-    }
-    foreach my $FilterIndex (0 .. @$FilterValues - 1)
-    {
-      if ($FilterIndex != 0)
-      {
-        $Where .= " OR ";
-      }
-      my $ColValue = $FilterValues->[$FilterIndex];
-      if ($PropertyDescriptor->GetClass() eq "Itemref")
-      {
-        $ColValue = $ColValue->GetKey();
-      }
-      foreach my $ColName (@{$PropertyDescriptor->GetColNames()})
-      {
-        $Where .= "$ColName $FilterType ?";
-        $Data[@Data] = $self->ToDb($ColValue, $PropertyDescriptor);
-      }
+      $Where .= ($Composite ? " AND ($FilterWhere)" : " AND $FilterWhere");
+      push @Data, @$FilterData;
     }
-    if (@$FilterValues != 1)
+    else
     {
-      $Where .= ")";
+      $Where = $FilterWhere;
+      @Data = @$FilterData;
     }
   }
 
-- 
2.20.1




More information about the wine-devel mailing list