[Bps-public-commit] r13031 - Parse-BooleanLogic/lib/Parse

ruz at bestpractical.com ruz at bestpractical.com
Sat Jun 7 15:10:39 EDT 2008


Author: ruz
Date: Sat Jun  7 15:10:29 2008
New Revision: 13031

Modified:
   Parse-BooleanLogic/lib/Parse/BooleanLogic.pm

Log:
* doc updates, new functions, may be don't compile

Modified: Parse-BooleanLogic/lib/Parse/BooleanLogic.pm
==============================================================================
--- Parse-BooleanLogic/lib/Parse/BooleanLogic.pm	(original)
+++ Parse-BooleanLogic/lib/Parse/BooleanLogic.pm	Sat Jun  7 15:10:29 2008
@@ -27,67 +27,9 @@
 it can be used to parse other boolean logic sentences with OPERANDs joined using
 binary OPERATORs and grouped and nested using parentheses (OPEN_PAREN and CLOSE_PAREN).
 
-=head1 METHODS
-
-=head2 as_array
-
-Takes a string and parses it into perl structure, where parentheses represented using
-array references, operands are hash references with one key/value pair: operand,
-when binary operators are simple scalars. So string C<x = 10 OR (x > 20 AND x < 30)>
-is parsed into the following structure:
-
-    [
-        { operand => 'x = 10' },
-        'OR',
-        [
-            { operand => 'x > 20' },
-            'AND',
-            { operand => 'x < 30' },
-        ]
-    ]
-
-=head2 parse
-
-Takes named arguments: string and callback. Where the first one is scalar with
-expression, the latter is a reference to hash with callbacks: open_paren, operator
-operand, close_paren and error. Callback for errors is optional and parser dies if
-it's omitted. Each callback is called when parser finds corresponding element in the
-string. In all cases the current match is passed as argument into the callback.
-
-Here is simple example based on L</as_array> method:
-
-    # result tree and the current group
-    my ($tree, $node);
-    $tree = $node = [];
-
-    # stack with nested groups, outer most in the bottom, inner on the top
-    my @pnodes = ();
-
-    my %callback;
-    # on open_paren put the current group on top of the stack,
-    # create new empty group and at the same time put it into
-    # the end of previous one
-    $callback{'open_paren'} = sub {
-        push @pnodes, $node;
-        push @{ $pnodes[-1] }, $node = []
-    };
-
-    # on close_paren just switch to previous group by taking it
-    # from the top of the stack
-    $callback{'close_paren'}     = sub { $node = pop @pnodes };
-
-    # push binary operators as is and operands as hash references
-    $callback{'operator'} = sub { push @$node, $_[0] };
-    $callback{'operand'}       = sub { push @$node, { operand => $_[0] } };
-
-    # run parser
-    $parser->parse( string => $string, callback => \%callback );
-
-    return $tree;
+=cut
 
-Using this method you can build other representations of an expression.
 
-=cut
 
 use strict;
 use warnings;
