Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

upgrade Module::Install

  • Loading branch information...
commit e348be780831d1b037da119e3aac386642d0881e 1 parent c60d2e7
Tatsuhiko Miyagawa authored
218 inc/Module/Install.pm
@@ -19,6 +19,9 @@ package Module::Install;
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,7 +31,7 @@ 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.00';
32 35
33 36 # Storage for the pseudo-singleton
34 37 $MAIN = undef;
@@ -38,18 +41,25 @@ BEGIN {
38 41
39 42 }
40 43
  44 +sub import {
  45 + my $class = shift;
  46 + my $self = $class->new(@_);
  47 + my $who = $self->_caller;
41 48
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" }
  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,26 +71,28 @@ not:
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,15 +101,12 @@ This is known to create infinite loops in make.
89 101 Please correct this, then run $0 again.
90 102
91 103 END_DIE
92   -}
93   -
94   -
95   -
  104 + }
96 105
97 106
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" }
  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,23 +116,42 @@ Please remove all Build.PL files and only use the Makefile.PL installer.
107 116
108 117 END_DIE
109 118
  119 + #-------------------------------------------------------------
110 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));
111 125
  126 + #-------------------------------------------------------------
112 127
  128 + unless ( -f $self->{file} ) {
  129 + foreach my $key (keys %INC) {
  130 + delete $INC{$key} if $key =~ /Module\/Install/;
  131 + }
113 132
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   -
  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 + }
119 141
  142 + local $^W;
  143 + *{"${who}::AUTOLOAD"} = $self->autoload;
  144 + $self->preload;
120 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'};
121 149
  150 + # Save to the singleton
  151 + $MAIN = $self;
122 152
123   -use Cwd ();
124   -use File::Find ();
125   -use File::Path ();
126   -use FindBin;
  153 + return 1;
  154 +}
