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-formtools
Commits
896e0948
Commit
896e0948
authored
Apr 22, 2011
by
Kevin Falcone
Browse files
Bump version and update MI
parent
9a22f0e9
Changes
10
Expand all
Hide whitespace changes
Inline
Side-by-side
inc/Module/Install.pm
View file @
896e0948
...
...
@@ -17,12 +17,13 @@ package Module::Install;
# 3. The ./inc/ version of Module::Install loads
# }
BEGIN
{
require
5.004
;
}
use
5.005
;
use
strict
'
vars
';
use
Cwd
();
use
File::
Find
();
use
File::
Path
();
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,25 +31,35 @@ 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.78
';
$VERSION
=
'
1.00
';
# Storage for the pseudo-singleton
$MAIN
=
undef
;
*
inc::Module::Install::
VERSION
=
*VERSION
;
@
inc::Module::Install::
ISA
=
__PACKAGE__
;
}
sub
import
{
my
$class
=
shift
;
my
$self
=
$class
->
new
(
@
_
);
my
$who
=
$self
->
_caller
;
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my
$file
=
join
(
'
/
',
'
inc
',
split
/::/
,
__PACKAGE__
)
.
'
.pm
';
unless
(
$INC
{
$file
}
)
{
die
<<
"
END_DIE
"
}
#-------------------------------------------------------------
# all of the following checks should be included in import(),
# to allow "eval 'require Module::Install; 1' to test
# installation of Module::Install. (RT #51267)
#-------------------------------------------------------------
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my
$file
=
join
(
'
/
',
'
inc
',
split
/::/
,
__PACKAGE__
)
.
'
.pm
';
unless
(
$INC
{
$file
}
)
{
die
<<
"
END_DIE
"
}
Please
invoke
$
{
\
__PACKAGE__
}
with:
...
...
@@ -60,32 +71,42 @@ not:
END_DIE
# This reportedly fixes a rare Win32 UTC file time issue, but
# as this is a non-cross-platform XS module not in the core,
# we shouldn't really depend on it. See RT #24194 for detail.
# (Also, this module only supports Perl 5.6 and above).
eval
"
use Win32::UTCFileTime
"
if
$^O
eq
'
MSWin32
'
&&
$]
>=
5.006
;
# If the script that is loading Module::Install is from the future,
# then make will detect this and cause it to re-run over and over
# 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
)
{
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
}
# Too far in the future, throw an error.
my
$t
=
time
;
if
(
$s
>
$t
)
{
die
<<
"
END_DIE
"
}
# If the script that is loading Module::Install is from the future,
# then make will detect this and cause it to re-run over and over
# 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
"
}
Your
installer
$
0
has
a
modification
time
in
the
future
.
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
}
# Build.PL was formerly supported, but no longer is due to excessive
# difficulty in implementing every single feature twice.
if
(
$
0
=~
/Build.PL$/i
)
{
die
<<
"
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
)
{
die
<<
"
END_DIE
"
}
Module::
Install
no
longer
supports
Build
.
PL
.
...
...
@@ -95,23 +116,42 @@ Please remove all Build.PL files and only use the Makefile.PL installer.
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)
);
#-------------------------------------------------------------
unless
(
-
f
$self
->
{
file
}
)
{
foreach
my
$key
(
keys
%INC
)
{
delete
$INC
{
$key
}
if
$key
=~
/Module\/Install/
;
}
# 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)
);
local
$^W
;
require
"
$self
->{path}/
$self
->{dispatch}.pm
";
File::Path::
mkpath
("
$self
->{prefix}/
$self
->{author}
");
$self
->
{
admin
}
=
"
$self
->{name}::
$self
->{dispatch}
"
->
new
(
_top
=>
$self
);
$self
->
{
admin
}
->
init
;
@
_
=
(
$class
,
_self
=>
$self
);
goto
&
{"
$self
->{name}::import
"};
}
local
$^W
;
*
{"
${who}
::AUTOLOAD
"}
=
$self
->
autoload
;
$self
->
preload
;
# Unregister loader and worker packages so subdirs can use them again
delete
$INC
{'
inc/Module/Install.pm
'};
delete
$INC
{'
Module/Install.pm
'};
# Save to the singleton
$MAIN
=
$self
;
use
Cwd
();
use
File::
Find
();
use
File::
Path
();
use
FindBin
;
return
1
;
}
sub
autoload
{
my
$self
=
shift
;
...
...
@@ -121,39 +161,37 @@ 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
";
unless
(
uc
(
$
1
)
eq
$
1
)
{
unshift
@
_
,
(
$self
,
$
1
);
goto
&
{
$self
->
can
('
call
')};
unless
(
$$sym
=~
s/([^:]+)$//
)
{
# XXX: it looks like we can't retrieve the missing function
# via $$sym (usually $main::AUTOLOAD) in this case.
# I'm still wondering if we should slurp Makefile.PL to
# get some context or not ...
my
(
$package
,
$file
,
$line
)
=
caller
;
die
<<"EOT";
Unknown function is found at $file line $line.
Execution of $file aborted due to runtime errors.
If you're a contributor to a project, you may need to install
some Module::Install extensions from CPAN (or other repository).
If you're a user of a module, please contact the author.
EOT
}
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
(
@
_
);
}
};
}
sub
import
{
my
$class
=
shift
;
my
$self
=
$class
->
new
(
@
_
);
my
$who
=
$self
->
_caller
;
unless
(
-
f
$self
->
{
file
}
)
{
require
"
$self
->{path}/
$self
->{dispatch}.pm
";
File::Path::
mkpath
("
$self
->{prefix}/
$self
->{author}
");
$self
->
{
admin
}
=
"
$self
->{name}::
$self
->{dispatch}
"
->
new
(
_top
=>
$self
);
$self
->
{
admin
}
->
init
;
@
_
=
(
$class
,
_self
=>
$self
);
goto
&
{"
$self
->{name}::import
"};
}
*
{"
${who}
::AUTOLOAD
"}
=
$self
->
autoload
;
$self
->
preload
;
# Unregister loader and worker packages so subdirs can use them again
delete
$INC
{"
$self
->{file}
"};
delete
$INC
{"
$self
->{path}.pm
"};
return
1
;
# Dispatch to the appropriate plugin
unshift
@
_
,
(
$self
,
$
1
);
goto
&
{
$self
->
can
('
call
')};
};
}
sub
preload
{
...
...
@@ -166,8 +204,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
;
...
...
@@ -182,6 +219,7 @@ sub preload {
my
$who
=
$self
->
_caller
;
foreach
my
$name
(
sort
keys
%seen
)
{
local
$^W
;
*
{"
${who}
::
$name
"}
=
sub
{
$
{"
${who}
::AUTOLOAD
"}
=
"
${who}
::
$name
";
goto
&
{"
${who}
::AUTOLOAD
"};
...
...
@@ -192,12 +230,18 @@ sub preload {
sub
new
{
my
(
$class
,
%args
)
=
@_
;
delete
$INC
{'
FindBin.pm
'};
{
# to suppress the redefine warning
local
$SIG
{
__WARN__
}
=
sub
{};
require
FindBin
;
}
# ignore the prefix on extension modules built from top level.
my
$base_path
=
Cwd::
abs_path
(
$
FindBin::
Bin
);
unless
(
Cwd::
abs_path
(
Cwd::
cwd
())
eq
$base_path
)
{
delete
$args
{
prefix
};
}
return
$args
{
_self
}
if
$args
{
_self
};
$args
{
dispatch
}
||=
'
Admin
';
...
...
@@ -250,8 +294,10 @@ END_DIE
sub
load_extensions
{
my
(
$self
,
$path
,
$top
)
=
@_
;
unless
(
grep
{
!
ref
$_
and
lc
$_
eq
lc
$self
->
{
prefix
}
}
@INC
)
{
my
$should_reload
=
0
;
unless
(
grep
{
!
ref
$_
and
lc
$_
eq
lc
$self
->
{
prefix
}
}
@INC
)
{
unshift
@INC
,
$self
->
{
prefix
};
$should_reload
=
1
;
}
foreach
my
$rv
(
$self
->
find_extensions
(
$path
)
)
{
...
...
@@ -259,12 +305,13 @@ sub load_extensions {
next
if
$self
->
{
pathnames
}{
$pkg
};
local
$@
;
my
$new
=
eval
{
require
$file
;
$pkg
->
can
('
new
')
};
my
$new
=
eval
{
local
$^W
;
require
$file
;
$pkg
->
can
('
new
')
};
unless
(
$new
)
{
warn
$@
if
$@
;
next
;
}
$self
->
{
pathnames
}{
$pkg
}
=
delete
$INC
{
$file
};
$self
->
{
pathnames
}{
$pkg
}
=
$should_reload
?
delete
$INC
{
$file
}
:
$INC
{
$file
};
push
@
{
$self
->
{
extensions
}},
&
{
$new
}(
$pkg
,
_top
=>
$top
);
}
...
...
@@ -314,7 +361,7 @@ sub find_extensions {
#####################################################################
# Utility Functions
#
Common
Utility Functions
sub
_caller
{
my
$depth
=
0
;
...
...
@@ -326,33 +373,87 @@ sub _caller {
return
$call
;
}
# Done in evals to avoid confusing Perl::MinimumVersion
eval
(
$]
>=
5.006
?
<<
'
END_NEW
'
:
<<
'
END_OLD
'
);
die
$@
if
$@
;
sub
_read
{
local
*FH
;
open
(
FH
,
'
<
',
$_
[
0
]
)
or
die
"
open(
$_
[0]): $!
";
my
$string
=
do
{
local
$/
;
<
FH
>
};
close
FH
or
die
"
close(
$_
[0]): $!
";
return
$string
;
}
END_NEW
sub
_read
{
local
*FH
;
open
FH
,
"
<
$_
[0]
"
or
die
"
open(
$_
[0]): $!
";
my
$str
=
do
{
local
$/
;
<
FH
>
};
open
(
FH
,
"
<
$_
[0]
"
)
or
die
"
open(
$_
[0]): $!
";
my
$str
ing
=
do
{
local
$/
;
<
FH
>
};
close
FH
or
die
"
close(
$_
[0]): $!
";
return
$str
;
return
$string
;
}
END_OLD
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
;
}
# Done in evals to avoid confusing Perl::MinimumVersion
eval
(
$]
>=
5.006
?
<<
'
END_NEW
'
:
<<
'
END_OLD
'
);
die
$@
if
$@
;
sub
_write
{
local
*FH
;
open
FH
,
"
>
$_
[0]
"
or
die
"
open(
$_
[0]): $!
";
foreach
(
1
..
$
#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
open
(
FH
,
'
>
',
$_
[
0
]
)
or
die
"
open(
$_
[0]): $!
";
foreach
(
1
..
$
#_ ) {
print
FH
$_
[
$_
]
or
die
"
print(
$_
[0]): $!
";
}
close
FH
or
die
"
close(
$_
[0]): $!
";
}
END_NEW
sub
_write
{
local
*FH
;
open
(
FH
,
"
>
$_
[0]
"
)
or
die
"
open(
$_
[0]): $!
";
foreach
(
1
..
$
#_ ) {
print
FH
$_
[
$_
]
or
die
"
print(
$_
[0]): $!
";
}
close
FH
or
die
"
close(
$_
[0]): $!
";
}
END_OLD
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub
_version
($)
{
my
$s
=
shift
||
0
;
$s
=~
s/^(\d+)\.?//
;
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
;
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
($)
{
(
...
...
@@ -360,10 +461,10 @@ sub _CLASS ($) {
and
!
ref
$_
[
0
]
and
$_
[
0
]
=~
m/^[^\W\d]\w*(?:::\w+)*
$
/s
$_
[
0
]
=~
m/^[^\W\d]\w*(?:::\w+)*
\z
/s
)
?
$_
[
0
]
:
undef
;
}
1
;
# Copyright 2008 - 200
9
Adam Kennedy.
# Copyright 2008 - 20
1
0 Adam Kennedy.
inc/Module/Install/Base.pm
View file @
896e0948
#line 1
package
Module::Install::
Base
;
$VERSION
=
'
0.78
';
use
strict
'
vars
';
use
vars
qw{$VERSION}
;
BEGIN
{
$VERSION
=
'
1.00
';
}
# Suspend handler for "redefined" warnings
BEGIN
{
...
...
@@ -9,54 +13,61 @@ 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 10
1
#line 10
6
sub
is_admin
{
$_
[
0
]
->
admin
->
VERSION
;
!
$_
[
0
]
->
admin
->
isa
('
Module::Install::Base::FakeAdmin
')
;
}
sub
DESTROY
{}
package
Module::Install::Base::
FakeAdmin
;
my
$Fake
;
sub
new
{
$Fake
||=
bless
(
\
@
_
,
$_
[
0
])
}
use
vars
qw{$VERSION}
;
BEGIN
{
$VERSION
=
$
Module::Install::Base::
VERSION
;
}
my
$fake
;
sub
new
{
$fake
||=
bless
(
\
@
_
,
$_
[
0
]);
}
sub
AUTOLOAD
{}
...
...
@@ -69,4 +80,4 @@ BEGIN {
1
;
#line 1
46
#line 1
59
inc/Module/Install/Can.pm
View file @
896e0948
...
...
@@ -2,18 +2,16 @@
package
Module::Install::
Can
;
use
strict
;
use
Module::Install::
Base
;
use
Config
();
### This adds a 5.005 Perl version dependency.
### This is a bug and will be fixed.
use
File::
Spec
();
use
ExtUtils::
MakeMaker
();
use
vars
qw{$VERSION $ISCORE @ISA}
;
use
Config
();
use
File::
Spec
();
use
ExtUtils::
MakeMaker
();
use
Module::Install::
Base
();
use
vars
qw{$VERSION @ISA $ISCORE}
;
BEGIN
{
$VERSION
=
'
0.78
';
$VERSION
=
'
1.00
';
@ISA
=
'
Module::Install::Base
';
$ISCORE
=
1
;
@ISA
=
qw{Module::Install::Base}
;
}
# check if we can load some module
...
...
@@ -80,4 +78,4 @@ if ( $^O eq 'cygwin' ) {
__END__
#line 15
8
#line 15
6
inc/Module/Install/Fetch.pm
View file @
896e0948
...
...
@@ -2,13 +2,13 @@
package
Module::Install::
Fetch
;
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.78
';
$VERSION
=
'
1.00
';
@ISA
=
'
Module::Install::Base
';
$ISCORE
=
1
;
@ISA
=
qw{Module::Install::Base}
;
}
sub
get_file
{
...
...
inc/Module/Install/Makefile.pm
View file @
896e0948
...
...
@@ -2,14 +2,15 @@
package Module
::
Install::Makefile;
use
strict
'vars'
;
use Module
::
Install::Base;
use ExtUtils
::
MakeMaker ();
use ExtUtils
::
MakeMaker ();
use Module
::
Install::Base ();
use Fcntl qw/
:
flock :seek/;
use
vars
qw{$VERSION
$ISCORE
@ISA
};
use
vars
qw{$VERSION
@ISA
$ISCORE};
BEGIN
{
$VERSION
=
'0.78'
;
$VERSION
=
'1.00'
;
@ISA = 'Module
::
Install::Base';
$ISCORE
=
1
;
@ISA = qw{Module
::
Install::Base};
}
sub
Makefile
{
$_[0]
}
...
...
@@ -25,8 +26,8 @@ sub prompt {
die
"Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"
;
}
# In automated testing, always use defaults
if
(
$ENV{AUTOMATED_TESTING}
and
!
$ENV{PERL_MM_USE_DEFAULT}
)
{
# In automated testing
or non-interactive session
, always use defaults
if
(
(
$ENV{AUTOMATED_TESTING}
or
-!
-t
STDIN)
and
!
$ENV{PERL_MM_USE_DEFAULT}
)
{
local
$ENV{PERL_MM_USE_DEFAULT}
=
1
;
goto &ExtUtils
::
MakeMaker::prompt;
}
else
{
...
...
@@ -34,21 +35,112 @@ sub prompt {
}
}
# Store a cleaned up version of the MakeMaker version,
# since we need to behave differently in a variety of
# ways based on the MM version.
my $makemaker = eval $ExtUtils
::
MakeMaker::VERSION;
# If we are passed a param, do a "newer than" comparison.
# Otherwise, just return the MakeMaker version.
sub
makemaker
{
( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker
:
0
}
# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
# as we only need to know here whether the attribute is an array