view release on metacpan or  search on metacpan

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

#line 1 "inc/Module/Install.pm - /usr/lang/perl/5.8.0/lib/site_perl/5.8.0/Module/Install.pm"
# $File: //depot/cpan/Module-Install/lib/Module/Install.pm $ $Author: autrijus $
# $Revision: #52 $ $Change: 1532 $ $DateTime: 2003/05/20 01:27:31 $ vim: expandtab shiftwidth=4

package Module::Install;
$VERSION = '0.19_99';

die <<END unless defined $INC{'inc/Module/Install.pm'};
You must invoke Module::Install with:

    use inc::Module::Install;

not:

    use Module::Install;

END

use strict 'vars';
use File::Find;
use File::Path;

@inc::Module::Install::ISA = 'Module::Install';

#line 124

sub import {
    my $class = $_[0];
    my $self = $class->new(@_[1..$#_]);

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

    *{caller(0) . "::AUTOLOAD"} = $self->autoload;
}

#line 147

sub autoload {
    my $self = shift;
    my $caller = caller;
    sub {
        ${"$caller\::AUTOLOAD"} =~ /([^:]+)$/ or die "Cannot autoload $caller";
        unshift @_, ($self, $1);
        goto &{$self->can('call')} unless uc($1) eq $1;
    };
}

#line 164

sub new {
    my ($class, %args) = @_;

    return $args{_self} if $args{_self};

    $args{dispatch} ||= 'Admin';
    $args{prefix}   ||= 'inc';
    $args{author}   ||= '.author';
    $args{bundle}   ||= '_bundle';

    $class =~ s/^\Q$args{prefix}\E:://;
    $args{name}     ||= $class;
    $args{version}  ||= $class->VERSION;
    unless ($args{path}) {
        $args{path}   = $args{name};
        $args{path}  =~ s!::!/!g;
    }
    $args{file}     ||= "$args{prefix}/$args{path}.pm";

    bless(\%args, $class);
}

#line 192

sub call {
    my $self   = shift;
    my $method = shift;
    my $obj = $self->load($method) or return;

    unshift @_, $obj;
    goto &{$obj->can($method)};
}

#line 207

sub load {
    my ($self, $method) = @_;

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

    foreach my $obj (@{$self->{extensions}}) {
        return $obj if $obj->can($method);