Skip to content

Instantly share code, notes, and snippets.

@jalvo2014
Created March 15, 2014 23:31
Show Gist options
  • Save jalvo2014/9575539 to your computer and use it in GitHub Desktop.
Save jalvo2014/9575539 to your computer and use it in GitHub Desktop.
testing action comamnd
#!/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;
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment