File Coverage

blib/lib/Test/Count/Parser.pm

Criterion	Covered	Total	%
statement	68	68	100.0
branch	6	6	100.0
condition			n/a
subroutine	17	17	100.0
pod	3	3	100.0
total	94	94	100.0

package Test::Count::Parser;
$Test::Count::Parser::VERSION = '0.1102';
use warnings;
use strict;

use parent 'Test::Count::Base';

use File::Basename (qw(dirname));

use Parse::RecDescent ();


sub _get_grammar
{
    return <<'EOF';
update_count: expression            {$thisparser->{count} += $item[1] * $thisparser->{filter_mults}->[-1]}

assignments:    statement  ';' assignments
              | statement

statement:    assignment
              | expression               {$item [1]}
              | including_file           {$item [1]}
              | start_filter
              | end_filter

start_filter: 'FILTER(MULT(' expression '))' {push @{$thisparser->{filter_mults}}, $thisparser->{filter_mults}->[-1] * $item[2] ; }

end_filter: 'ENDFILTER()' {if (@{$thisparser->{filter_mults}} <= 1) { die "Too many ENDFILTER()s"; } pop @{$thisparser->{filter_mults}}; }

including_file: 'source' string          {push @{$thisparser->{includes}}, $item[2];}

assignment:    variable '=' statement   {$thisparser->{vars}->{$item [1]} = $item [3]}
              | variable '+=' statement   {$thisparser->{vars}->{$item [1]} += $item [3]}
              | variable '-=' statement   {$thisparser->{vars}->{$item [1]} -= $item [3]}
              | variable '*=' statement   {$thisparser->{vars}->{$item [1]} *= $item [3]}

expression:     variable '++'            {$thisparser->{vars}->{$item [1]}++}
              | term '+' expression      {$item [1] + $item [3]}
              | term '-' expression      {$item [1] - $item [3]}
              | term

term:           factor '*' term          {$item [1] * $item [3]}
              | factor '/' term          {int($item [1] / $item [3])}
              | factor

factor:         number
              | variable                 {
                (exists($thisparser->{vars}->{$item [1]})
                    ? $thisparser->{vars}->{$item [1]}
                    : do { die "Undefined variable \"$item[1]\""; } )
                    }
              | '+' factor               {$item [2]}
              | '-' factor               {$item [2] * -1}
              | '(' statement ')'        {$item [2]}

number:         /\d+/                    {$item [1]}

variable:       /\$[a-z_]\w*/i

string:         /"[^"]+"/

EOF
}

sub _calc_parser
{
    my $self = shift;

    my $parser = Parse::RecDescent->new( $self->_get_grammar() );

    $parser->{vars}         = {};
    $parser->{count}        = 0;
    $parser->{includes}     = [];
    $parser->{filter_mults} = [1];

    return $parser;
}

sub _parser
{
    my $self = shift;
    if (@_)
    {
        $self->{'_parser'} = shift;
    }
    return $self->{'_parser'};
}

sub _current_fns
{
    my $self = shift;
    if (@_)
    {
        $self->{'_current_fns'} = shift;
    }
    return $self->{'_current_fns'};
}

sub _init
{
    my $self = shift;

    $self->_current_fns( [] );
    $self->_parser( $self->_calc_parser() );

    return 0;
}


sub _push_current_filename
{
    my $self     = shift;
    my $filename = shift;

    push @{ $self->_current_fns() }, $filename;

    return;
}

sub _pop_current_filenames
{
    my $self     = shift;
    my $filename = shift;

    pop( @{ $self->_current_fns() } );

    return;
}

sub _get_current_filename
{
    my $self = shift;

    return $self->_current_fns->[-1];
}

sub _parse_filename
{
    my $self     = shift;
    my $filename = shift;

    $filename =~ s{\A"}{};
    $filename =~ s{"\z}{};

    my $dirname = dirname( $self->_get_current_filename() );
    $filename =~ s{\$\^CURRENT_DIRNAME}{$dirname}g;

    return $filename;
}

sub update_assignments
{
    my ( $self, $args ) = @_;

    $self->_parser->{includes} = [];
    my $ret = $self->_parser()->assignments( $args->{text} );

    if ( @{ $self->_parser->{includes} } )
    {
        foreach my $include_file ( @{ $self->_parser->{includes} } )
        {
            my $counter = Test::Count->new(
                {
                    filename => $self->_parse_filename($include_file),
                },
            );
            $counter->process( { parser => $self } );
        }
        $self->_parser->{includes} = [];
    }
}


sub update_count
{
    my ( $self, $args ) = @_;

    return $self->_parser()->update_count( $args->{text} );
}


sub get_count
{
    my $self = shift;

    return $self->_parser()->{count};
}


1;    # End of Test::Count::Parser

__END__