File Coverage

blib/lib/Test/Count.pm

Criterion	Covered	Total	%
statement	55	56	98.2
branch	19	22	86.3
condition	2	3	66.6
subroutine	9	9	100.0
pod	1	1	100.0
total	86	91	94.5

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

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

use Test::Count::Parser ();

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

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

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

sub _init
{
    my $self = shift;
    my $args = shift;

    my $in;

    if ( exists( $args->{'filename'} ) )
    {
        $self->_filename( $args->{'filename'} );
        open $in, "<:raw", $self->_filename()
            or die "Could not open '" . $self->_filename() . "' - $!.";
    }
    else
    {
        $in = $args->{'input_fh'};
    }

    $self->_in_fh($in);
    if ( exists( $args->{'assert_prefix_regex'} ) )
    {
        my $re = $args->{'assert_prefix_regex'};
        $self->_assert_prefix_regex( ( ref($re) eq "" ) ? qr{$re} : $re );
    }
    else
    {
        $self->_assert_prefix_regex(qr{# TEST});
    }

    return 0;
}


sub process
{
    my $self = shift;
    my $args = shift;

    my $parser = $args->{parser} || Test::Count::Parser->new();

    $parser->_push_current_filename( $self->_filename );

    my $assert_re = $self->_assert_prefix_regex();

    my @file_lines = readline( $self->_in_fh() );
    close( $self->_in_fh() );

    foreach my $idx ( 0 .. $#file_lines )
    {
        my $line = $file_lines[$idx];

        chomp($line);
        if ( $line =~ /${assert_re}:(.*)$/ )
        {
            $parser->update_assignments(
                {
                    'text' => $1,
                }
            );
        }

        # The \s* is to handle trailing whitespace properly.
        elsif ( $line =~ /${assert_re}((?:[+*].*)?)\s*$/ )
        {
            my $s = $1;
            $parser->update_count(
                {
                    'text' => ( ( $s eq "" ) ? 1 : substr( $s, 1 ) ),
                }
            );
        }
    }
    $parser->_pop_current_filenames();
    if ( @{ $parser->_parser->{filter_mults} } != 1 )
    {
        die "Unbalanced FILTER() and ENDFILTER().";
    }

    return { 'tests_count' => $parser->get_count(), 'lines' => \@file_lines, };
}


1;    # End of Test::Count

__END__