view release on metacpan or  search on metacpan

lib/Acme/require/case.pm  view on Meta::CPAN

use Path::Tiny qw/path/;
use Scalar::Util qw/isvstring/;
use Sub::Uplevel qw/uplevel/;
use version 0.87;

sub require_casely {
    my ($filename) = @_;
    my ( $realfilename, $result, $valid, $actual );

    # Are we checking a version number?
    if ( _looks_like_version($filename) ) {
        my $v = eval { version->new($filename) };
        croak $@ if $@;
        croak "Perl @{[$v->normal]} required--this is only $^V, stopped"
          if $v > $^V;
        return 1;
    }

    # Is it already loaded?
    if ( exists $INC{$filename} ) {
        return 1 if $INC{$filename};

lib/Acme/require/case.pm  view on Meta::CPAN

                }
            }
        }
        croak "Can't locate $filename in \@INC (\@INC contains @INC)"
          unless $actual;
    }

    # Valid case or invalid?
    if ($valid) {
        $INC{$filename} = $realfilename;
        # uplevel so calling package looks right
        my $caller = caller(0);
        # deletes $realfilename from %INC after loading it since that's
        # just a proxy for $filename, which is already set above
        my $code = qq{
            package $caller; sub { local %^H; my \$r = do \$_[0]; delete \$INC{\$_[0]}; \$r }
          };
        my $packaged_do = eval $code; ## no critic
        $result = uplevel( 2, $packaged_do, $realfilename );
    }
    else {

lib/Acme/require/case.pm  view on Meta::CPAN

        }
        else {
            $valid = 0;
            my ($actual) = grep { lc $p eq lc $_ } map { $_->basename } $search->children;
            $search = $search->child($actual);
        }
    }
    return ( $valid, $search->relative($prefix) );
}

sub _looks_like_version {
    my ($v) = @_;
    return 1 if isvstring($v);
    return B::svref_2object( \$v )->FLAGS & ( B::SVp_NOK | B::SVp_IOK );
}

*CORE::GLOBAL::require = \&require_casely;

1;