view release on metacpan or  search on metacpan

local/lib/perl5/Module/Install/Admin.pm  view on Meta::CPAN

where C<$some_obj> is the singleton object of a class under the
C<Module::Install::Admin::*> namespace that provides the method
C<some_method>.  See L</METHODS> for a list of built-in methods.

=head1 DESCRIPTION

This module implements the internal mechanism for initializing,
including and managing extensions, and should only be of interest to
extension developers; it is I<never> included under a distribution's
F<inc/> directory, nor are any of the B<Module::Install::Admin::*>
extensions.

For normal usage of B<Module::Install>, please see L<Module::Install>
and L<Module::Install/"COOKBOOK / EXAMPLES"> instead.

=head2 Bootstrapping

When someone runs a F<Makefile.PL> that has C<use inc::Module::Install>,
and there is no F<inc/> in the current directory, B<Module::Install>
will load this module bootstrap itself, through the steps below:

=over 4

=item *

First, F<Module/Install.pm> is POD-stripped and copied from C<@INC> to
F<inc/>.  This should only happen on the author's side, never on the
end-user side.

=item *

Reload F<inc/Module/Install.pm> if the current file is somewhere else.
This ensures that the included version of F<inc/Module/Install.pm> is
always preferred over the installed version.

=item *

Look at F<inc/Module/Install/*.pm> and load all of them.

=item *

Set up a C<main::AUTOLOAD> function to delegate missing function calls
to C<Module::Install::Admin::load> -- again, this should only happen
at the author's side.

=item *

Provide a C<Module::Install::purge_self> function for removing included
files under F<inc/>.

=back

=head1 METHODS

=cut

sub import {
	my $class = shift;
	my $self  = $class->new( _top => Module::Install->new, @_ );
	local $^W;
	*{caller(0) . "::AUTOLOAD"} = sub {
		no strict 'vars';
		$AUTOLOAD =~ /([^:]+)$/ or die "Cannot load";
		return if uc($1) eq $1;
		my $obj = $self->load($1) or return;
		unshift @_, $obj;
		goto &{$obj->can($1)};
	};
}

sub new {
	my ($class, %args) = @_;
	return $class->SUPER::new(
		%{$args{_top}}, %args,
		extensions  => undef,
		pathnames   => undef,
	);
}

sub init {
	my $self = shift;
	$self->copy($INC{"$self->{path}.pm"} => $self->{file});

	unless ( grep { $_ eq $self->{prefix} } @INC ) {
		unshift @INC, $self->{prefix};
	}
 	delete $INC{"$self->{path}.pm"};

	local $^W;
	do "$self->{path}.pm";
}

sub copy {
	my ($self, $from, $to) = @_;

	my @parts = split('/', $to);
	File::Path::mkpath([ join('/', @parts[ 0 .. $#parts-1 ])]);

	chomp $to;

	local ($_);
	open my $FROM, "<", $from or die "Can't open $from for input:\n$!";
	open my $TO,   ">", $to   or die "Can't open $to for output:\n$!";
	binmode $FROM;
	binmode $TO;
	print $TO "#line 1\n";

	my $content;
	my $in_pod;

	while ( <$FROM> ) {
		if ( /^=(?:b(?:egin|ack)|head\d|(?:po|en)d|item|(?:ove|fo)r)/ ) {
			$in_pod = 1;
		} elsif ( /^=cut\s*\z/ and $in_pod ) {
			$in_pod = 0;
			print $TO "#line $.\n";
		} elsif ( ! $in_pod ) {
			print $TO $_;
		}
	}