127 155
128 156 sub autoload {
129 157 my $self = shift;
@@ -136,7 +164,21 @@ sub autoload {
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,33 +194,6 @@ sub autoload {
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,6 +219,7 @@ sub preload {
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,12 +230,18 @@ sub preload {
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,8 +294,10 @@ END_DIE
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,12 +305,13 @@ sub load_extensions {
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,17 +373,24 @@ sub _caller {
348 373 return $call;
349 374 }
350 375
  376 +# Done in evals to avoid confusing Perl::MinimumVersion
  377 +eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
351 378 sub _read {
352 379 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   - }
  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]): $!";
358 389 my $string = do { local $/; <FH> };
359 390 close FH or die "close($_[0]): $!";
360 391 return $string;
361 392 }
  393 +END_OLD
362 394
363 395 sub _readperl {
364 396 my $string = Module::Install::_read($_[0]);
@@ -379,18 +411,26 @@ sub _readpod {
379 411 return $string;
380 412 }
381 413
  414 +# Done in evals to avoid confusing Perl::MinimumVersion
  415 +eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
382 416 sub _write {
383 417 local *FH;
384   - if ( $] >= 5.006 ) {
385   - open( FH, '>', $_[0] ) or die "open($_[0]): $!";
386   - } else {
387   - open( FH, "> $_[0]" ) or die "open($_[0]): $!";
  418 + open( FH, '>', $_[0] ) or die "open($_[0]): $!";
  419 + foreach ( 1 .. $#_ ) {
  420 + print FH $_[$_] or die "print($_[0]): $!";
388 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]): $!";
389 428 foreach ( 1 .. $#_ ) {
390 429 print FH $_[$_] or die "print($_[0]): $!";
391 430 }
392 431 close FH or die "close($_[0]): $!";
393 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).
@@ -427,4 +467,4 @@ sub _CLASS ($) {
427 467
428 468 1;
429 469
430   -# Copyright 2008 - 2009 Adam Kennedy.
  470 +# Copyright 2008 - 2010 Adam Kennedy.
11 inc/Module/Install/Base.pm
@@ -4,7 +4,7 @@ package Module::Install::Base;
4 4 use strict 'vars';
5 5 use vars qw{$VERSION};
6 6 BEGIN {
7   - $VERSION = '0.91';
  7 + $VERSION = '1.00';
8 8 }
9 9
10 10 # Suspend handler for "redefined" warnings
@@ -51,13 +51,18 @@ sub admin {
51 51 #line 106
52 52
53 53 sub is_admin {
54   - $_[0]->admin->VERSION;
  54 + ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
55 55 }
56 56
57 57 sub DESTROY {}
58 58
59 59 package Module::Install::Base::FakeAdmin;
60 60
  61 +use vars qw{$VERSION};
  62 +BEGIN {
  63 + $VERSION = $Module::Install::Base::VERSION;
  64 +}
  65 +
61 66 my $fake;
62 67
63 68 sub new {
@@ -75,4 +80,4 @@ BEGIN {
75 80
76 81 1;
77 82
78   -#line 154
  83 +#line 159
2  inc/Module/Install/Can.pm
@@ -9,7 +9,7 @@ use Module::Install::Base ();
9 9
10 10 use vars qw{$VERSION @ISA $ISCORE};
11 11 BEGIN {
12   - $VERSION = '0.91';
  12 + $VERSION = '1.00';
13 13 @ISA = 'Module::Install::Base';
14 14 $ISCORE = 1;
15 15 }
2  inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
6 6
7 7 use vars qw{$VERSION @ISA $ISCORE};
8 8 BEGIN {
9   - $VERSION = '0.91';
  9 + $VERSION = '1.00';
10 10 @ISA = 'Module::Install::Base';
11 11 $ISCORE = 1;
12 12 }
229 inc/Module/Install/Makefile.pm
@@ -4,10 +4,11 @@ package Module::Install::Makefile;
4 4 use strict 'vars';
5 5 use ExtUtils::MakeMaker ();
6 6 use Module::Install::Base ();
  7 +use Fcntl qw/:flock :seek/;
7 8
8 9 use vars qw{$VERSION @ISA $ISCORE};
9 10 BEGIN {
10   - $VERSION = '0.91';
  11 + $VERSION = '1.00';
11 12 @ISA = 'Module::Install::Base';
12 13 $ISCORE = 1;
13 14 }
@@ -25,8 +26,8 @@ sub prompt {
25 26 die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
26 27 }
27 28
28   - # In automated testing, always use defaults
29   - if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) {
  29 + # In automated testing or non-interactive session, always use defaults
  30 + if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
30 31 local $ENV{PERL_MM_USE_DEFAULT} = 1;
31 32 goto &ExtUtils::MakeMaker::prompt;
32 33 } else {
@@ -34,21 +35,112 @@ sub prompt {
34 35 }
35 36 }
36 37
  38 +# Store a cleaned up version of the MakeMaker version,
  39 +# since we need to behave differently in a variety of
  40 +# ways based on the MM version.
  41 +my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
  42 +
  43 +# If we are passed a param, do a "newer than" comparison.
  44 +# Otherwise, just return the MakeMaker version.
  45 +sub makemaker {
  46 + ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
  47 +}
  48 +
  49 +# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
  50 +# as we only need to know here whether the attribute is an array
  51 +# or a hash or something else (which may or may not be appendable).
  52 +my %makemaker_argtype = (
  53 + C => 'ARRAY',
  54 + CONFIG => 'ARRAY',
  55 +# CONFIGURE => 'CODE', # ignore
  56 + DIR => 'ARRAY',
  57 + DL_FUNCS => 'HASH',
  58 + DL_VARS => 'ARRAY',
  59 + EXCLUDE_EXT => 'ARRAY',
  60 + EXE_FILES => 'ARRAY',
  61 + FUNCLIST => 'ARRAY',
  62 + H => 'ARRAY',
  63 + IMPORTS => 'HASH',
  64 + INCLUDE_EXT => 'ARRAY',
  65 + LIBS => 'ARRAY', # ignore ''
  66 + MAN1PODS => 'HASH',
  67 + MAN3PODS => 'HASH',
  68 + META_ADD => 'HASH',
  69 + META_MERGE => 'HASH',
  70 + PL_FILES => 'HASH',
  71 + PM => 'HASH',
  72 + PMLIBDIRS => 'ARRAY',
  73 + PMLIBPARENTDIRS => 'ARRAY',
  74 + PREREQ_PM => 'HASH',
  75 + CONFIGURE_REQUIRES => 'HASH',
  76 + SKIP => 'ARRAY',
  77 + TYPEMAPS => 'ARRAY',
  78 + XS => 'HASH',
  79 +# VERSION => ['version',''], # ignore
  80 +# _KEEP_AFTER_FLUSH => '',
  81 +
  82 + clean => 'HASH',
  83 + depend => 'HASH',
  84 + dist => 'HASH',
  85 + dynamic_lib=> 'HASH',
  86 + linkext => 'HASH',
  87 + macro => 'HASH',
  88 + postamble => 'HASH',
  89 + realclean => 'HASH',
  90 + test => 'HASH',
  91 + tool_autosplit => 'HASH',
  92 +
  93 + # special cases where you can use makemaker_append
  94 + CCFLAGS => 'APPENDABLE',
  95 + DEFINE => 'APPENDABLE',
  96 + INC => 'APPENDABLE',
  97 + LDDLFLAGS => 'APPENDABLE',
  98 + LDFROM => 'APPENDABLE',
  99 +);
  100 +
37 101 sub makemaker_args {
38   - my $self = shift;
  102 + my ($self, %new_args) = @_;
39 103 my $args = ( $self->{makemaker_args} ||= {} );
40   - %$args = ( %$args, @_ );
  104 + foreach my $key (keys %new_args) {
  105 + if ($makemaker_argtype{$key}) {
  106 + if ($makemaker_argtype{$key} eq 'ARRAY') {
  107 + $args->{$key} = [] unless defined $args->{$key};
  108 + unless (ref $args->{$key} eq 'ARRAY') {
  109 + $args->{$key} = [$args->{$key}]
  110 + }
  111 + push @{$args->{$key}},
  112 + ref $new_args{$key} eq 'ARRAY'
  113 + ? @{$new_args{$key}}
  114 + : $new_args{$key};
  115 + }
  116 + elsif ($makemaker_argtype{$key} eq 'HASH') {
  117 + $args->{$key} = {} unless defined $args->{$key};
  118 + foreach my $skey (keys %{ $new_args{$key} }) {
  119 + $args->{$key}{$skey} = $new_args{$key}{$skey};
  120 + }
  121 + }
  122 + elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
  123 + $self->makemaker_append($key => $new_args{$key});
  124 + }
  125 + }
  126 + else {
  127 + if (defined $args->{$key}) {
  128 + warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
  129 + }
  130 + $args->{$key} = $new_args{$key};
  131 + }
  132 + }
41 133 return $args;
42 134 }
43 135
44 136 # For mm args that take multiple space-seperated args,
45 137 # append an argument to the current list.
46 138 sub makemaker_append {
47   - my $self = sShift;
  139 + my $self = shift;
48 140 my $name = shift;
49 141 my $args = $self->makemaker_args;
50   - $args->{name} = defined $args->{$name}
51   - ? join( ' ', $args->{name}, @_ )
  142 + $args->{$name} = defined $args->{$name}
  143 + ? join( ' ', $args->{$name}, @_ )
52 144 : join( ' ', @_ );
53 145 }
54 146
@@ -89,25 +181,22 @@ sub inc {
89 181 $self->makemaker_args( INC => shift );
90 182 }
91 183
92   -my %test_dir = ();
93   -
94 184 sub _wanted_t {
95   - /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1;
96 185 }
97 186
98 187 sub tests_recursive {
99 188 my $self = shift;
100   - if ( $self->tests ) {
101   - die "tests_recursive will not work if tests are already defined";
102   - }
103 189 my $dir = shift || 't';
104 190 unless ( -d $dir ) {
105 191 die "tests_recursive dir '$dir' does not exist";
106 192 }
107   - %test_dir = ();
  193 + my %tests = map { $_ => 1 } split / /, ($self->tests || '');
108 194 require File::Find;
109   - File::Find::find( \&_wanted_t, $dir );
110   - $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
  195 + File::Find::find(
  196 + sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
  197 + $dir
  198 + );
  199 + $self->tests( join ' ', sort keys %tests );
111 200 }
112 201
113 202 sub write {
@@ -130,12 +219,13 @@ sub write {
130 219 # an underscore, even though its own version may contain one!
131 220 # Hence the funny regexp to get rid of it. See RT #35800
132 221 # for details.
133   - $self->build_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
134   - $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
  222 + my $v = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/;
  223 + $self->build_requires( 'ExtUtils::MakeMaker' => $v );
  224 + $self->configure_requires( 'ExtUtils::MakeMaker' => $v );
135 225 } else {
136 226 # Allow legacy-compatibility with 5.005 by depending on the
137 227 # most recent EU:MM that supported 5.005.
138   - $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
  228 + $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
139 229 $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
140 230 }
141 231
@@ -143,59 +233,115 @@ sub write {
143 233 my $args = $self->makemaker_args;
144 234 $args->{DISTNAME} = $self->name;
145 235 $args->{NAME} = $self->module_name || $self->name;
146   - $args->{VERSION} = $self->version;
147 236 $args->{NAME} =~ s/-/::/g;
  237 + $args->{VERSION} = $self->version or die <<'EOT';
  238 +ERROR: Can't determine distribution version. Please specify it
  239 +explicitly via 'version' in Makefile.PL, or set a valid $VERSION
  240 +in a module, and provide its file path via 'version_from' (or
  241 +'all_from' if you prefer) in Makefile.PL.
  242 +EOT
  243 +
  244 + $DB::single = 1;
148 245 if ( $self->tests ) {
149   - $args->{test} = { TESTS => $self->tests };
  246 + my @tests = split ' ', $self->tests;
  247 + my %seen;
  248 + $args->{test} = {
  249 + TESTS => (join ' ', grep {!$seen{$_}++} @tests),
  250 + };
  251 + } elsif ( $Module::Install::ExtraTests::use_extratests ) {
  252 + # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
  253 + # So, just ignore our xt tests here.
  254 + } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
  255 + $args->{test} = {
  256 + TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
  257 + };
150 258 }
151 259 if ( $] >= 5.005 ) {
152 260 $args->{ABSTRACT} = $self->abstract;
153   - $args->{AUTHOR} = $self->author;
  261 + $args->{AUTHOR} = join ', ', @{$self->author || []};
154 262 }
155   - if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
156   - $args->{NO_META} = 1;
  263 + if ( $self->makemaker(6.10) ) {
  264 + $args->{NO_META} = 1;
  265 + #$args->{NO_MYMETA} = 1;
157 266 }
158   - if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
  267 + if ( $self->makemaker(6.17) and $self->sign ) {
159 268 $args->{SIGN} = 1;
160 269 }
161 270 unless ( $self->is_admin ) {
162 271 delete $args->{SIGN};
163 272 }
  273 + if ( $self->makemaker(6.31) and $self->license ) {
  274 + $args->{LICENSE} = $self->license;
  275 + }
164 276
165   - # Merge both kinds of requires into prereq_pm
166 277 my $prereq = ($args->{PREREQ_PM} ||= {});
167 278 %$prereq = ( %$prereq,
168   - map { @$_ }
  279 + map { @$_ } # flatten [module => version]
169 280 map { @$_ }
170 281 grep $_,
171   - ($self->configure_requires, $self->build_requires, $self->requires)
  282 + ($self->requires)
172 283 );
173 284
174 285 # Remove any reference to perl, PREREQ_PM doesn't support it
175 286 delete $args->{PREREQ_PM}->{perl};
176 287
177   - # merge both kinds of requires into prereq_pm
178   - my $subdirs = ($args->{DIR} ||= []);
  288 + # Merge both kinds of requires into BUILD_REQUIRES
  289 + my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
  290 + %$build_prereq = ( %$build_prereq,
  291 + map { @$_ } # flatten [module => version]
  292 + map { @$_ }
  293 + grep $_,
  294 + ($self->configure_requires, $self->build_requires)
  295 + );
  296 +
  297 + # Remove any reference to perl, BUILD_REQUIRES doesn't support it
  298 + delete $args->{BUILD_REQUIRES}->{perl};
  299 +
  300 + # Delete bundled dists from prereq_pm, add it to Makefile DIR
  301 + my $subdirs = ($args->{DIR} || []);
179 302 if ($self->bundles) {
  303 + my %processed;
180 304 foreach my $bundle (@{ $self->bundles }) {
181   - my ($file, $dir) = @$bundle;
182   - push @$subdirs, $dir if -d $dir;
183   - delete $prereq->{$file};
  305 + my ($mod_name, $dist_dir) = @$bundle;
  306 + delete $prereq->{$mod_name};
  307 + $dist_dir = File::Basename::basename($dist_dir); # dir for building this module
  308 + if (not exists $processed{$dist_dir}) {
  309 + if (-d $dist_dir) {
  310 + # List as sub-directory to be processed by make
  311 + push @$subdirs, $dist_dir;
  312 + }
  313 + # Else do nothing: the module is already present on the system
  314 + $processed{$dist_dir} = undef;
  315 + }
184 316 }
185 317 }
186 318
  319 + unless ( $self->makemaker('6.55_03') ) {
  320 + %$prereq = (%$prereq,%$build_prereq);
  321 + delete $args->{BUILD_REQUIRES};
  322 + }
  323 +
187 324 if ( my $perl_version = $self->perl_version ) {
188 325 eval "use $perl_version; 1"
189 326 or die "ERROR: perl: Version $] is installed, "
190 327 . "but we need version >= $perl_version";
  328 +
  329 + if ( $self->makemaker(6.48) ) {
  330 + $args->{MIN_PERL_VERSION} = $perl_version;
  331 + }
191 332 }
192 333
193   - $args->{INSTALLDIRS} = $self->installdirs;
  334 + if ($self->installdirs) {
  335 + warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
  336 + $args->{INSTALLDIRS} = $self->installdirs;
  337 + }
194 338
195   - my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
  339 + my %args = map {
  340 + ( $_ => $args->{$_} ) } grep {defined($args->{$_} )
  341 + } keys %$args;
196 342
197 343 my $user_preop = delete $args{dist}->{PREOP};
198   - if (my $preop = $self->admin->preop($user_preop)) {
  344 + if ( my $preop = $self->admin->preop($user_preop) ) {
199 345 foreach my $key ( keys %$preop ) {
200 346 $args{dist}->{$key} = $preop->{$key};
201 347 }
@@ -219,9 +365,9 @@ sub fix_up_makefile {
219 365 . ($self->postamble || '');
220 366
221 367 local *MAKEFILE;
222   - open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
  368 + open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
  369 + eval { flock MAKEFILE, LOCK_EX };
223 370 my $makefile = do { local $/; <MAKEFILE> };
224   - close MAKEFILE or die $!;
225 371
226 372 $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
227 373 $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
@@ -241,7 +387,8 @@ sub fix_up_makefile {
241 387 # XXX - This is currently unused; not sure if it breaks other MM-users
242 388 # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
243 389
244   - open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
  390 + seek MAKEFILE, 0, SEEK_SET;
  391 + truncate MAKEFILE, 0;
245 392 print MAKEFILE "$preamble$makefile$postamble" or die $!;
246 393 close MAKEFILE or die $!;
247 394
@@ -265,4 +412,4 @@ sub postamble {
265 412
266 413 __END__
267 414
268   -#line 394
  415 +#line 541
267 inc/Module/Install/Metadata.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
6 6
7 7 use vars qw{$VERSION @ISA $ISCORE};
8 8 BEGIN {
9   - $VERSION = '0.91';
  9 + $VERSION = '1.00';
10 10 @ISA = 'Module::Install::Base';
11 11 $ISCORE = 1;
12 12 }
@@ -19,7 +19,6 @@ my @scalar_keys = qw{
19 19 name
20 20 module_name
21 21 abstract
22   - author
23 22 version
24 23 distribution_type
25 24 tests
@@ -43,8 +42,11 @@ my @resource_keys = qw{
43 42
44 43 my @array_keys = qw{
45 44 keywords
  45 + author
46 46 };
47 47
  48 +*authors = \&author;
  49 +
48 50 sub Meta { shift }
49 51 sub Meta_BooleanKeys { @boolean_keys }
50 52 sub Meta_ScalarKeys { @scalar_keys }
@@ -176,43 +178,6 @@ sub perl_version {
176 178 $self->{values}->{perl_version} = $version;
177 179 }
178 180
179   -#Stolen from M::B
180   -my %license_urls = (
181   - perl => 'http://dev.perl.org/licenses/',
182   - apache => 'http://apache.org/licenses/LICENSE-2.0',
183   - artistic => 'http://opensource.org/licenses/artistic-license.php',
184   - artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
185   - lgpl => 'http://opensource.org/licenses/lgpl-license.php',
186   - lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
187   - lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
188   - bsd => 'http://opensource.org/licenses/bsd-license.php',
189   - gpl => 'http://opensource.org/licenses/gpl-license.php',
190   - gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
191   - gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
192   - mit => 'http://opensource.org/licenses/mit-license.php',
193   - mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
194   - open_source => undef,
195   - unrestricted => undef,
196   - restrictive => undef,
197   - unknown => undef,
198   -);
199   -
200   -sub license {
201   - my $self = shift;
202   - return $self->{values}->{license} unless @_;
203   - my $license = shift or die(
204   - 'Did not provide a value to license()'
205   - );
206   - $self->{values}->{license} = $license;
207   -
208   - # Automatically fill in license URLs
209   - if ( $license_urls{$license} ) {
210   - $self->resources( license => $license_urls{$license} );
211   - }
212   -
213   - return 1;
214   -}
215   -
216 181 sub all_from {
217 182 my ( $self, $file ) = @_;
218 183
@@ -230,6 +195,8 @@ sub all_from {
230 195 die("The path '$file' does not exist, or is not a file");
231 196 }
232 197
  198 + $self->{values}{all_from} = $file;
  199 +
233 200 # Some methods pull from POD instead of code.
234 201 # If there is a matching .pod, use that instead
235 202 my $pod = $file;
@@ -240,7 +207,7 @@ sub all_from {
240 207 $self->name_from($file) unless $self->name;
241 208 $self->version_from($file) unless $self->version;
242 209 $self->perl_version_from($file) unless $self->perl_version;
243   - $self->author_from($pod) unless $self->author;
  210 + $self->author_from($pod) unless @{$self->author || []};
244 211 $self->license_from($pod) unless $self->license;
245 212 $self->abstract_from($pod) unless $self->abstract;
246 213
@@ -350,6 +317,9 @@ sub version_from {
350 317 require ExtUtils::MM_Unix;
351 318 my ( $self, $file ) = @_;
352 319 $self->version( ExtUtils::MM_Unix->parse_version($file) );
  320 +
  321 + # for version integrity check
  322 + $self->makemaker_args( VERSION_FROM => $file );
353 323 }
354 324
355 325 sub abstract_from {
@@ -360,7 +330,7 @@ sub abstract_from {
360 330 { DISTNAME => $self->name },
361 331 'ExtUtils::MM_Unix'
362 332 )->parse_abstract($file)
363   - );
  333 + );
364 334 }
365 335
366 336 # Add both distribution and module name
@@ -385,11 +355,10 @@ sub name_from {
385 355 }
386 356 }
387 357
388   -sub perl_version_from {
389   - my $self = shift;
  358 +sub _extract_perl_version {
390 359 if (
391   - Module::Install::_read($_[0]) =~ m/
392   - ^
  360 + $_[0] =~ m/
  361 + ^\s*
393 362 (?:use|require) \s*
394 363 v?
395 364 ([\d_\.]+)
@@ -398,6 +367,16 @@ sub perl_version_from {
398 367 ) {
399 368 my $perl_version = $1;
400 369 $perl_version =~ s{_}{}g;
  370 + return $perl_version;
  371 + } else {
  372 + return;
  373 + }
  374 +}
  375 +
  376 +sub perl_version_from {
  377 + my $self = shift;
  378 + my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
  379 + if ($perl_version) {
401 380 $self->perl_version($perl_version);
402 381 } else {
403 382 warn "Cannot determine perl version info from $_[0]\n";
@@ -417,59 +396,164 @@ sub author_from {
417 396 ([^\n]*)
418 397 /ixms) {
419 398 my $author = $1 || $2;
420   - $author =~ s{E<lt>}{<}g;
421   - $author =~ s{E<gt>}{>}g;
  399 +
  400 + # XXX: ugly but should work anyway...
  401 + if (eval "require Pod::Escapes; 1") {
  402 + # Pod::Escapes has a mapping table.
  403 + # It's in core of perl >= 5.9.3, and should be installed
  404 + # as one of the Pod::Simple's prereqs, which is a prereq
  405 + # of Pod::Text 3.x (see also below).
  406 + $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
  407 + {
  408 + defined $2
  409 + ? chr($2)
  410 + : defined $Pod::Escapes::Name2character_number{$1}
  411 + ? chr($Pod::Escapes::Name2character_number{$1})
  412 + : do {
  413 + warn "Unknown escape: E<$1>";
  414 + "E<$1>";
  415 + };
  416 + }gex;
  417 + }
  418 + elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
  419 + # Pod::Text < 3.0 has yet another mapping table,
  420 + # though the table name of 2.x and 1.x are different.
  421 + # (1.x is in core of Perl < 5.6, 2.x is in core of
  422 + # Perl < 5.9.3)
  423 + my $mapping = ($Pod::Text::VERSION < 2)
  424 + ? \%Pod::Text::HTML_Escapes
  425 + : \%Pod::Text::ESCAPES;
  426 + $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
  427 + {
  428 + defined $2
  429 + ? chr($2)
  430 + : defined $mapping->{$1}
  431 + ? $mapping->{$1}
  432 + : do {
  433 + warn "Unknown escape: E<$1>";
  434 + "E<$1>";
  435 + };
  436 + }gex;
  437 + }
  438 + else {
  439 + $author =~ s{E<lt>}{<}g;
  440 + $author =~ s{E<gt>}{>}g;
  441 + }
422 442 $self->author($author);
423 443 } else {
424 444 warn "Cannot determine author info from $_[0]\n";
425 445 }
426 446 }
427 447
428   -sub license_from {
  448 +#Stolen from M::B
  449 +my %license_urls = (
  450 + perl => 'http://dev.perl.org/licenses/',
  451 + apache => 'http://apache.org/licenses/LICENSE-2.0',
  452 + apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
  453 + artistic => 'http://opensource.org/licenses/artistic-license.php',
  454 + artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
  455 + lgpl => 'http://opensource.org/licenses/lgpl-license.php',
  456 + lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
  457 + lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
  458 + bsd => 'http://opensource.org/licenses/bsd-license.php',
  459 + gpl => 'http://opensource.org/licenses/gpl-license.php',
  460 + gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
  461 + gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
  462 + mit => 'http://opensource.org/licenses/mit-license.php',
  463 + mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
  464 + open_source => undef,
  465 + unrestricted => undef,
  466 + restrictive => undef,
  467 + unknown => undef,
  468 +);
  469 +
  470 +sub license {
429 471 my $self = shift;
430   - if (
431   - Module::Install::_read($_[0]) =~ m/
432   - (
433   - =head \d \s+
434   - (?:licen[cs]e|licensing|copyright|legal)\b
435   - .*?
436   - )
437   - (=head\\d.*|=cut.*|)
438   - \z
439   - /ixms ) {
440   - my $license_text = $1;
441   - my @phrases = (
442   - 'under the same (?:terms|license) as (?:perl|the perl programming language) itself' => 'perl', 1,
443   - 'GNU general public license' => 'gpl', 1,
444   - 'GNU public license' => 'gpl', 1,
445   - 'GNU lesser general public license' => 'lgpl', 1,
446   - 'GNU lesser public license' => 'lgpl', 1,
447   - 'GNU library general public license' => 'lgpl', 1,
448   - 'GNU library public license' => 'lgpl', 1,
449   - 'BSD license' => 'bsd', 1,
450   - 'Artistic license' => 'artistic', 1,
451   - 'GPL' => 'gpl', 1,
452   - 'LGPL' => 'lgpl', 1,
453   - 'BSD' => 'bsd', 1,
454   - 'Artistic' => 'artistic', 1,
455   - 'MIT' => 'mit', 1,
456   - 'proprietary' => 'proprietary', 0,
457   - );
458   - while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
459   - $pattern =~ s{\s+}{\\s+}g;
460   - if ( $license_text =~ /\b$pattern\b/i ) {
461   - $self->license($license);
462   - return 1;
463   - }
  472 + return $self->{values}->{license} unless @_;
  473 + my $license = shift or die(
  474 + 'Did not provide a value to license()'
  475 + );
  476 + $license = __extract_license($license) || lc $license;
  477 + $self->{values}->{license} = $license;
  478 +
  479 + # Automatically fill in license URLs
  480 + if ( $license_urls{$license} ) {
  481 + $self->resources( license => $license_urls{$license} );
  482 + }
  483 +
  484 + return 1;
  485 +}
  486 +
  487 +sub _extract_license {
  488 + my $pod = shift;
  489 + my $matched;
  490 + return __extract_license(
  491 + ($matched) = $pod =~ m/
  492 + (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
  493 + (=head \d.*|=cut.*|)\z
  494 + /xms
  495 + ) || __extract_license(
  496 + ($matched) = $pod =~ m/
  497 + (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
  498 + (=head \d.*|=cut.*|)\z
  499 + /xms
  500 + );
  501 +}
  502 +
  503 +sub __extract_license {
  504 + my $license_text = shift or return;
  505 + my @phrases = (
  506 + '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
  507 + '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
  508 + 'Artistic and GPL' => 'perl', 1,
  509 + 'GNU general public license' => 'gpl', 1,
  510 + 'GNU public license' => 'gpl', 1,
  511 + 'GNU lesser general public license' => 'lgpl', 1,
  512 + 'GNU lesser public license' => 'lgpl', 1,
  513 + 'GNU library general public license' => 'lgpl', 1,
  514 + 'GNU library public license' => 'lgpl', 1,
  515 + 'GNU Free Documentation license' => 'unrestricted', 1,
  516 + 'GNU Affero General Public License' => 'open_source', 1,
  517 + '(?:Free)?BSD license' => 'bsd', 1,
  518 + 'Artistic license' => 'artistic', 1,
  519 + 'Apache (?:Software )?license' => 'apache', 1,
  520 + 'GPL' => 'gpl', 1,
  521 + 'LGPL' => 'lgpl', 1,
  522 + 'BSD' => 'bsd', 1,
  523 + 'Artistic' => 'artistic', 1,
  524 + 'MIT' => 'mit', 1,
  525 + 'Mozilla Public License' => 'mozilla', 1,
  526 + 'Q Public License' => 'open_source', 1,
  527 + 'OpenSSL License' => 'unrestricted', 1,
  528 + 'SSLeay License' => 'unrestricted', 1,
  529 + 'zlib License' => 'open_source', 1,
  530 + 'proprietary' => 'proprietary', 0,
  531 + );
  532 + while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
  533 + $pattern =~ s#\s+#\\s+#gs;
  534 + if ( $license_text =~ /\b$pattern\b/i ) {
  535 + return $license;
464 536 }
465 537 }
  538 + return '';
  539 +}
466 540
467   - warn "Cannot determine license info from $_[0]\n";
468   - return 'unknown';
  541 +sub license_from {
  542 + my $self = shift;
  543 + if (my $license=_extract_license(Module::Install::_read($_[0]))) {
  544 + $self->license($license);
  545 + } else {
  546 + warn "Cannot determine license info from $_[0]\n";
  547 + return 'unknown';
  548 + }
469 549 }
470 550
471 551 sub _extract_bugtracker {
472   - my @links = $_[0] =~ m#L<(\Qhttp://rt.cpan.org/\E[^>]+)>#g;
  552 + my @links = $_[0] =~ m#L<(
  553 + \Qhttp://rt.cpan.org/\E[^>]+|
  554 + \Qhttp://github.com/\E[\w_]+/[\w_]+/issues|
  555 + \Qhttp://code.google.com/p/\E[\w_\-]+/issues/list
  556 + )>#gx;
473 557 my %links;
474 558 @links{@links}=();
475 559 @links=keys %links;
@@ -485,7 +569,7 @@ sub bugtracker_from {
485 569 return 0;
486 570 }
487 571 if ( @links > 1 ) {
488   - warn "Found more than on rt.cpan.org link in $_[0]\n";
  572 + warn "Found more than one bugtracker link in $_[0]\n";
489 573 return 0;
490 574 }
491 575
@@ -532,8 +616,15 @@ sub _perl_version {
532 616 return $v;
533 617 }
534 618
535   -
536   -
  619 +sub add_metadata {
  620 + my $self = shift;
  621 + my %hash = @_;
  622 + for my $key (keys %hash) {
  623 + warn "add_metadata: $key is not prefixed with 'x_'.\n" .
  624 + "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
  625 + $self->{values}->{$key} = $hash{$key};
  626 + }
  627 +}
537 628
538 629
539 630 ######################################################################
2  inc/Module/Install/Scripts.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
6 6
7 7 use vars qw{$VERSION @ISA $ISCORE};
8 8 BEGIN {
9   - $VERSION = '0.91';
  9 + $VERSION = '1.00';
10 10 @ISA = 'Module::Install::Base';
11 11 $ISCORE = 1;
12 12 }
2  inc/Module/Install/Win32.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
6 6
7 7 use vars qw{$VERSION @ISA $ISCORE};
8 8 BEGIN {
9   - $VERSION = '0.91';
  9 + $VERSION = '1.00';
10 10 @ISA = 'Module::Install::Base';
11 11 $ISCORE = 1;
12 12 }
7 inc/Module/Install/WriteAll.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
6