marpa-test7

#!/usr/bin/perl
# Copyright 2012 Jeffrey Kegler
# This file is part of Marpa::R2.  Marpa::R2 is free software: you can
# redistribute it and/or modify it under the terms of the GNU Lesser
# General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# Marpa::R2 is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser
# General Public License along with Marpa::R2.  If not, see
# http://www.gnu.org/licenses/.
# $DB::single=2;   # remember debug breakpoint

use 5.010;
use strict;
use warnings;
use English qw( -no_match_vars );
use Marpa::R2;
use Data::Dumper;               # debug only

my $string;
my $grammar;
my $recce;

my $dsl = <<'END_OF_DSL';

:default ::= action => ::array

:start ::= formula

:discard ~ ws

formula               ::= '*IF' <condition_list>
                              |   '*IF' <condition_list> <until_clause>

<condition_list>        ::=  <condition>
                              |    '(' <condition_list> ')'
                              |    <condition_list> <logical_operator> <condition_list>

<logical_operator>    ::= '*AND' | '*OR'

<condition>              ::= <basic_condition>
                              |   <scalar_condition>
                              |   <missing_condition>
                              |   <str_func_condition>
                              |   <situation_condition>

<basic_condition>     ::= <basic_function> <attribute> <comparison> <literal>   action => do_basic

<basic_function>       ::= '*VALUE' | '*COUNT'

<comparison>          ::= '*EQ' | '*GE' | '*GT' | '*LE' | '*LT' | '*NE'

<literal>                  ::= <quoted_string> | <word> | <number>

<attribute>              ::= id '.' id

<scalar_condition>    ::= <scalar_function> <attribute> <comparison> <number>
                              |   <minmax_function> <attribute> '*EQ' '*TRUE'

<scalar_function>      ::= '*AVG' | '*SUM' | '*CHANGE' | '*PCTCHANGE'

<minmax_function>   ::= '*MIN' | '*MAX'

<missing_condition>   ::= '*MISSING' <attribute> '*EQ' '(' <comma_separated_list> ')'

<comma_separated_list>  ::= <quoted_string>
                                     |   <quoted_string> ',' <comma_separated_list>

<str_func_condition>    ::= '*SCAN' <attribute> <comparison> <quoted_string>
                                 |   '*SCAN' <attribute> <comparison> <word>
                                 |   '*STR' <attribute> <comparison> <str_arg>

<str_arg>                   ::= <number> ',' <word>

<situation_condition>   ::= '*SIT' <situation> '*EQ' '*TRUE'

<situation>                 ::= <id>

<until_clause>             ::= '*UNTIL' '(' <until_condition> ')'

<until_condition>         ::= '*SIT' <situation>
                                 |   '*TTL' <interval>
                                 |   '*SIT' <situation> '*OR' '*TTL' <interval>

<quoted_string>        ~ <single_quoted_string> | <double_quoted_string>

<single_quoted_string> ~ <singlequote> <string_without_single_quote_or_vertical_space> <singlequote>

<double_quoted_string> ~ <doublequote> <string_without_double_quote_or_vertical_space> <doublequote>

<singlequote> ~ [']

<doublequote> ~ ["]

<string_without_single_quote_or_vertical_space> ~ [^']+

<string_without_double_quote_or_vertical_space> ~ [^"]+

<word>                     ~  [\w]+

<digit>                   ~ [\d]

<digits>                   ~ [\d]+

<number>                ~ <digits> | <digits>'.'<digits>

<alpha>              ~ [A-Za-z]

<alphanump>              ~ [A-Za-z0-9_]*

<id>                ~ <alpha><alphanump>

<digit2>            ~ [0-2]

<digit6>            ~ [0-6]

<interval>      ~ <digits>':'<digit2><digit>':'<digit6><digit>':'<digit6><digit>

ws             ~ [\s]+

END_OF_DSL
#
#
#<id>                        ::= [A-Za-z][A-Za-z0-9_]*
#
#<interval>                ::= [0-9]+":"[0-2][0-9]":"[0-6][0-9]":"[0-6][0-9]

#$DB::single=2;
$grammar = Marpa::R2::Scanless::G->new({ source => \$dsl,});
#$DB::single=2;
$recce = Marpa::R2::Scanless::R->new(
        { grammar => $grammar,
          semantics_package => 'My_Actions',
          trace_terminals => 1,
          trace_values => 1,
        });

#$DB::single=2;
#my $input="*IF *VALUE Log_Entries.Log_Name *EQ errlog *AND ( ( ( *SCAN Log_Entries.Description *EQ '857033C6' ) *OR ( *SCAN Log_Entries.Description *EQ '8647C4E2' ) *OR ( *SCAN Log_Entries.Description *EQ '8650BE3F' ) *OR ( *SCAN Log_Entries.Description *EQ '8988389F' ) *OR ( *SCAN Log_Entries.Description *EQ '8C9704CA' ) *OR ( *SCAN Log_Entries.Description *EQ '9A8401BB' ) *OR ( *SCAN Log_Entries.Description *EQ '9E5DCE06' ) *OR ( *SCAN Log_Entries.Description *EQ '9F7B0FA6' ) *OR ( *SCAN Log_Entries.Description *EQ 'AA8D7232' ) *OR ( *SCAN Log_Entries.Description *EQ 'ABED1BA8' ) *OR ( *SCAN Log_Entries.Description *EQ 'AE3E3FAD' ) *OR ( *SCAN Log_Entries.Description *EQ 'B8113DD1' ) *OR ( *SCAN Log_Entries.Description *EQ 'B8FBD189' ) *OR ( *SCAN Log_Entries.Description *EQ 'BA8C5EBE' ) *OR ( *SCAN Log_Entries.Description *EQ 'BCF6612E' ) *OR ( *SCAN Log_Entries.Description *EQ B6DB68E0 ) ) ) *UNTIL ( *TTL 0:06:00:00 )" ;
my $input="*IF *VALUE Log_Entries.Log_Name *EQ errlog ";

#$DB::single=2;
$recce->read( \$input );

#$DB::single=2;
 my $value_ref = $recce->value;
#$DB::single=2;
 my $value = $value_ref ? ${$value_ref} : 'No Parse';
#$DB::single=2;
 my $progress_report = $recce->show_progress( 0, -1 );
$DB::single=2;
exit 0;

sub My_Actions::do_basic {
    my ( undef, $t1, $t2, $t3, $t4 ) = @_;
    if (defined $t1) {
$DB::single=2;
say STDERR Data::Dumper::Dumper(\@_);
    print "My_Actions::do_basic: $t1 $t2 $t3 $t4\n";
                return undef;
    }
}