[Rt-commit] r3910 - in rt/branches/QUEBEC-EXPERIMENTAL: . html/Search lib/RT

jesse at bestpractical.com jesse at bestpractical.com
Wed Oct 5 14:35:57 EDT 2005


Author: jesse
Date: Wed Oct  5 14:35:57 2005
New Revision: 3910

Modified:
   rt/branches/QUEBEC-EXPERIMENTAL/   (props changed)
   rt/branches/QUEBEC-EXPERIMENTAL/html/Search/Build.html
   rt/branches/QUEBEC-EXPERIMENTAL/lib/RT/Tickets_Overlay.pm
Log:
 r17056 at hualien:  jesse | 2005-10-05 10:08:04 -0400
  r15752 at hualien:  jesse | 2005-09-15 11:41:41 -0400
   r14236 at hualien (orig r3754):  robert | 2005-09-01 17:47:36 -0400
    r3800 at bear:  rspier | 2005-09-01 14:46:59 -0700
    RT-Ticket: 6986
    RT-Status: resolved
    RT-Update: correspond
    
    If we didn't generate any SQL, don't pass it to FromSQL which will reset the dirty flag and then SB won't actually run anything.
    
    Also, tests.
        
   
   r15713 at hualien (orig r3847):  glasser | 2005-09-12 18:11:43 -0400
    r41532 at maclaurin-seven-twelve:  glasser | 2005-09-12 18:04:55 -0400
    Defining subs in Mason components is dangerous, since they clash with subs defined
    in every other component.
   
  
 


Modified: rt/branches/QUEBEC-EXPERIMENTAL/html/Search/Build.html
==============================================================================
--- rt/branches/QUEBEC-EXPERIMENTAL/html/Search/Build.html	(original)
+++ rt/branches/QUEBEC-EXPERIMENTAL/html/Search/Build.html	Wed Oct  5 14:35:57 2005
@@ -233,8 +233,199 @@
 # }}}
 
 # {{{ Parse the query
