#!perl -w
use strict;
my $grammar  = <<'';
%%
greeting : hi  | hello ;
farewell : bye | goodbye ;
%%

# create two parsers with same grammar, different start rules
my $g_parser = MyParser->new($grammar,'greeting');
my $f_parser = MyParser->new($grammar,'farewell');

die if $g_parser->parse('bye');            # 'bye' is not a greeting
die if $f_parser->parse('hi');             # 'hi' is not a farewell
print "ok!\n" if  $g_parser->parse('hi');  # 'hi' is a greeting
print "ok!\n" if  $f_parser->parse('bye'); # 'bye' is a farewell

package MyParser;
use Parse::Yapp;
sub new {
    my ($class,$grammar,$start,$debug)=@_;
    %Parser:: = () if defined %Parser::;
    if ($start){
        $grammar =~ s/^%start.*$/%start $start/m
        or $grammar =~ s/^(%%\n)/%start $start\n$1/m;
    }
    my $py = new Parse::Yapp(input => $grammar);
    eval $py->Output;
    die "ERROR IN GRAMMAR\n$@\n" if $@;
    return bless {parser => new Parser, debug => $debug}, $class;
}
sub lexer {
    for(shift->YYData->{INPUT}) { s/^(\S+)// and return($1,$1) }
}
sub parse {
    my $self   = shift;
    my $parser = $self->{parser};
    $parser->YYData->{INPUT}=shift;
    my $rv = $parser->YYParse
       ( yylex   => \&lexer
       , yyerror => sub{}           # we just need a yes or no
       , yydebug => $self->{debug}  # set this to 0x0F for a good time
       );
    return undef if $parser->YYNberr;
    return $rv;
}
__END__
[download]