File Coverage

blib/lib/Lingua/LinkParser/MatchPath.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Lingua::LinkParser::MatchPath;

use strict;
use Lingua::LinkParser::MatchPath::SM;
use Lingua::LinkParser::MatchPath::Lex;
use Lingua::LinkParser::MatchPath::Parser;

our $VERSION = '0.03';

my $DEBUG;

use fields qw(parser matcher);

sub new {
    my $class = shift;
    my %arg = @_;
    if( ! ref $arg{parser} ){
	require Lingua::LinkParser;
	$arg{parser} = Lingua::LinkParser->new;
    }
    bless { parser => $arg{parser} } => $class;
}

sub create_matcher($$) {
    push @{$_[0]->{matcher}}, path_matcher($_[1], $_[0]->{parser});
}

sub matcher($) { $_[0]->{matcher} }

# parenthesize rules and append a semicolon
sub _preprocess($) {
    my $path = shift;
    $path =~ s/[\s\n]*$//o;
    $path .= ';' unless $path =~ /;$/;
    if($path !~ /^\(.+\);$/o){
	$path =~ s/;$/\);/o;
	$path = '('.$path;
    }
#    print "$path$/";
    $path
}

sub path_matcher($$) {
    my $template = _preprocess shift;
    my $parser = shift;

    my $p = new Lingua::LinkParser::MatchPath::Parser;
    $p->{_sm} = Lingua::LinkParser::MatchPath::SM->new($template);

    my $l = Lingua::LinkParser::MatchPath::Lex->new( debug => $DEBUG );
    $l->load($template);

    $p->YYParse(
		yylex => sub { $l->lex },
		yyerror => sub { die "Syntax error in [ $template ]\n" },
		# yydebug => 0x1F,
		);
    $p->{_sm}->{parser} = $parser;
    $p->{_sm};
}


1;
__END__