+use Regexp::Common qw /delimited/;
+
+# States
+use constant VALUE   => 1;
+use constant AGGREG  => 2;
+use constant OP      => 4;
+use constant PAREN   => 8;
+use constant KEYWORD => 16;
+
+my $_match = sub {
+
+    # Case insensitive equality
+    my ( $y, $x ) = @_;
+    return 1 if $x =~ /^$y$/i;
+
+    #  return 1 if ((lc $x) eq (lc $y)); # Why isnt this equiv?
+    return 0;
+};
+
+my $ParseQuery = sub {
+    my $string  = shift;
+    my $tree    = shift;
+    my @actions = shift;
+    my $want    = KEYWORD | PAREN;
+    my $last    = undef;
+
+    my $depth = 1;
+
+    # make a tree root
+    $$tree = RT::Interface::Web::QueryBuilder::Tree->new;
+    my $root       = RT::Interface::Web::QueryBuilder::Tree->new( 'AND', $$tree );
+    my $lastnode   = $root;
+    my $parentnode = $root;
+
+    # get the FIELDS from Tickets_Overlay
+    my $tickets = new RT::Tickets( $session{'CurrentUser'} );
+    my %FIELDS  = %{ $tickets->FIELDS };
+
+    # Lower Case version of FIELDS, for case insensitivity
+    my %lcfields = map { ( lc($_) => $_ ) } ( keys %FIELDS );
+
+    my @tokens     = qw[VALUE AGGREG OP PAREN KEYWORD];
+    my $re_aggreg  = qr[(?i:AND|OR)];
+    my $re_value   = qr[$RE{delimited}{-delim=>qq{\'\"}}|\d+];
+    my $re_keyword = qr[$RE{delimited}{-delim=>qq{\'\"}}|(?:\{|\}|\w|\.)+];
+    my $re_op      =
+      qr[=|!=|>=|<=|>|<|(?i:IS NOT)|(?i:IS)|(?i:NOT LIKE)|(?i:LIKE)]
+      ;    # long to short
+    my $re_paren = qr'\(|\)';
+
+    # assume that $ea is AND if it is not set
+    my ( $ea, $key, $op, $value ) = ( "AND", "", "", "" );
+
+    # order of matches in the RE is important.. op should come early,
+    # because it has spaces in it.  otherwise "NOT LIKE" might be parsed
+    # as a keyword or value.
+
+    while (
+        $string =~ /(
+                      $re_aggreg
+                      |$re_op
+                      |$re_keyword
+                      |$re_value
+                      |$re_paren
+                     )/igx
+      )
+    {
+        my $val     = $1;
+        my $current = 0;
+
+        # Highest priority is last
+        $current = OP    if $_match->( $re_op,    $val );
+        $current = VALUE if $_match->( $re_value, $val );
+        $current = KEYWORD
+          if $_match->( $re_keyword, $val ) && ( $want & KEYWORD );
+        $current = AGGREG if $_match->( $re_aggreg, $val );
+        $current = PAREN  if $_match->( $re_paren,  $val );
+
+        unless ( $current && $want & $current ) {
+
+            # Error
+            # FIXME: I will only print out the highest $want value
+            my $token = $tokens[ ( ( log $want ) / ( log 2 ) ) ];
+            push @actions,
+              [
+                loc(
+"current: $current, want $want, Error near ->$val<- expecting a "
+                      . $token
+                      . " in '$string'\n"
+                ),
+                -1
+              ];
+        }
+
+        # State Machine:
+        my $parentdepth = $depth;
+
+        # Parens are highest priority
+        if ( $current & PAREN ) {
+            if ( $val eq "(" ) {
+                $depth++;
+
+                # make a new node that the clauses can be children of
+                $parentnode = RT::Interface::Web::QueryBuilder::Tree->new( $ea, $parentnode );
+            }
+            else {
+                $depth--;
+                $parentnode = $parentnode->getParent();
+                $lastnode   = $parentnode;
+            }
+
+            $want = KEYWORD | PAREN | AGGREG;
+        }
+        elsif ( $current & AGGREG ) {
+            $ea   = $val;
+            $want = KEYWORD | PAREN;
+        }
+        elsif ( $current & KEYWORD ) {
+            $key  = $val;
+            $want = OP;
+        }
+        elsif ( $current & OP ) {
+            $op   = $val;
+            $want = VALUE;
+        }
+        elsif ( $current & VALUE ) {
+            $value = $val;
+
+            # Remove surrounding quotes from $key, $val
+            # (in future, simplify as for($key,$val) { action on $_ })
+            if ( $key =~ /$RE{delimited}{-delim=>qq{\'\"}}/ ) {
+                substr( $key, 0,  1 ) = "";
+                substr( $key, -1, 1 ) = "";
+            }
+            if ( $val =~ /$RE{delimited}{-delim=>qq{\'\"}}/ ) {
+                substr( $val, 0,  1 ) = "";
+                substr( $val, -1, 1 ) = "";
+            }
+
+            # Unescape escaped characters
+            $key =~ s!\\(.)!$1!g;
+            $val =~ s!\\(.)!$1!g;
+
+            my $class;
+            if ( exists $lcfields{ lc $key } ) {
+                $key   = $lcfields{ lc $key };
+                $class = $FIELDS{$key}->[0];
+            }
+            if ( $class ne 'INT' ) {
+                $val = "'$val'";
+            }
+
+            push @actions, [ loc("Unknown field: $key"), -1 ] unless $class;
+
+            $want = PAREN | AGGREG;
+        }
+        else {
+            push @actions, [ loc("I'm lost"), -1 ];
+        }
+
+        if ( $current & VALUE ) {
+            if ( $key =~ /^CF./ ) {
+                $key = "'" . $key . "'";
+            }
+            my $clause = {
+                Key   => $key,
+                Op    => $op,
+                Value => $val
+            };
+
+            # explicity add a child to it
+            $lastnode = RT::Interface::Web::QueryBuilder::Tree->new( $clause, $parentnode );
+            $lastnode->getParent()->setNodeValue($ea);
+
+            ( $ea, $key, $op, $value ) = ( "", "", "", "" );
+        }
+
+        $last = $current;
+    }    # while
+
+    push @actions, [ loc("Incomplete query"), -1 ]
+      unless ( ( $want | PAREN ) || ( $want | KEYWORD ) );
+
+    push @actions, [ loc("Incomplete Query"), -1 ]
+      unless ( $last && ( $last | PAREN ) || ( $last || VALUE ) );
+
+    # This will never happen, because the parser will complain
+    push @actions, [ loc("Mismatched parentheses"), -1 ]
+      unless $depth == 1;
+};
+
 my $tree;
-ParseQuery( $Query, \$tree, \@actions );
+$ParseQuery->( $Query, \$tree, \@actions );
 
 # if parsing went poorly, send them to the edit page to fix it
 if ( $actions[0] ) {
@@ -465,202 +656,6 @@
 
 
 
-use Regexp::Common qw /delimited/;
-
-# States
-use constant VALUE   => 1;
-use constant AGGREG  => 2;
-use constant OP      => 4;
-use constant PAREN   => 8;
-use constant KEYWORD => 16;
-
-sub ParseQuery {
-    my $string  = shift;
-    my $tree    = shift;
-    my @actions = shift;
-    my $want    = KEYWORD | PAREN;
-    my $last    = undef;
-
-    my $depth = 1;
-
-    # make a tree root
-    $$tree = RT::Interface::Web::QueryBuilder::Tree->new;
-    my $root       = RT::Interface::Web::QueryBuilder::Tree->new( 'AND', $$tree );
-    my $lastnode   = $root;
-    my $parentnode = $root;
-
-    # get the FIELDS from Tickets_Overlay
-    my $tickets = new RT::Tickets( $session{'CurrentUser'} );
-    my %FIELDS  = %{ $tickets->FIELDS };
-
-    # Lower Case version of FIELDS, for case insensitivity
-    my %lcfields = map { ( lc($_) => $_ ) } ( keys %FIELDS );
-
-    my @tokens     = qw[VALUE AGGREG OP PAREN KEYWORD];
-    my $re_aggreg  = qr[(?i:AND|OR)];
-    my $re_value   = qr[$RE{delimited}{-delim=>qq{\'\"}}|\d+];
-    my $re_keyword = qr[$RE{delimited}{-delim=>qq{\'\"}}|(?:\{|\}|\w|\.)+];
-    my $re_op      =
-      qr[=|!=|>=|<=|>|<|(?i:IS NOT)|(?i:IS)|(?i:NOT LIKE)|(?i:LIKE)]
-      ;    # long to short
-    my $re_paren = qr'\(|\)';
-
-    # assume that $ea is AND if it is not set
-    my ( $ea, $key, $op, $value ) = ( "AND", "", "", "" );
-
-    # order of matches in the RE is important.. op should come early,
-    # because it has spaces in it.  otherwise "NOT LIKE" might be parsed
-    # as a keyword or value.
-
-    while (
-        $string =~ /(
-                      $re_aggreg
-                      |$re_op
-                      |$re_keyword
-                      |$re_value
-                      |$re_paren
-                     )/igx
-      )
-    {
-        my $val     = $1;
-        my $current = 0;
-
-        # Highest priority is last
-        $current = OP    if _match( $re_op,    $val );
-        $current = VALUE if _match( $re_value, $val );
-        $current = KEYWORD
-          if _match( $re_keyword, $val ) && ( $want & KEYWORD );
-        $current = AGGREG if _match( $re_aggreg, $val );
-        $current = PAREN  if _match( $re_paren,  $val );
-
-        unless ( $current && $want & $current ) {
-
-            # Error
-            # FIXME: I will only print out the highest $want value
-            my $token = $tokens[ ( ( log $want ) / ( log 2 ) ) ];
-            push @actions,
-              [
-                loc(
-"current: $current, want $want, Error near ->$val<- expecting a "
-                      . $token
-                      . " in '$string'\n"
-                ),
-                -1
-              ];
-        }
-
-        # State Machine:
-        my $parentdepth = $depth;
-
-        # Parens are highest priority
-        if ( $current & PAREN ) {
-            if ( $val eq "(" ) {
-                $depth++;
-
-                # make a new node that the clauses can be children of
-                $parentnode = RT::Interface::Web::QueryBuilder::Tree->new( $ea, $parentnode );
-            }
-            else {
-                $depth--;
-                $parentnode = $parentnode->getParent();
-                $lastnode   = $parentnode;
-            }
-
-            $want = KEYWORD | PAREN | AGGREG;
-        }
-        elsif ( $current & AGGREG ) {
-            $ea   = $val;
-            $want = KEYWORD | PAREN;
-        }
-        elsif ( $current & KEYWORD ) {
-            $key  = $val;
-            $want = OP;
-        }
-        elsif ( $current & OP ) {
-            $op   = $val;
-            $want = VALUE;
-        }
-        elsif ( $current & VALUE ) {
-            $value = $val;
-
-            # Remove surrounding quotes from $key, $val
-            # (in future, simplify as for($key,$val) { action on $_ })
-            if ( $key =~ /$RE{delimited}{-delim=>qq{\'\"}}/ ) {
-                substr( $key, 0,  1 ) = "";
-                substr( $key, -1, 1 ) = "";
-            }
-            if ( $val =~ /$RE{delimited}{-delim=>qq{\'\"}}/ ) {
-                substr( $val, 0,  1 ) = "";
-                substr( $val, -1, 1 ) = "";
-            }
-
-            # Unescape escaped characters
-            $key =~ s!\\(.)!$1!g;
-            $val =~ s!\\(.)!$1!g;
-
-            my $class;
-            if ( exists $lcfields{ lc $key } ) {
-                $key   = $lcfields{ lc $key };
-                $class = $FIELDS{$key}->[0];
-            }
-            if ( $class ne 'INT' ) {
-                $val = "'$val'";
-            }
-
-            push @actions, [ loc("Unknown field: $key"), -1 ] unless $class;
-
-            $want = PAREN | AGGREG;
-        }
-        else {
-            push @actions, [ loc("I'm lost"), -1 ];
-        }
-
-        if ( $current & VALUE ) {
-            if ( $key =~ /^CF./ ) {
-                $key = "'" . $key . "'";
-            }
-            my $clause = {
-                Key   => $key,
-                Op    => $op,
-                Value => $val
-            };
-
-            # explicity add a child to it
-            $lastnode = RT::Interface::Web::QueryBuilder::Tree->new( $clause, $parentnode );
-            $lastnode->getParent()->setNodeValue($ea);
-
-            ( $ea, $key, $op, $value ) = ( "", "", "", "" );
-        }
-
-        $last = $current;
-    }    # while
-
-    push @actions, [ loc("Incomplete query"), -1 ]
-      unless ( ( $want | PAREN ) || ( $want | KEYWORD ) );
-
-    push @actions, [ loc("Incomplete Query"), -1 ]
-      unless ( $last && ( $last | PAREN ) || ( $last || VALUE ) );
-
-    # This will never happen, because the parser will complain
-    push @actions, [ loc("Mismatched parentheses"), -1 ]
-      unless $depth == 1;
-}
-
-sub _match {
-
-    # Case insensitive equality
-    my ( $y, $x ) = @_;
-    return 1 if $x =~ /^$y$/i;
-
-    #  return 1 if ((lc $x) eq (lc $y)); # Why isnt this equiv?
-    return 0;
-}
-
-sub debug {
-    my $message = shift;
-    $m->print( $message . "<br>" );
-}
-
 # }}}
 
 # }}}

Modified: rt/branches/QUEBEC-EXPERIMENTAL/lib/RT/Tickets_Overlay.pm
==============================================================================
--- rt/branches/QUEBEC-EXPERIMENTAL/lib/RT/Tickets_Overlay.pm	(original)
+++ rt/branches/QUEBEC-EXPERIMENTAL/lib/RT/Tickets_Overlay.pm	Wed Oct  5 14:35:57 2005
@@ -2616,7 +2616,7 @@
         }
         else {
             $sql = $self->ClausesToSQL($clauseRef);
-            $self->FromSQL($sql);
+            $self->FromSQL($sql) if $sql;
         }
     }
 
@@ -2709,6 +2709,15 @@
 
 =cut
 
+=begin testing
+
+# We assume that we've got some tickets hanging around from before.
+ok( my $unlimittickets = RT::Tickets->new( $RT::SystemUser ) );
+ok( $unlimittickets->UnLimit );
+ok( $unlimittickets->Count > 0, "UnLimited tickets object should return tickets" );
+
+=end testing
+
 1;
 
 


More information about the Rt-commit mailing list