File Coverage

blib/lib/filename.pm

Criterion	Covered	Total	%
statement	28	29	96.5
branch	11	16	68.7
condition	3	9	33.3
subroutine	6	6	100.0
pod	1	1	100.0
total	49	61	80.3

use strict;
use warnings;

use locale;    # localize $!

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


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


our $VERSION = 'v0.20.010'; # VERSION



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($!); # $! is invalid if $INC{$filename} is true.

    $@ && 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__