Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
best-practical
rt-extension-commandbymail
Commits
d127842c
Commit
d127842c
authored
May 28, 2009
by
Kevin Falcone
Browse files
upgrade Module::Install
parent
44838161
Changes
12
Hide whitespace changes
Inline
Side-by-side
inc/Module/AutoInstall.pm
View file @
d127842c
...
...
@@ -18,7 +18,9 @@ my %FeatureMap = (
# various lexical flags
my
(
@Missing
,
@Existing
,
%DisabledTests
,
$UnderCPAN
,
$HasCPANPLUS
);
my
(
$Config
,
$CheckOnly
,
$SkipInstall
,
$AcceptDefault
,
$TestOnly
);
my
(
$Config
,
$CheckOnly
,
$SkipInstall
,
$AcceptDefault
,
$TestOnly
,
$AllDeps
);
my
(
$PostambleActions
,
$PostambleUsed
);
# See if it's a testing or non-interactive session
...
...
@@ -73,6 +75,9 @@ sub _init {
elsif
(
$arg
=~
/^--test(?:only)?$/
)
{
$TestOnly
=
1
;
}
elsif
(
$arg
=~
/^--all(?:deps)?$/
)
{
$AllDeps
=
1
;
}
}
}
...
...
@@ -115,6 +120,13 @@ sub import {
)[
0
]
);
# We want to know if we're under CPAN early to avoid prompting, but
# if we aren't going to try and install anything anyway then skip the
# check entirely since we don't want to have to load (and configure)
# an old CPAN just for a cosmetic message
$UnderCPAN
=
_check_lock
(
1
)
unless
$SkipInstall
;
while
(
my
(
$feature
,
$modules
)
=
splice
(
@args
,
0
,
2
)
)
{
my
(
@required
,
@tests
,
@skiptests
);
my
$default
=
1
;
...
...
@@ -163,15 +175,24 @@ sub import {
}
# XXX: check for conflicts and uninstalls(!) them.
if
(
defined
(
my
$cur
=
_version_check
(
_load
(
$mod
),
$arg
||=
0
)
)
)
my
$cur
=
_load
(
$mod
);
if
(
_version_cmp
(
$cur
,
$arg
)
>=
0
)
{
print
"
loaded. (
$cur
"
.
(
$arg
?
"
>=
$arg
"
:
''
)
.
"
)
\n
";
push
@Existing
,
$mod
=>
$arg
;
$DisabledTests
{
$_
}
=
1
for
map
{
glob
(
$_
)
}
@skiptests
;
}
else
{
print
"
missing.
"
.
(
$arg
?
"
(would need
$arg
)
"
:
''
)
.
"
\n
";
if
(
not
defined
$cur
)
# indeed missing
{
print
"
missing.
"
.
(
$arg
?
"
(would need
$arg
)
"
:
''
)
.
"
\n
";
}
else
{
# no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
print
"
too old. (
$cur
<
$arg
)
\n
";
}
push
@required
,
$mod
=>
$arg
;
}
}
...
...
@@ -184,6 +205,8 @@ sub import {
!
$SkipInstall
and
(
$CheckOnly
or
(
$mandatory
and
$UnderCPAN
)
or
$AllDeps
or
_prompt
(
qq{==> Auto-install the }
.
(
@required
/
2
)
...
...
@@ -214,8 +237,6 @@ sub import {
}
}
$UnderCPAN
=
_check_lock
();
# check for $UnderCPAN
if
(
@Missing
and
not
(
$CheckOnly
or
$UnderCPAN
)
)
{
require
Config
;
print
...
...
@@ -234,21 +255,38 @@ sub import {
*
{'
main::WriteMakefile
'}
=
\
&Write
if
caller
(
0
)
eq
'
main
';
}
sub
_running_under
{
my
$thing
=
shift
;
print
<<"END_MESSAGE";
*** Since we're running under ${thing}, I'll just let it take care
of the dependency's installation later.
END_MESSAGE
return
1
;
}
# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
# if we are, then we simply let it taking care of our dependencies
sub
_check_lock
{
return
unless
@Missing
;
return
unless
@Missing
or
@_
;
my
$cpan_env
=
$ENV
{
PERL5_CPAN_IS_RUNNING
};
if
(
$ENV
{
PERL5_CPANPLUS_IS_RUNNING
})
{
print
<<'END_MESSAGE';
return
_running_under
(
$cpan_env
?
'
CPAN
'
:
'
CPANPLUS
');
}
*** Since we're running under CPANPLUS, I'll just let it take care
of the dependency's installation later.
END_MESSAGE
return
1
;
require
CPAN
;
if
(
$
CPAN::
VERSION
>
'
1.89
')
{
if
(
$cpan_env
)
{
return
_running_under
('
CPAN
');
}
return
;
# CPAN.pm new enough, don't need to check further
}
_load_cpan
();
# last ditch attempt, this -will- configure CPAN, very sorry
_load_cpan
(
1
);
# force initialize even though it's already loaded
# Find the CPAN lock-file
my
$lock
=
MM
->
catfile
(
$
CPAN::
Config
->
{
cpan_home
},
"
.lock
"
);
...
...
@@ -284,7 +322,7 @@ sub install {
while
(
my
(
$pkg
,
$ver
)
=
splice
(
@
_
,
0
,
2
)
)
{
# grep out those already installed
if
(
defined
(
_version_c
heck
(
_load
(
$pkg
),
$ver
)
)
)
{
if
(
_version_c
mp
(
_load
(
$pkg
),
$ver
)
>=
0
)
{
push
@installed
,
$pkg
;
}
else
{
...
...
@@ -313,7 +351,7 @@ sub install {
@modules
=
@newmod
;
}
if
(
_has_cpanplus
()
)
{
if
(
_has_cpanplus
()
and
not
$ENV
{
PERL_AUTOINSTALL_PREFER_CPAN
}
)
{
_install_cpanplus
(
\
@modules
,
\
@config
);
}
else
{
_install_cpan
(
\
@modules
,
\
@config
);
...
...
@@ -323,7 +361,7 @@ sub install {
# see if we have successfully installed them
while
(
my
(
$pkg
,
$ver
)
=
splice
(
@modules
,
0
,
2
)
)
{
if
(
defined
(
_version_c
heck
(
_load
(
$pkg
),
$ver
)
)
)
{
if
(
_version_c
mp
(
_load
(
$pkg
),
$ver
)
>=
0
)
{
push
@installed
,
$pkg
;
}
elsif
(
$args
{
do_once
}
and
open
(
FAILED
,
'
>> .#autoinstall.failed
'
)
)
{
...
...
@@ -378,7 +416,7 @@ sub _install_cpanplus {
my
$success
;
my
$obj
=
$modtree
->
{
$pkg
};
if
(
$obj
and
defined
(
_version_c
heck
(
$obj
->
{
version
},
$ver
)
)
)
{
if
(
$obj
and
_version_c
mp
(
$obj
->
{
version
},
$ver
)
>=
0
)
{
my
$pathname
=
$pkg
;
$pathname
=~
s/::/\\W/
;
...
...
@@ -471,7 +509,7 @@ sub _install_cpan {
my
$obj
=
CPAN::
Shell
->
expand
(
Module
=>
$pkg
);
my
$success
=
0
;
if
(
$obj
and
defined
(
_version_c
heck
(
$obj
->
cpan_version
,
$ver
)
)
)
{
if
(
$obj
and
_version_c
mp
(
$obj
->
cpan_version
,
$ver
)
>=
0
)
{
my
$pathname
=
$pkg
;
$pathname
=~
s/::/\\W/
;
...
...
@@ -535,7 +573,7 @@ sub _update_to {
my
$ver
=
shift
;
return
if
defined
(
_version_c
heck
(
_load
(
$class
),
$ver
)
)
;
# no need to upgrade
if
_version_c
mp
(
_load
(
$class
),
$ver
)
>=
0
;
# no need to upgrade
if
(
_prompt
(
"
==> A newer version of
$class
(
$ver
) is required. Install?
",
...
...
@@ -632,7 +670,7 @@ sub _load {
# Load CPAN.pm and it's configuration
sub
_load_cpan
{
return
if
$
CPAN::
VERSION
;
return
if
$
CPAN::
VERSION
and
$
CPAN::
Config
and
not
@_
;
require
CPAN
;
if
(
$
CPAN::HandleConfig::
VERSION
)
{
# Newer versions of CPAN have a HandleConfig module
...
...
@@ -644,9 +682,11 @@ sub _load_cpan {
}
# compare two versions, either use Sort::Versions or plain comparison
sub
_version_check
{
# return values same as <=>
sub
_version_cmp
{
my
(
$cur
,
$min
)
=
@_
;
return
unless
defined
$cur
;
return
-
1
unless
defined
$cur
;
# if 0 keep comparing
return
1
unless
$min
;
$cur
=~
s/\s+$//
;
...
...
@@ -657,16 +697,13 @@ sub _version_check {
)
{
# use version.pm if it is installed.
return
(
(
version
->
new
(
$cur
)
>=
version
->
new
(
$min
)
)
?
$cur
:
undef
);
return
version
->
new
(
$cur
)
<=>
version
->
new
(
$min
);
}
elsif
(
$
Sort::Versions::
VERSION
or
defined
(
_load
('
Sort::Versions
')
)
)
{
# use Sort::Versions as the sorting algorithm for a.b.c versions
return
(
(
Sort::Versions::
versioncmp
(
$cur
,
$min
)
!=
-
1
)
?
$cur
:
undef
);
return
Sort::Versions::
versioncmp
(
$cur
,
$min
);
}
warn
"
Cannot reliably compare non-decimal formatted versions.
\n
"
...
...
@@ -675,7 +712,7 @@ sub _version_check {
# plain comparison
local
$^W
=
0
;
# shuts off 'not numeric' bugs
return
(
$cur
>
=
$min
?
$cur
:
undef
)
;
return
$cur
<=
>
$min
;
}
# nothing; this usage is deprecated.
...
...
@@ -706,7 +743,7 @@ sub _make_args {
if
$Config
;
$PostambleActions
=
(
$missing
(
$missing
and
not
$UnderCPAN
)
?
"
\$
(PERL) $0 --config=
$config
--installdeps=
$missing
"
:
"
\$
(NOECHO)
\$
(NOOP)
"
);
...
...
@@ -746,7 +783,7 @@ sub Write {
sub
postamble
{
$PostambleUsed
=
1
;
return
<<
"
.
";
return
<<
"END_MAKE
";
config :: installdeps
\t\$(NOECHO) \$(NOOP)
...
...
@@ -757,7 +794,7 @@ checkdeps ::
installdeps ::
\t$PostambleActions
.
END_MAKE
}
...
...
@@ -765,4 +802,4 @@ installdeps ::
__END__
#line 10
03
#line 10
56
inc/Module/Install.pm
View file @
d127842c
...
...
@@ -17,12 +17,10 @@ package Module::Install;
# 3. The ./inc/ version of Module::Install loads
# }
BEGIN
{
require
5.004
;
}
use
5.005
;
use
strict
'
vars
';
use
vars
qw{$VERSION}
;
use
vars
qw{$VERSION
$MAIN
}
;
BEGIN
{
# All Module::Install core packages now require synchronised versions.
# This will be used to ensure we don't accidentally load old or
...
...
@@ -30,7 +28,14 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
$VERSION
=
'
0.70
';
$VERSION
=
'
0.91
';
# Storage for the pseudo-singleton
$MAIN
=
undef
;
*
inc::Module::Install::
VERSION
=
*VERSION
;
@
inc::Module::Install::
ISA
=
__PACKAGE__
;
}
...
...
@@ -65,15 +70,26 @@ END_DIE
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
if
(
-
f
$
0
and
(
stat
(
$
0
))[
9
]
>
time
)
{
die
<<
"
END_DIE
"
}
if
(
-
f
$
0
)
{
my
$s
=
(
stat
(
$
0
))[
9
];
# If the modification time is only slightly in the future,
# sleep briefly to remove the problem.
my
$a
=
$s
-
time
;
if
(
$a
>
0
and
$a
<
5
)
{
sleep
5
}
Your
installer
$
0
has
a
modification
time
in
the
future
.
# Too far in the future, throw an error.
my
$t
=
time
;
if
(
$s
>
$t
)
{
die
<<
"
END_DIE
"
}
Your
installer
$
0
has
a
modification
time
in
the
future
(
$s
>
$t
)
.
This
is
known
to
create
infinite
loops
in
make
.
Please
correct
this
,
then
run
$
0
again
.
END_DIE
}
...
...
@@ -81,7 +97,7 @@ END_DIE
# Build.PL was formerly supported, but no longer is due to excessive
# difficulty in implementing every single feature twice.
if
(
$
0
=~
/Build.PL$/i
or
-
f
'
Build.PL
'
)
{
die
<<
"
END_DIE
"
}
if
(
$
0
=~
/Build.PL$/i
)
{
die
<<
"
END_DIE
"
}
Module::
Install
no
longer
supports
Build
.
PL
.
...
...
@@ -95,14 +111,20 @@ END_DIE
# To save some more typing in Module::Install installers, every...
# use inc::Module::Install
# ...also acts as an implicit use strict.
$^H
|=
strict::
bits
(
qw(refs subs vars)
);
use
Cwd
();
use
File::
Find
();
use
File::
Path
();
use
FindBin
;
*
inc::Module::Install::
VERSION
=
*VERSION
;
@
inc::Module::Install::
ISA
=
__PACKAGE__
;
sub
autoload
{
my
$self
=
shift
;
my
$who
=
$self
->
_caller
;
...
...
@@ -111,12 +133,22 @@ sub autoload {
$sym
->
{
$cwd
}
=
sub
{
my
$pwd
=
Cwd::
cwd
();
if
(
my
$code
=
$sym
->
{
$pwd
}
)
{
#
d
elegate back to parent dirs
#
D
elegate back to parent dirs
goto
&$code
unless
$cwd
eq
$pwd
;
}
$$sym
=~
/([^:]+)$/
or
die
"
Cannot autoload
$who
-
$sym
";
my
$method
=
$
1
;
if
(
uc
(
$method
)
eq
$method
)
{
# Do nothing
return
;
}
elsif
(
$method
=~
/^_/
and
$self
->
can
(
$method
)
)
{
# Dispatch to the root M:I class
return
$self
->
$method
(
@
_
);
}
# Dispatch to the appropriate plugin
unshift
@
_
,
(
$self
,
$
1
);
goto
&
{
$self
->
can
('
call
')}
unless
uc
(
$
1
)
eq
$
1
;
goto
&
{
$self
->
can
('
call
')};
};
}
...
...
@@ -141,12 +173,14 @@ sub import {
delete
$INC
{"
$self
->{file}
"};
delete
$INC
{"
$self
->{path}.pm
"};
# Save to the singleton
$MAIN
=
$self
;
return
1
;
}
sub
preload
{
my
(
$self
)
=
@_
;
my
$self
=
shift
;
unless
(
$self
->
{
extensions
}
)
{
$self
->
load_extensions
(
"
$self
->{prefix}/
$self
->{path}
",
$self
...
...
@@ -155,8 +189,7 @@ sub preload {
my
@exts
=
@
{
$self
->
{
extensions
}};
unless
(
@exts
)
{
my
$admin
=
$self
->
{
admin
};
@exts
=
$admin
->
load_all_extensions
;
@exts
=
$self
->
{
admin
}
->
load_all_extensions
;
}
my
%seen
;
...
...
@@ -202,6 +235,7 @@ sub new {
$args
{
path
}
=~
s!::!/!g
;
}
$args
{
file
}
||=
"
$args
{base}/
$args
{prefix}/
$args
{path}.pm
";
$args
{
wrote
}
=
0
;
bless
(
\
%args
,
$class
);
}
...
...
@@ -238,7 +272,7 @@ END_DIE
sub
load_extensions
{
my
(
$self
,
$path
,
$top
)
=
@_
;
unless
(
grep
{
lc
$_
eq
lc
$self
->
{
prefix
}
}
@INC
)
{
unless
(
grep
{
!
ref
$_
and
lc
$_
eq
lc
$self
->
{
prefix
}
}
@INC
)
{
unshift
@INC
,
$self
->
{
prefix
};
}
...
...
@@ -277,9 +311,9 @@ sub find_extensions {
# correctly. Otherwise, root through the file to locate the case-preserved
# version of the package name.
if
(
$subpath
eq
lc
(
$subpath
)
||
$subpath
eq
uc
(
$subpath
)
)
{
open
PKGFILE
,
"
<
$subpath
.pm
"
or
die
"
find_extensions: Can't open
$subpath
.pm: $!
"
;
my
$in_pod
=
0
;
while
(
<
PKGFILE
>
)
{
my
$content
=
Module::Install::
_read
(
$subpath
.
'
.pm
')
;
my
$in_pod
=
0
;
foreach
(
split
//
,
$content
)
{
$in_pod
=
1
if
/^=\w/
;
$in_pod
=
0
if
/^=cut/
;
next
if
(
$in_pod
||
/^=cut/
);
# skip pod text
...
...
@@ -289,7 +323,6 @@ sub find_extensions {
last
;
}
}
close
PKGFILE
;
}
push
@found
,
[
$file
,
$pkg
];
...
...
@@ -298,6 +331,13 @@ sub find_extensions {
@found
;
}
#####################################################################
# Common Utility Functions
sub
_caller
{
my
$depth
=
0
;
my
$call
=
caller
(
$depth
);
...
...
@@ -308,6 +348,83 @@ sub _caller {
return
$call
;
}
sub
_read
{
local
*FH
;
if
(
$]
>=
5.006
)
{
open
(
FH
,
'
<
',
$_
[
0
]
)
or
die
"
open(
$_
[0]): $!
";
}
else
{
open
(
FH
,
"
<
$_
[0]
"
)
or
die
"
open(
$_
[0]): $!
";
}
my
$string
=
do
{
local
$/
;
<
FH
>
};
close
FH
or
die
"
close(
$_
[0]): $!
";
return
$string
;
}
sub
_readperl
{
my
$string
=
Module::Install::
_read
(
$_
[
0
]);
$string
=~
s/(?:\015{1,2}\012|\015|\012)/\n/sg
;
$string
=~
s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s
;
$string
=~
s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg
;
return
$string
;
}
sub
_readpod
{
my
$string
=
Module::Install::
_read
(
$_
[
0
]);
$string
=~
s/(?:\015{1,2}\012|\015|\012)/\n/sg
;
return
$string
if
$_
[
0
]
=~
/\.pod\z/
;
$string
=~
s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg
;
$string
=~
s/\n*=pod\b[^\n]*\n+/\n\n/sg
;
$string
=~
s/\n*=cut\b[^\n]*\n+/\n\n/sg
;
$string
=~
s/^\n+//s
;
return
$string
;
}
sub
_write
{
local
*FH
;
if
(
$]
>=
5.006
)
{
open
(
FH
,
'
>
',
$_
[
0
]
)
or
die
"
open(
$_
[0]): $!
";
}
else
{
open
(
FH
,
"
>
$_
[0]
"
)
or
die
"
open(
$_
[0]): $!
";
}
foreach
(
1
..
$
#_ ) {
print
FH
$_
[
$_
]
or
die
"
print(
$_
[0]): $!
";
}
close
FH
or
die
"
close(
$_
[0]): $!
";
}
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub
_version
($)
{
my
$s
=
shift
||
0
;
my
$d
=
()
=
$s
=~
/(\.)/g
;
if
(
$d
>=
2
)
{
# Normalise multipart versions
$s
=~
s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/
eg
;
}
$s
=~
s/^(\d+)\.?//
;
my
$l
=
$
1
||
0
;
my
@v
=
map
{
$_
.
'
0
'
x
(
3
-
length
$_
)
}
$s
=~
/(\d{1,3})\D?/g
;
$l
=
$l
.
'
.
'
.
join
'',
@v
if
@v
;
return
$l
+
0
;
}
sub
_cmp
($$)
{
_version
(
$_
[
0
])
<=>
_version
(
$_
[
1
]);
}
# Cloned from Params::Util::_CLASS
sub
_CLASS
($)
{
(
defined
$_
[
0
]
and
!
ref
$_
[
0
]
and
$_
[
0
]
=~
m/^[^\W\d]\w*(?:::\w+)*\z/s
)
?
$_
[
0
]
:
undef
;
}
1
;
# Copyright 2008 Adam Kennedy.
# Copyright 2008
- 2009
Adam Kennedy.
inc/Module/Install/AutoInstall.pm
View file @
d127842c
...
...
@@ -2,13 +2,13 @@
package
Module::Install::
AutoInstall
;
use
strict
;
use
Module::Install::
Base
;
use
Module::Install::
Base
()
;
use
vars
qw{$VERSION $ISCORE
@ISA
}
;
use
vars
qw{$VERSION
@ISA
$ISCORE}
;
BEGIN
{
$VERSION
=
'
0.68
';
$VERSION
=
'
0.91
';
@ISA
=
'
Module::Install::Base
';
$ISCORE
=
1
;
@ISA
=
qw{Module::Install::Base}
;
}
sub
AutoInstall
{
$_
[
0
]
}
...
...
inc/Module/Install/Base.pm
View file @
d127842c
#line 1
package
Module::Install::
Base
;
$VERSION
=
'
0.70
';
use
strict
'
vars
';
use
vars
qw{$VERSION}
;
BEGIN
{
$VERSION
=
'
0.91
';
}
# Suspend handler for "redefined" warnings
BEGIN
{
...
...
@@ -9,52 +13,56 @@ BEGIN {
$SIG
{
__WARN__
}
=
sub
{
$w
};
}
### This is the ONLY module that shouldn't have strict on
# use strict;
#line 41
#line 42
sub
new
{
my
(
$class
,
%args
)
=
@_
;
foreach
my
$method
(
qw(call load)
)
{
*
{"
$class
\
::
$method
"}
=
sub
{
shift
()
->
_top
->
$method
(
@
_
);
}
unless
defined
&
{"
$class
\
::
$method
"};
}
bless
(
\
%args
,
$class
);
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
;
}
#line 61
sub
AUTOLOAD
{
my
$self
=
shift
;
local
$@
;
my
$autoload
=
eval
{
$self
->
_top
->
autoload
}
or
return
;
goto
&$autoload
;
local
$@
;
my
$func
=
eval
{
shift
->
_top
->
autoload
}
or
return
;
goto
&$func
;
}
#line 7
6
#line 7
5
sub
_top
{
$_
[
0
]
->
{
_top
}
}
sub
_top
{
$_
[
0
]
->
{
_top
};
}
#line
8
9
#line 9
0
sub
admin
{
$_
[
0
]
->
_top
->
{
admin
}
or
Module::Install::Base::
FakeAdmin
->
new
;
$_
[
0
]
->
_top
->
{
admin
}
or
Module::Install::Base::
FakeAdmin
->
new
;
}
#line 106
sub
is_admin
{