File Coverage

blib/lib/filename.pm

Criterion	Covered	Total	%
statement	25	26	96.1
branch	11	16	68.7
condition	3	9	33.3
subroutine	5	5	100.0
pod	1	1	100.0
total	45	57	78.9

use strict;
use warnings;

package filename v0.20.009;
# ABSTRACT: Perl module to load files at compile-time, without BEGIN blocks.


use Carp 1.50  ();
use File::Spec ();


my ( $do, $error ) = ();    # Private subs

# Modified version of the code as specified in `perldoc -f require`
*import = \&require;
sub require {
    eval { $_[0]->isa(__PACKAGE__) } && shift
        || Carp::croak( $_[0], " is not a ", __PACKAGE__ );
    my $filename = @_ ? shift : $_;
    Carp::croak("Null filename used") unless length($filename);

    return $INC{$filename} if ( exists $INC{$filename} );

    if ( File::Spec->file_name_is_absolute($filename) ) {
        goto NOT_INC if $^V < v5.17.0 && !-r $filename;
        return $do->($filename);
    }
    foreach my $inc (@INC) {
        my $prefix = $inc;
        #if ( my $ref = ref($inc) ) {
        #    # TODO ...
        #}
        next unless -f ( my $fullpath = "$prefix/$filename" );
        next if $^V < v5.17.0 && !-r _;
        return $do->( $fullpath => $filename );
    }
    NOT_INC:
        Carp::croak("Can't locate $filename in \@INC (\@INC contains: @INC)");
}

my $do_text = <<'END';
package $pkg;
my $result = do($fullpath);
die $@ if $@;
$INC{$filename} = delete $INC{$fullpath}
    if $filename ne $fullpath && exists $INC{$fullpath};
$result;
END
$do = sub {
    my $fullpath = @_ ? shift : $_;
    my $filename = @_ ? shift : $fullpath;
    my ($pkg)    = caller(2);

    ( my $do_eval = $do_text ) =~ s/\$pkg/$pkg/;
    return eval $do_eval || $error->( $filename => $fullpath );
};

# Private sub
$error = sub {
    my $filename = @_ ? shift : $_;
    my $fullpath = @_ ? shift : $filename;

    $INC{$filename} &&= undef($!);

    $@ && Carp::croak( $@, "Compilation failed in require" );

    $! && Carp::croak(
        "Can't locate $filename:   ",
        $^V >= v5.21.0 ? "$fullpath: " : (),
        "$!"
    );

    Carp::croak( $filename, " did not return a true value" );
};

1;

__END__