view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

    # This will be used to ensure we don't accidentally load old or
    # different versions of modules.
    # This is not enforced yet, but will be some time in the next few
    # releases once we can make sure it won't clash with custom
    # Module::Install extensions.
    $VERSION = '0.64';
}

# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) {
    die <<"END_DIE";
Please invoke ${\__PACKAGE__} with:

    use inc::${\__PACKAGE__};

not:

    use ${\__PACKAGE__};

END_DIE
}

# If the script that is loading Module::Install is from the future,
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
if ( -f $0 and (stat($0))[9] > time ) {
	die << "END_DIE";
Your installer $0 has a modification time in the future.

This is known to create infinite loops in make.

Please correct this, then run $0 again.

END_DIE
}

use Cwd        ();
use File::Find ();
use File::Path ();
use FindBin;

*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA     = __PACKAGE__;

sub autoload {
    my $self = shift;
    my $who  = $self->_caller;
    my $cwd  = Cwd::cwd();
    my $sym  = "${who}::AUTOLOAD";
    $sym->{$cwd} = sub {
        my $pwd = Cwd::cwd();
        if ( my $code = $sym->{$pwd} ) {
            # delegate back to parent dirs
            goto &$code unless $cwd eq $pwd;
        }
        $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
        unshift @_, ($self, $1);
        goto &{$self->can('call')} unless uc($1) eq $1;
    };
}

sub import {
    my $class = shift;
    my $self  = $class->new(@_);
    my $who   = $self->_caller;

    unless ( -f $self->{file} ) {
        require "$self->{path}/$self->{dispatch}.pm";
        File::Path::mkpath("$self->{prefix}/$self->{author}");
        $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
        $self->{admin}->init;
        @_ = ($class, _self => $self);
        goto &{"$self->{name}::import"};
    }

    *{"${who}::AUTOLOAD"} = $self->autoload;
    $self->preload;

    # Unregister loader and worker packages so subdirs can use them again
    delete $INC{"$self->{file}"};
    delete $INC{"$self->{path}.pm"};
}

sub preload {
    my ($self) = @_;

    unless ( $self->{extensions} ) {
        $self->load_extensions(
            "$self->{prefix}/$self->{path}", $self
        );
    }

    my @exts = @{$self->{extensions}};
    unless ( @exts ) {
        my $admin = $self->{admin};
        @exts = $admin->load_all_extensions;
    }

    my %seen;
    foreach my $obj ( @exts ) {
        while (my ($method, $glob) = each %{ref($obj) . '::'}) {
            next unless $obj->can($method);
            next if $method =~ /^_/;
            next if $method eq uc($method);
            $seen{$method}++;
        }
    }

    my $who = $self->_caller;
    foreach my $name ( sort keys %seen ) {
        *{"${who}::$name"} = sub {
            ${"${who}::AUTOLOAD"} = "${who}::$name";
            goto &{"${who}::AUTOLOAD"};