File Coverage

blib/lib/Module/Install/Base.pm

Criterion	Covered	Total	%
statement	25	35	71.4
branch	2	8	25.0
condition	0	2	0.0
subroutine	8	18	44.4
pod	3	3	100.0
total	38	66	57.5

package Module::Install::Base;

use strict 'vars';
use vars qw{$VERSION};
BEGIN {
	$VERSION = '1.18';
}

# Suspend handler for "redefined" warnings
BEGIN {
	my $w = $SIG{__WARN__};
	$SIG{__WARN__} = sub { $w };
}

=pod

=head1 NAME

Module::Install::Base - Base class for Module::Install extensions

=head1 SYNOPSIS

In a B extension:

    use Module::Install::Base ();
    @ISA = qw(Module::Install::Base);

=head1 DESCRIPTION

This module provide essential methods for all B
extensions, in particular the common constructor C and method
dispatcher C.

=head1 METHODS

=over 4

=item new(%args)

Constructor -- need to preserve at least _top

=cut

sub new {
	my $class = shift;
	unless ( defined &{"${class}::call"} ) {
		*{"${class}::call"} = sub { shift->_top->call(@_) };
	}
	unless ( defined &{"${class}::load"} ) {
		*{"${class}::load"} = sub { shift->_top->load(@_) };
	}
	bless { @_ }, $class;
}

=pod

=item AUTOLOAD

The main dispatcher - copy extensions if missing

=cut

sub AUTOLOAD {
	local $@;
	my $func = eval { shift->_top->autoload } or return;
	goto &$func;
}

=pod

=item _top()

Returns the top-level B object.

=cut

sub _top {
	$_[0]->{_top};
}

=pod

=item admin()

Returns the C<_top> object's associated B object
on the first run (i.e. when there was no F when the program
started); on subsequent (user-side) runs, returns a fake admin object
with an empty C method that does nothing at all.

=cut

sub admin {
	$_[0]->_top->{admin}
	or
	Module::Install::Base::FakeAdmin->new;
}

=pod

=item is_admin()

Tells whether this is the first run of the installer (on
author's side). That is when there was no F at
program start. True if that's the case. False, otherwise.

=cut

sub is_admin {
	! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
}

sub DESTROY {}

package Module::Install::Base::FakeAdmin;

use vars qw{$VERSION};
BEGIN {
	$VERSION = $Module::Install::Base::VERSION;
}

my $fake;

sub new {
	$fake ||= bless(\@_, $_[0]);
}

sub AUTOLOAD {}

sub DESTROY {}

# Restore warning handler
BEGIN {
	$SIG{__WARN__} = $SIG{__WARN__}->();
}

1;

=pod

=back

=head1 SEE ALSO

L

=head1 AUTHORS

Audrey Tang [e-mail]

=head1 COPYRIGHT

Copyright 2003, 2004 by Audrey Tang [e-mail].

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

See L

=cut