|
|
@@ -0,0 +1,165 @@ |
|
|
#!/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'; |
|
|
|
|
|
: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; |
|
|
print "My_Actions::do_basic: $t1 $t2 $t3 $t4\n"; |
|
|
return undef; |
|
|
} |
|
|
} |
|
|
|