File Coverage

blib/lib/Test/LocalFunctions/Fast.pm

Criterion	Covered	Total	%
statement	53	54	98.1
branch	8	12	66.6
condition	4	5	80.0
subroutine	12	12	100.0
pod	2	3	66.6
total	79	86	91.8

package Test::LocalFunctions::Fast;

use strict;
use warnings;
use Test::LocalFunctions::Util;
use Test::LocalFunctions::Receptor;
use parent qw/Test::Builder::Module/;

BEGIN {
    eval { require Compiler::Lexer };
    if ($@) {
        $ENV{TEST_LOCALFUNCTIONS_TEST_PHASE} or die $@;
    }
}

our @EXPORT = qw/all_local_functions_ok local_functions_ok/;

use constant _VERBOSE => ( $ENV{TEST_VERBOSE} || 0 );

sub all_local_functions_ok {
    my ($args) = @_;
    return Test::LocalFunctions::Receptor::all_local_functions_ok( __PACKAGE__, $args );
}

sub local_functions_ok {
    my ( $lib, $args ) = @_;
    return Test::LocalFunctions::Receptor::local_functions_ok( __PACKAGE__, $lib, $args );
}

sub is_in_use {
    my ( undef, $builder, $file, $args ) = @_;

    my $ignore_functions = $args->{ignore_functions};
    my $module           = Test::LocalFunctions::Util::extract_module_name($file);
    my @local_functions  = Test::LocalFunctions::Util::list_local_functions($module);
    my @tokens           = _fetch_tokens($file);

    my $fail = 0;
    LOCAL_FUNCTION: for my $local_function (@local_functions) {
        for my $token (@tokens) {
            next LOCAL_FUNCTION if ( $token->{data} eq $local_function );
        }

        unless ( grep { $local_function =~ $_ } @$ignore_functions ) {
            $builder->diag("Test::LocalFunctions failed: '$local_function' is not used.");
            $fail++;
        }
    }

    return $fail;
}

sub _fetch_tokens {
    my $file = shift;

    open( my $fh, '<', $file ) or die("Can not open the file: $!");
    my $code   = do { local $/; <$fh> };
    my $lexer  = Compiler::Lexer->new($file);
    my @tokens = grep { _remove_tokens($_) } @{$lexer->tokenize($code)};
    close($fh);

    return @tokens;
}

sub _remove_tokens {
    my $token = shift;

    return 1 if ( $token->{name} eq 'Key' || $token->{name} eq 'Call' );
    return 0;
}
1;
__END__