28
32
# This is not enforced yet, but will be some time in the next few
29
33
# releases once we can make sure it won't clash with custom
30
34
# Module::Install extensions.
33
37
# Storage for the pseudo-singleton
45
# Whether or not inc::Module::Install is actually loaded, the
46
# $INC{inc/Module/Install.pm} is what will still get set as long as
47
# the caller loaded module this in the documented manner.
48
# If not set, the caller may NOT have loaded the bundled version, and thus
49
# they may not have a MI version that works with the Makefile.PL. This would
50
# result in false errors or unexpected behaviour. And we don't want that.
51
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
52
unless ( $INC{$file} ) { die <<"END_DIE" }
47
my $self = $class->new(@_);
48
my $who = $self->_caller;
50
#-------------------------------------------------------------
51
# all of the following checks should be included in import(),
52
# to allow "eval 'require Module::Install; 1' to test
53
# installation of Module::Install. (RT #51267)
54
#-------------------------------------------------------------
56
# Whether or not inc::Module::Install is actually loaded, the
57
# $INC{inc/Module/Install.pm} is what will still get set as long as
58
# the caller loaded module this in the documented manner.
59
# If not set, the caller may NOT have loaded the bundled version, and thus
60
# they may not have a MI version that works with the Makefile.PL. This would
61
# result in false errors or unexpected behaviour. And we don't want that.
62
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
63
unless ( $INC{$file} ) { die <<"END_DIE" }
54
65
Please invoke ${\__PACKAGE__} with:
68
# If the script that is loading Module::Install is from the future,
69
# then make will detect this and cause it to re-run over and over
70
# again. This is bad. Rather than taking action to touch it (which
71
# is unreliable on some platforms and requires write permissions)
72
# for now we should catch this and refuse to run.
74
my $s = (stat($0))[9];
76
# If the modification time is only slightly in the future,
77
# sleep briefly to remove the problem.
79
if ( $a > 0 and $a < 5 ) { sleep 5 }
81
# Too far in the future, throw an error.
83
if ( $s > $t ) { die <<"END_DIE" }
75
# This reportedly fixes a rare Win32 UTC file time issue, but
76
# as this is a non-cross-platform XS module not in the core,
77
# we shouldn't really depend on it. See RT #24194 for detail.
78
# (Also, this module only supports Perl 5.6 and above).
79
eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
81
# If the script that is loading Module::Install is from the future,
82
# then make will detect this and cause it to re-run over and over
83
# again. This is bad. Rather than taking action to touch it (which
84
# is unreliable on some platforms and requires write permissions)
85
# for now we should catch this and refuse to run.
87
my $s = (stat($0))[9];
89
# If the modification time is only slightly in the future,
90
# sleep briefly to remove the problem.
92
if ( $a > 0 and $a < 5 ) { sleep 5 }
94
# Too far in the future, throw an error.
96
if ( $s > $t ) { die <<"END_DIE" }
85
98
Your installer $0 has a modification time in the future ($s > $t).
89
102
Please correct this, then run $0 again.
98
# Build.PL was formerly supported, but no longer is due to excessive
99
# difficulty in implementing every single feature twice.
100
if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
108
# Build.PL was formerly supported, but no longer is due to excessive
109
# difficulty in implementing every single feature twice.
110
if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
102
112
Module::Install no longer supports Build.PL.
114
# To save some more typing in Module::Install installers, every...
115
# use inc::Module::Install
116
# ...also acts as an implicit use strict.
117
$^H |= strict::bits(qw(refs subs vars));
120
#-------------------------------------------------------------
122
# To save some more typing in Module::Install installers, every...
123
# use inc::Module::Install
124
# ...also acts as an implicit use strict.
125
$^H |= strict::bits(qw(refs subs vars));
127
#-------------------------------------------------------------
129
unless ( -f $self->{file} ) {
130
require "$self->{path}/$self->{dispatch}.pm";
131
File::Path::mkpath("$self->{prefix}/$self->{author}");
132
$self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
133
$self->{admin}->init;
134
@_ = ($class, _self => $self);
135
goto &{"$self->{name}::import"};
138
*{"${who}::AUTOLOAD"} = $self->autoload;
141
# Unregister loader and worker packages so subdirs can use them again
142
delete $INC{"$self->{file}"};
143
delete $INC{"$self->{path}.pm"};
145
# Save to the singleton
129
152
my $self = shift;
157
my $self = $class->new(@_);
158
my $who = $self->_caller;
160
unless ( -f $self->{file} ) {
161
require "$self->{path}/$self->{dispatch}.pm";
162
File::Path::mkpath("$self->{prefix}/$self->{author}");
163
$self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
164
$self->{admin}->init;
165
@_ = ($class, _self => $self);
166
goto &{"$self->{name}::import"};
169
*{"${who}::AUTOLOAD"} = $self->autoload;
172
# Unregister loader and worker packages so subdirs can use them again
173
delete $INC{"$self->{file}"};
174
delete $INC{"$self->{path}.pm"};
176
# Save to the singleton
183
179
my $self = shift;
184
180
unless ( $self->{extensions} ) {