testx.pl

#!/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;

my $grammar;
my $recce;

my $dsl = <<'END_OF_DSL';

:start ::= formula

:default ::= action => ::array

:discard ~ ws

formula               ::= '*IF' <condition>

<condition>              ::= <basic_condition>

<basic_condition>     ::= '*VALUE' <attribute> <comparison> <compare_string>  action => do_basic


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


<attribute>              ::= id '.' id
                           | id

<compare_string> ::=   <literal_word>

<alpha>              ~ [A-Za-z%*]

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

<id>                ~ <alpha><alphanump>

<literal_word> ~ [\S]+

ws             ~ [\s]+

END_OF_DSL

#$DB::single=2;
$grammar = Marpa::R2::Scanless::G->new({ source => \$dsl,});
#$DB::single=2;

my $ipdt = "*IF *VALUE i5OS_IOA_Cache_Battery.State *EQ Error";

   $recce = Marpa::R2::Scanless::R->new(
        { grammar => $grammar,
          semantics_package => 'My_Actions',
          trace_terminals => 1,
          trace_values => 1,
        });
$DB::single=2;
   $recce->read( \$ipdt );
$DB::single=2;
   my $value_ref = $recce->value;
   my $value = $value_ref ? ${$value_ref} : 'No Parse';
   my $progress_report = $recce->show_progress( 0, -1 );

exit 0;

sub My_Actions::do_basic {
    my ( undef, $t1, $t2, $t3, $t4 ) = @_;
#$DB::single=2;
    my $pt1 = $t1; $pt1 = join(" ",@{$t1}) if ref($t1) eq 'ARRAY';
    my $pt2 = $t2; $pt2 = join(" ",@{$t2}) if ref($t2) eq 'ARRAY';
    my $pt3 = $t3; $pt3 = join(" ",@{$t3}) if ref($t3) eq 'ARRAY';
    my $pt4 = $t4; $pt4 = join(" ",@{$t4}) if ref($t4) eq 'ARRAY';
    check_table($$t2[0]);
    print "My_Actions::do_basic: 1[$pt1] 2[$pt2] 3[$pt3] 4[$pt4]\n";
    return undef;
}