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

jesse at bestpractical.com jesse at bestpractical.com
Wed Oct 5 14:50:08 EDT 2005


Author: jesse
Date: Wed Oct  5 14:50:07 2005
New Revision: 3918

Modified:
   rt/branches/CHALDEA-EXPERIMENTAL/   (props changed)
   rt/branches/CHALDEA-EXPERIMENTAL/html/Search/Build.html
   rt/branches/CHALDEA-EXPERIMENTAL/lib/RT/Tickets_Overlay.pm
Log:
 r17070 at hualien:  jesse | 2005-10-05 10:39:31 -0400
  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/CHALDEA-EXPERIMENTAL/html/Search/Build.html
==============================================================================
--- rt/branches/CHALDEA-EXPERIMENTAL/html/Search/Build.html	(original)
+++ rt/branches/CHALDEA-EXPERIMENTAL/html/Search/Build.html	Wed Oct  5 14:50:07 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/CHALDEA-EXPERIMENTAL/lib/RT/Tickets_Overlay.pm
==============================================================================
--- rt/branches/CHALDEA-EXPERIMENTAL/lib/RT/Tickets_Overlay.pm	(original)
+++ rt/branches/CHALDEA-EXPERIMENTAL/lib/RT/Tickets_Overlay.pm	Wed Oct  5 14:50:07 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