« back to all changes in this revision
Viewing changes to inc/Module/Install.pm
- browse files at revision 8
- compare with another revision
- download diff
- download tarball
- view history from revision 8
- Committer: Package Import Robot
- Author(s): Xavier Guimard, Nathan Handler, Ansgar Burchardt, gregor herrmann, Xavier Guimard
- Date: 2012-12-14 22:30:58 UTC
- mfrom: (1.1.5) (2.1.4 sid)
- Revision ID: package-import@ubuntu.com-20121214223058-c4nkl0tjko2m6che
Tags: 0.12-1
[ Nathan Handler ]
* debian/watch: Update to ignore development releases.
* Email change: Nathan Handler -> nhandler@debian.org
[ Ansgar Burchardt ]
* debian/control: Convert Vcs-* fields to Git.
[ gregor herrmann ]
* debian/control: update {versioned,alternative} (build) dependencies.
* Improve long description. Thanks to Martin Eberhard Schauer for the
bug report, and Russ Allbery and Justin B Rye for their linguistic
help. (Closes: #695036)
* Remove unused ${shlibs:Depends} from Depends.
[ Xavier Guimard ]
* Imported Upstream version 0.12
* Update source format to 3.0 (quilt)
* Bump Standards-Version to 3.9.4
* Use debhelper 8
* Update debian/copyright (years and format)
* Update debian/rules to use dh
* debian/watch: Update to ignore development releases.
* Email change: Nathan Handler -> nhandler@debian.org
[ Ansgar Burchardt ]
* debian/control: Convert Vcs-* fields to Git.
[ gregor herrmann ]
* debian/control: update {versioned,alternative} (build) dependencies.
* Improve long description. Thanks to Martin Eberhard Schauer for the
bug report, and Russ Allbery and Justin B Rye for their linguistic
help. (Closes: #695036)
* Remove unused ${shlibs:Depends} from Depends.
[ Xavier Guimard ]
* Imported Upstream version 0.12
* Update source format to 3.0 (quilt)
* Bump Standards-Version to 3.9.4
* Use debhelper 8
* Update debian/copyright (years and format)
* Update debian/rules to use dh
- files added:
- .pc
- debian/source
- files modified:
- ChangeLog
added
removed
inc/Module/Install.pm
19
19
20
20
use 5.005;
21
21
use strict 'vars';
22
use Cwd ();
23
use File::Find ();
24
use File::Path ();
22
25
23
26
use vars qw{$VERSION $MAIN};
24
27
BEGIN {
28
31
# This is not enforced yet, but will be some time in the next few
29
32
# releases once we can make sure it won't clash with custom
30
33
# Module::Install extensions.
31
$VERSION = '0.91';
34
$VERSION = '1.06';
32
35
33
36
# Storage for the pseudo-singleton
34
37
$MAIN = undef;
38
41
39
42
}
40
43
41
42
43
44
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" }
44
sub import {
45
my $class = shift;
46
my $self = $class->new(@_);
47
my $who = $self->_caller;
48
49
#-------------------------------------------------------------
50
# all of the following checks should be included in import(),
51
# to allow "eval 'require Module::Install; 1' to test
52
# installation of Module::Install. (RT #51267)
53
#-------------------------------------------------------------
54
55
# Whether or not inc::Module::Install is actually loaded, the
56
# $INC{inc/Module/Install.pm} is what will still get set as long as
57
# the caller loaded module this in the documented manner.
58
# If not set, the caller may NOT have loaded the bundled version, and thus
59
# they may not have a MI version that works with the Makefile.PL. This would
60
# result in false errors or unexpected behaviour. And we don't want that.
61
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
62
unless ( $INC{$file} ) { die <<"END_DIE" }
53
63
54
64
Please invoke ${\__PACKAGE__} with:
55
65
61
71
62
72
END_DIE
63
73
64
65
66
67
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.
73
if ( -f $0 ) {
74
my $s = (stat($0))[9];
75
76
# If the modification time is only slightly in the future,
77
# sleep briefly to remove the problem.
78
my $a = $s - time;
79
if ( $a > 0 and $a < 5 ) { sleep 5 }
80
81
# Too far in the future, throw an error.
82
my $t = time;
83
if ( $s > $t ) { die <<"END_DIE" }
74
# This reportedly fixes a rare Win32 UTC file time issue, but
75
# as this is a non-cross-platform XS module not in the core,
76
# we shouldn't really depend on it. See RT #24194 for detail.
77
# (Also, this module only supports Perl 5.6 and above).
78
eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
79
80
# If the script that is loading Module::Install is from the future,
81
# then make will detect this and cause it to re-run over and over
82
# again. This is bad. Rather than taking action to touch it (which
83
# is unreliable on some platforms and requires write permissions)
84
# for now we should catch this and refuse to run.
85
if ( -f $0 ) {
86
my $s = (stat($0))[9];
87
88
# If the modification time is only slightly in the future,
89
# sleep briefly to remove the problem.
90
my $a = $s - time;
91
if ( $a > 0 and $a < 5 ) { sleep 5 }
92
93
# Too far in the future, throw an error.
94
my $t = time;
95
if ( $s > $t ) { die <<"END_DIE" }
84
96
85
97
Your installer $0 has a modification time in the future ($s > $t).
86
98
89
101
Please correct this, then run $0 again.
90
102
91
103
END_DIE
92
}
93
94
95
96
97
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" }
104
}
105
106
107
# Build.PL was formerly supported, but no longer is due to excessive
108
# difficulty in implementing every single feature twice.
109
if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
101
110
102
111
Module::Install no longer supports Build.PL.
103
112
107
116
108
117
END_DIE
109
118
110
111
112
113
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));
118
119
120
121
122
123
use Cwd ();
124
use File::Find ();
125
use File::Path ();
126
use FindBin;
119
#-------------------------------------------------------------
120
121
# To save some more typing in Module::Install installers, every...
122
# use inc::Module::Install
123
# ...also acts as an implicit use strict.
124
$^H |= strict::bits(qw(refs subs vars));
125
126
#-------------------------------------------------------------
127
128
unless ( -f $self->{file} ) {
129
foreach my $key (keys %INC) {
130
delete $INC{$key} if $key =~ /Module\/Install/;
131
}
132
133
local $^W;
134
require "$self->{path}/$self->{dispatch}.pm";
135
File::Path::mkpath("$self->{prefix}/$self->{author}");
136
$self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
137
$self->{admin}->init;
138
@_ = ($class, _self => $self);
139
goto &{"$self->{name}::import"};
140
}
141
142
local $^W;
143
*{"${who}::AUTOLOAD"} = $self->autoload;
144
$self->preload;
145
146
# Unregister loader and worker packages so subdirs can use them again
147
delete $INC{'inc/Module/Install.pm'};
148
delete $INC{'Module/Install.pm'};
149
150
# Save to the singleton
151
$MAIN = $self;
152
153
return 1;
154
}
127
155
128
156
sub autoload {
129
157
my $self = shift;
136
164
# Delegate back to parent dirs
137
165
goto &$code unless $cwd eq $pwd;
138
166
}
139
$$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
167
unless ($$sym =~ s/([^:]+)$//) {
168
# XXX: it looks like we can't retrieve the missing function
169
# via $$sym (usually $main::AUTOLOAD) in this case.
170
# I'm still wondering if we should slurp Makefile.PL to
171
# get some context or not ...
172
my ($package, $file, $line) = caller;
173
die <<"EOT";
174
Unknown function is found at $file line $line.
175
Execution of $file aborted due to runtime errors.
176
177
If you're a contributor to a project, you may need to install
178
some Module::Install extensions from CPAN (or other repository).
179
If you're a user of a module, please contact the author.
180
EOT
181
}
140
182
my $method = $1;
141
183
if ( uc($method) eq $method ) {
142
184
# Do nothing
152
194
};
153
195
}
154
196
155
sub import {
156
my $class = shift;
157
my $self = $class->new(@_);
158
my $who = $self->_caller;
159
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"};
167
}
168
169
*{"${who}::AUTOLOAD"} = $self->autoload;
170
$self->preload;
171
172
# Unregister loader and worker packages so subdirs can use them again
173
delete $INC{"$self->{file}"};
174
delete $INC{"$self->{path}.pm"};
175
176
# Save to the singleton
177
$MAIN = $self;
178
179
return 1;
180
}
181
182
197
sub preload {
183
198
my $self = shift;
184
199
unless ( $self->{extensions} ) {
204
219
205
220
my $who = $self->_caller;
206
221
foreach my $name ( sort keys %seen ) {
222
local $^W;
207
223
*{"${who}::$name"} = sub {
208
224
${"${who}::AUTOLOAD"} = "${who}::$name";
209
225
goto &{"${who}::AUTOLOAD"};
214
230
sub new {
215
231
my ($class, %args) = @_;
216
232
233
delete $INC{'FindBin.pm'};
234
{
235
# to suppress the redefine warning
236
local $SIG{__WARN__} = sub {};
237
require FindBin;
238
}
239
217
240
# ignore the prefix on extension modules built from top level.
218
241
my $base_path = Cwd::abs_path($FindBin::Bin);
219
242
unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
220
243
delete $args{prefix};
221
244
}
222
223
245
return $args{_self} if $args{_self};
224
246
225
247
$args{dispatch} ||= 'Admin';
272
294
sub load_extensions {
273
295
my ($self, $path, $top) = @_;
274
296
297
my $should_reload = 0;
275
298
unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
276
299
unshift @INC, $self->{prefix};
300
$should_reload = 1;
277
301
}
278
302
279
303
foreach my $rv ( $self->find_extensions($path) ) {
281
305
next if $self->{pathnames}{$pkg};
282
306
283
307
local $@;
284
my $new = eval { require $file; $pkg->can('new') };
308
my $new = eval { local $^W; require $file; $pkg->can('new') };
285
309
unless ( $new ) {
286
310
warn $@ if $@;
287
311
next;
288
312
}
289
$self->{pathnames}{$pkg} = delete $INC{$file};
313
$self->{pathnames}{$pkg} =
314
$should_reload ? delete $INC{$file} : $INC{$file};
290
315
push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
291
316
}
292
317
348
373
return $call;
349
374
}
350
375
351
sub _read {
352
local *FH;
353
if ( $] >= 5.006 ) {
354
open( FH, '<', $_[0] ) or die "open($_[0]): $!";
355
} else {
356
open( FH, "< $_[0]" ) or die "open($_[0]): $!";
357
}
358
my $string = do { local $/; <FH> };
359
close FH or die "close($_[0]): $!";
360
return $string;
361
}
376
# Done in evals to avoid confusing Perl::MinimumVersion
377
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
378
sub _read {
379
local *FH;
380
open( FH, '<', $_[0] ) or die "open($_[0]): $!";
381
my $string = do { local $/; <FH> };
382
close FH or die "close($_[0]): $!";
383
return $string;
384
}
385
END_NEW
386
sub _read {
387
local *FH;
388
open( FH, "< $_[0]" ) or die "open($_[0]): $!";
389
my $string = do { local $/; <FH> };
390
close FH or die "close($_[0]): $!";
391
return $string;
392
}
393
END_OLD
362
394
363
395
sub _readperl {
364
396
my $string = Module::Install::_read($_[0]);
379
411
return $string;
380
412
}
381
413
382
sub _write {
383
local *FH;
384
if ( $] >= 5.006 ) {
385
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
386
} else {
387
open( FH, "> $_[0]" ) or die "open($_[0]): $!";
388
}
389
foreach ( 1 .. $#_ ) {
390
print FH $_[$_] or die "print($_[0]): $!";
391
}
392
close FH or die "close($_[0]): $!";
393
}
414
# Done in evals to avoid confusing Perl::MinimumVersion
415
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
416
sub _write {
417
local *FH;
418
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
419
foreach ( 1 .. $#_ ) {
420
print FH $_[$_] or die "print($_[0]): $!";
421
}
422
close FH or die "close($_[0]): $!";
423
}
424
END_NEW
425
sub _write {
426
local *FH;
427
open( FH, "> $_[0]" ) or die "open($_[0]): $!";
428
foreach ( 1 .. $#_ ) {
429
print FH $_[$_] or die "print($_[0]): $!";
430
}
431
close FH or die "close($_[0]): $!";
432
}
433
END_OLD
394
434
395
435
# _version is for processing module versions (eg, 1.03_05) not
396
436
# Perl versions (eg, 5.8.1).
411
451
}
412
452
413
453
sub _cmp ($$) {
414
_version($_[0]) <=> _version($_[1]);
454
_version($_[1]) <=> _version($_[2]);
415
455
}
416
456
417
457
# Cloned from Params::Util::_CLASS
427
467
428
468
1;
429
469
430
# Copyright 2008 - 2009 Adam Kennedy.
470
# Copyright 2008 - 2012 Adam Kennedy.
Loggerhead is a web-based interface for Breezy
Version: 2.0.1