@@ -111,11 +53,53 @@
 my $re_delim       = qr{$RE{delimited}{-delim=>qq{\'\"}}};
 my $re_operand     = qr{(?!\s)(?:$re_delim|(?!$re_tokens|["']).+?(?=$re_tokens|["']|\Z))+};
 
+=head1 METHODS
+
+=head2 new
+
+Very simple constructor, returns a new object. Now takes no options and most
+methods can be executed as class methods too, however there are plans to
+change it and using this lightweight constructor is recommended.
+
+=cut
+
 sub new {
     my $proto = shift;
     return bless {@_}, ref($proto) || $proto;
 }
 
+
+=head2 Parsing expressions
+
+=head3 as_array $string [ %options ]
+
+Takes a string and parses it into perl structure, where parentheses represented using
+array references, operands are hash references with one key/value pair: operand,
+when binary operators are simple scalars. So string C<x = 10 OR (x > 20 AND x < 30)>
+is parsed into the following structure:
+
+    [
+        { operand => 'x = 10' },
+        'OR',
+        [
+            { operand => 'x > 20' },
+            'AND',
+            { operand => 'x < 30' },
+        ]
+    ]
+
+Aditional options:
+
+=over 4
+
+=item operand_cb - custom operands handler
+
+=item error_cb - custom errors handler
+
+=back
+
+=cut
+
 { # static variables
 
 my ($tree, $node, @pnodes);
@@ -150,6 +134,49 @@
     return $tree;
 } }
 
+=head3 parse
+
+Takes named arguments: string and callback. Where the first one is scalar with
+expression, the latter is a reference to hash with callbacks: open_paren, operator
+operand, close_paren and error. Callback for errors is optional and parser dies if
+it's omitted. Each callback is called when parser finds corresponding element in the
+string. In all cases the current match is passed as argument into the callback.
+
+Here is simple example based on L</as_array> method:
+
+    # result tree and the current group
+    my ($tree, $node);
+    $tree = $node = [];
+
+    # stack with nested groups, outer most in the bottom, inner on the top
+    my @pnodes = ();
+
+    my %callback;
+    # on open_paren put the current group on top of the stack,
+    # create new empty group and at the same time put it into
+    # the end of previous one
+    $callback{'open_paren'} = sub {
+        push @pnodes, $node;
+        push @{ $pnodes[-1] }, $node = []
+    };
+
+    # on close_paren just switch to previous group by taking it
+    # from the top of the stack
+    $callback{'close_paren'} = sub { $node = pop @pnodes };
+
+    # push binary operators as is and operands as hash references
+    $callback{'operator'} = sub { push @$node, $_[0] };
+    $callback{'operand'}  = sub { push @$node, { operand => $_[0] } };
+
+    # run parser
+    $parser->parse( string => $string, callback => \%callback );
+
+    return $tree;
+
+Using this method you can build other representations of an expression.
+
+=cut
+
 sub parse {
     my $self = shift;
     my %args = (
@@ -246,6 +273,81 @@
     return join ' or ', @res;
 }
 
+=head2 Tree modifications
+
+Several functions taking a tree of boolean expressions as returned by
+as_array method and changing it using a callback.
+
+=head3 filter $tree $callback
+
+Returns sub-tree where only operands left for which the callback returned
+true value.
+
+=cut
+
+sub filter {
+    my ($self, $tree, $cb, $inner) = @_;
+
+    my $skip_next = 0;
+
+    my @res;
+    foreach my $entry ( @$tree ) {
+        next if $skip_next-- > 0;
+
+        if ( ref $entry eq 'ARRAY' ) {
+            my $tmp = $self->filter( $entry, $cb, 1 );
+            if ( !$tmp || (ref $tmp eq 'ARRAY' && !@$tmp) ) {
+                pop @res;
+                $skip_next = 1 unless @res;
+            } else {
+                push @res, $tmp;
+            }
+        } elsif ( ref $entry eq 'HASH' ) {
+            if ( $cb->( $entry ) ) {
+                push @res, $entry;
+            } else {
+                pop @res;
+                $skip_next = 1 unless @res;
+            }
+        } else {
+            push @res, $entry;
+        }
+    }
+    return $res[0] if @res == 1 && ($inner || ref $res[0] eq 'ARRAY');
+    return \@res;
+}
+
+=head3 solve $tree $callback
+
+Returns sub-tree where only operands left for which the callback returned
+true value.
+
+=cut
+
+sub solve {
+    my ($self, $tree, $cb) = @_;
+
+    my $skip_next = 0;
+
+    my ($res, $ea) = (0, 'OR');
+
+    foreach my $entry ( @$tree ) {
+        next if $skip_next-- > 0;
+        unless ( ref $entry ) {
+
+        }
+
+        if ( ref $entry eq 'ARRAY' ) {
+            my $tmp = $self->solve( $entry, $cb, 1 );
+        } elsif ( ref $entry eq 'HASH' ) {
+            my $tmp = $cb->( $entry );
+        } else {
+            push @res, $entry;
+        }
+    }
+    return $res;
+}
+
 1;
 
 =head1 AUTHORS



More information about the Bps-public-commit mailing list