local-lib5/lib/perl5/Module/Install/Base.pm

   1 package Module::Install::Base;
   2
   3 use strict 'vars';
   4 use vars qw{$VERSION};
   5 BEGIN {
   6         $VERSION = '0.91';
   7 }
   8
   9 # Suspend handler for "redefined" warnings
  10 BEGIN {
  11         my $w = $SIG{__WARN__};
  12         $SIG{__WARN__} = sub { $w };
  13 }
  14
  15 =pod
  16
  17 =head1 NAME
  18
  19 Module::Install::Base - Base class for Module::Install extensions
  20
  21 =head1 SYNOPSIS
  22
  23 In a B<Module::Install> extension:
  24
  25     use Module::Install::Base ();
  26     @ISA = qw(Module::Install::Base);
  27
  28 =head1 DESCRIPTION
  29
  30 This module provide essential methods for all B<Module::Install>
  31 extensions, in particular the common constructor C<new> and method
  32 dispatcher C<AUTOLOAD>.
  33
  34 =head1 METHODS
  35
  36 =over 4
  37
  38 =item new(%args)
  39
  40 Constructor -- need to preserve at least _top
  41
  42 =cut
  43
  44 sub new {
  45         my $class = shift;
  46         unless ( defined &{"${class}::call"} ) {
  47                 *{"${class}::call"} = sub { shift->_top->call(@_) };
  48         }
  49         unless ( defined &{"${class}::load"} ) {
  50                 *{"${class}::load"} = sub { shift->_top->load(@_) };
  51         }
  52         bless { @_ }, $class;
  53 }
  54
  55 =pod
  56
  57 =item AUTOLOAD
  58
  59 The main dispatcher - copy extensions if missing
  60
  61 =cut
  62
  63 sub AUTOLOAD {
  64         local $@;
  65         my $func = eval { shift->_top->autoload } or return;
  66         goto &$func;
  67 }
  68
  69 =pod
  70
  71 =item _top()
  72
  73 Returns the top-level B<Module::Install> object.
  74
  75 =cut
  76
  77 sub _top {
  78         $_[0]->{_top};
  79 }
  80
  81 =pod
  82
  83 =item admin()
  84
  85 Returns the C<_top> object's associated B<Module::Install::Admin> object
  86 on the first run (i.e. when there was no F<inc/> when the program
  87 started); on subsequent (user-side) runs, returns a fake admin object
  88 with an empty C<AUTOLOAD> method that does nothing at all.
  89
  90 =cut
  91
  92 sub admin {
  93         $_[0]->_top->{admin}
  94         or
  95         Module::Install::Base::FakeAdmin->new;
  96 }
  97
  98 =pod
  99
 100 =item is_admin()
 101
 102 Tells whether this is the first run of the installer (on
 103 author's side). That is when there was no F<inc/> at
 104 program start. True if that's the case. False, otherwise.
 105
 106 =cut
 107
 108 sub is_admin {
 109         $_[0]->admin->VERSION;
 110 }
 111
 112 sub DESTROY {}
 113
 114 package Module::Install::Base::FakeAdmin;
 115
 116 my $fake;
 117
 118 sub new {
 119         $fake ||= bless(\@_, $_[0]);
 120 }
 121
 122 sub AUTOLOAD {}
 123
 124 sub DESTROY {}
 125
 126 # Restore warning handler
 127 BEGIN {
 128         $SIG{__WARN__} = $SIG{__WARN__}->();
 129 }
 130
 131 1;
 132
 133 =pod
 134
 135 =back
 136
 137 =head1 SEE ALSO
 138
 139 L<Module::Install>
 140
 141 =head1 AUTHORS
 142
 143 Audrey Tang E<lt>autrijus@autrijus.orgE<gt>
 144
 145 =head1 COPYRIGHT
 146
 147 Copyright 2003, 2004 by Audrey Tang E<lt>autrijus@autrijus.orgE<gt>.
 148
 149 This program is free software; you can redistribute it and/or modify it
 150 under the same terms as Perl itself.
 151
 152 See L<http://www.perl.com/perl/misc/Artistic.html>
 153
 154 =cut