File Coverage

blib/lib/Fennec/Util.pm

Criterion	Covered	Total	%
statement	51	54	94.4
branch	15	22	68.1
condition	7	15	46.6
subroutine	17	18	94.4
pod	4	10	40.0
total	94	119	78.9

package Fennec::Util;
use strict;
use warnings;
use Exporter::Declare;
use Carp qw/croak/;
use Scalar::Util qw/blessed/;

exports qw{
    inject_sub accessors get_test_call require_module verbose_message
};

sub inject_sub {
    my ( $package, $name, $code ) = @_;
    croak "inject_sub() takes a package, a name, and a coderef"
        unless $package
        && $name
        && $code
        && $code =~ /CODE/;

    no strict 'refs';
    *{"$package\::$name"} = $code;
}

sub accessors {
    my $caller = caller;
    _accessor( $caller, $_ ) for @_;
}

sub require_module {
    my $module = shift;

    # Is it defined?
    croak "No module specified"
        unless defined $module;

    # Is the caller using utf8?
    require utf8;
    my $with_utf8 = ( caller(0) )[8] & $utf8::hint_bits;

    # Are Unicode package names ok?
    my $check =
        $with_utf8
        ? qr{\A [[:alpha:]_] [[:word:]]*    (?: :: [[:word:]]+ )* \z}x
        : qr{\A [A-Z_a-z]    [0-9A-Z_a-z]*  (?: :: [0-9A-Z_a-z]+  )* \z}x;

    # Is it a syntactically valid module name?
    croak "Invalid Module '$module'"
        unless $module =~ $check;

    # Transform to a pm file path
    my $file = $module;
    $file .= ".pm";
    $file =~ s{::}{/}g;

    # What were we doing again?
    return require $file;
}

sub _accessor {
    my ( $caller, $attribute ) = @_;
    inject_sub(
        $caller,
        $attribute,
        sub {
            my $self = shift;
            croak "$attribute() called on '$self' instead of an instance"
                unless blessed($self);
            ( $self->{$attribute} ) = @_ if @_;
            return $self->{$attribute};
        }
    );
}

sub get_test_call {
    my $runner;
    my $i = 1;

    while ( my @call = caller( $i++ ) ) {
        $runner = \@call if !$runner && $call[0]->isa('Fennec::Runner');
        return @call if $call[0]->can('FENNEC');
    }

    return ( $runner ? @$runner : ( "UNKNOWN", "UNKNOWN", 0 ) );
}

sub verbose_message {
    return
        if $ENV{HARNESS_ACTIVE}
        && !$ENV{HARNESS_IS_VERBOSE};

    # Do not print the messages on syntax check
    return if $^C;

    print @_;
}

sub tb_ok         { Test::Builder->new->ok(@_) }
sub tb_diag       { Test::Builder->new->diag(@_) }
sub tb_skip       { Test::Builder->new->skip(@_) }
sub tb_todo_start { Test::Builder->new->todo_start(@_) }
sub tb_todo_end   { Test::Builder->new->todo_end }

1;

__END__