line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#line 1 |
2
|
|
|
|
|
|
|
package Module::Build::Functions; |
3
|
|
|
|
|
|
|
|
4
|
3
|
|
|
3
|
|
16
|
#<<< |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
117
|
|
5
|
3
|
|
|
3
|
|
80
|
use strict; |
|
3
|
|
|
|
|
11
|
|
|
3
|
|
|
|
|
131
|
|
6
|
3
|
|
|
3
|
|
26
|
use 5.00503; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
224
|
|
7
|
3
|
|
|
3
|
|
16
|
use vars qw( $VERSION @EXPORT $AUTOLOAD %ARGS); |
|
3
|
|
|
|
|
13
|
|
|
3
|
|
|
|
|
324
|
|
8
|
3
|
|
|
3
|
|
871
|
use Carp qw( croak carp confess ); |
|
3
|
|
|
|
|
712
|
|
|
3
|
|
|
|
|
202
|
|
9
|
3
|
|
|
3
|
|
14
|
use File::Spec::Functions qw( catdir catfile ); |
|
3
|
|
|
|
|
16
|
|
|
3
|
|
|
|
|
48
|
|
10
|
3
|
|
|
3
|
|
15
|
use Exporter qw(); |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
69
|
|
11
|
3
|
|
|
3
|
|
16
|
use Cwd qw(); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
45
|
|
12
|
3
|
|
|
3
|
|
16
|
use File::Find qw(); |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
55
|
|
13
|
3
|
|
|
3
|
|
2885
|
use File::Path qw(); |
|
3
|
|
|
|
|
4022
|
|
|
3
|
|
|
|
|
129
|
|
14
|
3
|
|
|
3
|
|
19
|
use FindBin; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
5038
|
|
15
|
|
|
|
|
|
|
use Config; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# The equivalent of "use warnings" pre-5.006. |
18
|
|
|
|
|
|
|
local $^W = 1; |
19
|
|
|
|
|
|
|
my $object = undef; |
20
|
|
|
|
|
|
|
my $class = 'Module::Build'; |
21
|
|
|
|
|
|
|
my $mb_required = 0; |
22
|
|
|
|
|
|
|
my $object_created = 0; |
23
|
|
|
|
|
|
|
my $export_to = undef; |
24
|
|
|
|
|
|
|
my $sharemod_used = 1; |
25
|
|
|
|
|
|
|
my (%FLAGS, %ALIASES, %ARRAY, %HASH, @AUTOLOADED, @DEFINED); |
26
|
|
|
|
|
|
|
my @install_types; |
27
|
|
|
|
|
|
|
my %config; |
28
|
|
|
|
|
|
|
#>>> |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# Whether or not inc::Module::Build::Functions is actually loaded, the |
31
|
|
|
|
|
|
|
# $INC{inc/Module/Build/Functions.pm} is what will still get set as long as |
32
|
|
|
|
|
|
|
# the caller loaded this module in the documented manner. |
33
|
|
|
|
|
|
|
# If not set, the caller may NOT have loaded the bundled version, and thus |
34
|
|
|
|
|
|
|
# they may not have a MBF version that works with the Build.PL. This would |
35
|
|
|
|
|
|
|
# result in false errors or unexpected behaviour. And we don't want that. |
36
|
|
|
|
|
|
|
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; |
37
|
|
|
|
|
|
|
unless ( $INC{$file} ) { |
38
|
|
|
|
|
|
|
die <<"END_DIE" } |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
Please invoke ${\__PACKAGE__} with: |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
use inc::${\__PACKAGE__}; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
not: |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
use ${\__PACKAGE__}; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
END_DIE |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# To save some more typing in Module::Build::Functions installers, every... |
51
|
|
|
|
|
|
|
# use inc::Module::Build::Functions |
52
|
|
|
|
|
|
|
# ...also acts as an implicit use strict. |
53
|
|
|
|
|
|
|
$^H |= strict::bits(qw(refs subs vars)); |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# import which will also perform self-bundling |
56
|
2
|
|
|
2
|
|
21
|
sub import { |
57
|
|
|
|
|
|
|
$export_to = caller; |
58
|
2
|
|
|
|
|
4
|
|
59
|
|
|
|
|
|
|
my $class = shift; |
60
|
2
|
|
|
|
|
6
|
|
61
|
|
|
|
|
|
|
%config = @_; |
62
|
2
|
|
50
|
|
|
16
|
|
63
|
2
|
50
|
33
|
|
|
18
|
$config{prefix} ||= 'inc'; |
64
|
2
|
|
33
|
|
|
143
|
$config{author} ||= ( $^O eq 'VMS' ? '_author' : '.author' ); |
65
|
|
|
|
|
|
|
$config{base} ||= Cwd::abs_path($FindBin::Bin); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# Stripping leading prefix, if this import was called |
68
|
2
|
|
|
|
|
38
|
# from loader (inc::Module::Build::Functions) |
69
|
|
|
|
|
|
|
$class =~ s/^\Q$config{prefix}\E:://; |
70
|
2
|
|
33
|
|
|
14
|
|
71
|
2
|
|
33
|
|
|
41
|
$config{name} ||= $class; |
72
|
|
|
|
|
|
|
$config{version} ||= $class->VERSION; |
73
|
2
|
50
|
|
|
|
11
|
|
74
|
2
|
|
|
|
|
6
|
unless ( $config{path} ) { |
75
|
2
|
|
|
|
|
11
|
$config{path} = $config{name}; |
76
|
|
|
|
|
|
|
$config{path} =~ s!::!/!g; |
77
|
2
|
|
33
|
|
|
21
|
} |
78
|
|
|
|
|
|
|
$config{file} ||= "$config{base}/$config{prefix}/$config{path}.pm"; |
79
|
2
|
50
|
33
|
|
|
55
|
|
|
|
|
33
|
|
|
|
|
80
|
0
|
|
|
|
|
0
|
unless ( -f $config{file} || $0 ne 'Build.PL' && $0 ne 'Makefile.PL' ) { |
81
|
|
|
|
|
|
|
File::Path::mkpath("$config{prefix}/$config{author}"); |
82
|
|
|
|
|
|
|
|
83
|
0
|
|
|
|
|
0
|
# Bundling its own copy to ./inc |
84
|
|
|
|
|
|
|
_copy( $INC{"$config{path}.pm"} => $config{file} ); |
85
|
0
|
0
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
86
|
0
|
|
|
|
|
0
|
unless ( grep { $_ eq $config{prefix} } @INC ) { |
87
|
|
|
|
|
|
|
unshift @INC, $config{prefix}; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
} |
90
|
2
|
50
|
|
|
|
8
|
|
91
|
0
|
|
|
|
|
0
|
if (defined $config{build_class}) { |
92
|
|
|
|
|
|
|
$DB::single = 1; |
93
|
0
|
|
|
|
|
0
|
|
94
|
|
|
|
|
|
|
build_class($config{build_class}); |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
{ |
98
|
|
|
|
|
|
|
# The export should be performed 1 level up, since we call |
99
|
2
|
|
|
|
|
3
|
# Exporter's 'import' from our 'import' |
|
2
|
|
|
|
|
5
|
|
100
|
|
|
|
|
|
|
local $Exporter::ExportLevel = 1; |
101
|
|
|
|
|
|
|
|
102
|
2
|
|
|
|
|
1166
|
# Delegating back to Exporter's import |
103
|
|
|
|
|
|
|
&Exporter::import($class); |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
} ## end sub import |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
# Copy a single package to inc/, with its @ISA tree (note, dependencies are skipped) |
109
|
0
|
|
|
0
|
0
|
0
|
sub copy_package { |
110
|
|
|
|
|
|
|
my ( $pkg, $skip_isa ) = @_; |
111
|
0
|
|
|
|
|
0
|
|
112
|
0
|
|
|
|
|
0
|
my $file = $pkg; |
113
|
|
|
|
|
|
|
$file =~ s!::!/!g; |
114
|
0
|
|
|
|
|
0
|
|
115
|
|
|
|
|
|
|
my $pathname = "$file.pm"; |
116
|
|
|
|
|
|
|
|
117
|
0
|
0
|
|
|
|
0
|
# Do not re-require packages |
118
|
0
|
0
|
|
|
|
0
|
eval "require $pkg" unless $INC{$pathname}; |
119
|
|
|
|
|
|
|
die "The package [$pkg] not found and cannot be added to ./inc" if $@; |
120
|
0
|
|
|
|
|
0
|
|
121
|
0
|
0
|
|
|
|
0
|
$file = "$config{prefix}/$file.pm"; |
122
|
|
|
|
|
|
|
return if -f $file; # prevents infinite recursion |
123
|
0
|
|
|
|
|
0
|
|
124
|
|
|
|
|
|
|
_copy( $INC{$pathname} => $file ); |
125
|
0
|
0
|
|
|
|
0
|
|
126
|
0
|
|
|
|
|
0
|
unless ($skip_isa) { |
127
|
|
|
|
|
|
|
my @isa = eval '@' . $pkg . '::ISA'; |
128
|
0
|
|
|
|
|
0
|
|
129
|
|
|
|
|
|
|
copy_package($_) foreach (@isa); |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
} ## end sub copy_package |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# POD-stripping enabled copy function |
134
|
0
|
|
|
0
|
|
0
|
sub _copy { |
135
|
|
|
|
|
|
|
my ( $from, $to ) = @_; |
136
|
0
|
|
|
|
|
0
|
|
137
|
0
|
|
|
|
|
0
|
my @parts = split( '/', $to ); |
138
|
|
|
|
|
|
|
File::Path::mkpath( [ join( '/', @parts[ 0 .. $#parts - 1 ] ) ] ); |
139
|
0
|
|
|
|
|
0
|
|
140
|
|
|
|
|
|
|
chomp $to; |
141
|
0
|
|
|
|
|
0
|
|
142
|
0
|
0
|
|
|
|
0
|
local ( *FROM, *TO, $_ ); |
143
|
0
|
0
|
|
|
|
0
|
open FROM, "< $from" or die "Can't open $from for input:\n$!"; |
144
|
0
|
|
|
|
|
0
|
open TO, "> $to" or die "Can't open $to for output:\n$!"; |
145
|
|
|
|
|
|
|
print TO "#line 1\n"; |
146
|
0
|
|
|
|
|
0
|
|
147
|
|
|
|
|
|
|
my $content; |
148
|
|
|
|
|
|
|
my $in_pod; |
149
|
0
|
|
|
|
|
0
|
|
150
|
0
|
0
|
0
|
|
|
0
|
while () { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
151
|
0
|
|
|
|
|
0
|
if (/^=(?:b(?:egin|ack)|head\d|(?:po|en)d|item|(?:ove|fo)r)/) { |
152
|
|
|
|
|
|
|
$in_pod = 1; |
153
|
0
|
|
|
|
|
0
|
} elsif ( /^=cut\s*\z/ and $in_pod ) { |
154
|
0
|
|
|
|
|
0
|
$in_pod = 0; |
155
|
|
|
|
|
|
|
print TO "#line $.\n"; |
156
|
0
|
|
|
|
|
0
|
} elsif ( !$in_pod ) { |
157
|
|
|
|
|
|
|
print TO $_; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
} |
160
|
0
|
|
|
|
|
0
|
|
161
|
0
|
|
|
|
|
0
|
close FROM; |
162
|
|
|
|
|
|
|
close TO; |
163
|
0
|
|
|
|
|
0
|
|
164
|
|
|
|
|
|
|
print "include $to\n"; |
165
|
|
|
|
|
|
|
} ## end sub _copy |
166
|
|
|
|
|
|
|
|
167
|
3
|
|
|
3
|
|
11
|
BEGIN { |
168
|
|
|
|
|
|
|
$VERSION = '0.02'; |
169
|
3
|
|
|
|
|
11
|
|
170
|
|
|
|
|
|
|
*inc::Module::Build::Functions::VERSION = *VERSION; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
# Very important line which turns a loader (inc::Module::Build::Functions) |
173
|
3
|
|
|
|
|
105
|
# into our subclass, thus provides an 'import' function to it |
174
|
|
|
|
|
|
|
@inc::Module::Build::Functions::ISA = __PACKAGE__; |
175
|
3
|
|
|
|
|
377323
|
|
176
|
|
|
|
|
|
|
require Module::Build; |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
# Module implementation here |
179
|
|
|
|
|
|
|
|
180
|
3
|
50
|
|
|
|
1102330
|
# Set defaults. |
181
|
3
|
|
|
|
|
11
|
if ( $Module::Build::VERSION >= 0.28 ) { |
182
|
3
|
|
|
|
|
8
|
$ARGS{create_packlist} = 1; |
183
|
|
|
|
|
|
|
$mb_required = '0.28'; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
3
|
|
|
|
|
58
|
%FLAGS = ( |
187
|
|
|
|
|
|
|
'create_makefile_pl' => [ '0.19', 0 ], |
188
|
|
|
|
|
|
|
'c_source' => [ '0.04', 0 ], |
189
|
|
|
|
|
|
|
'dist_abstract' => [ '0.20', 0 ], |
190
|
|
|
|
|
|
|
'dist_name' => [ '0.11', 0 ], |
191
|
|
|
|
|
|
|
'dist_version' => [ '0.11', 0 ], |
192
|
|
|
|
|
|
|
'dist_version_from' => [ '0.11', 0 ], |
193
|
|
|
|
|
|
|
'installdirs' => [ '0.19', 0 ], |
194
|
|
|
|
|
|
|
'license' => [ '0.11', 0 ], |
195
|
|
|
|
|
|
|
'create_packlist' => [ '0.28', 1 ], |
196
|
|
|
|
|
|
|
'create_readme' => [ '0.22', 1 ], |
197
|
|
|
|
|
|
|
'create_license' => [ '0.31', 1 ], |
198
|
|
|
|
|
|
|
'dynamic_config' => [ '0.07', 1 ], |
199
|
|
|
|
|
|
|
'use_tap_harness' => [ '0.30', 1 ], |
200
|
|
|
|
|
|
|
'sign' => [ '0.16', 1 ], |
201
|
|
|
|
|
|
|
'recursive_test_files' => [ '0.28', 1 ], |
202
|
|
|
|
|
|
|
); |
203
|
3
|
|
|
|
|
45
|
|
204
|
|
|
|
|
|
|
%ALIASES = ( |
205
|
|
|
|
|
|
|
'test_requires' => 'build_requires', |
206
|
|
|
|
|
|
|
'abstract' => 'dist_abstract', |
207
|
|
|
|
|
|
|
'name' => 'module_name', |
208
|
|
|
|
|
|
|
'author' => 'dist_author', |
209
|
|
|
|
|
|
|
'version' => 'dist_version', |
210
|
|
|
|
|
|
|
'version_from' => 'dist_version_from', |
211
|
|
|
|
|
|
|
'extra_compiler_flag' => 'extra_compiler_flags', |
212
|
|
|
|
|
|
|
'extra_linker_flag' => 'extra_linker_flags', |
213
|
|
|
|
|
|
|
'include_dir' => 'include_dirs', |
214
|
|
|
|
|
|
|
'pl_file' => 'PL_files', |
215
|
|
|
|
|
|
|
'pl_files' => 'PL_files', |
216
|
|
|
|
|
|
|
'PL_file' => 'PL_files', |
217
|
|
|
|
|
|
|
'pm_file' => 'pm_files', |
218
|
|
|
|
|
|
|
'pod_file' => 'pod_files', |
219
|
|
|
|
|
|
|
'xs_file' => 'xs_files', |
220
|
|
|
|
|
|
|
'test_file' => 'test_files', |
221
|
|
|
|
|
|
|
'script_file' => 'script_files', |
222
|
|
|
|
|
|
|
); |
223
|
3
|
|
|
|
|
15
|
|
224
|
|
|
|
|
|
|
%ARRAY = ( |
225
|
|
|
|
|
|
|
'autosplit' => '0.04', |
226
|
|
|
|
|
|
|
'add_to_cleanup' => '0.19', |
227
|
|
|
|
|
|
|
'include_dirs' => '0.24', |
228
|
|
|
|
|
|
|
'dist_author' => '0.20', |
229
|
|
|
|
|
|
|
); |
230
|
3
|
|
|
|
|
38
|
|
231
|
|
|
|
|
|
|
%HASH = ( |
232
|
|
|
|
|
|
|
'configure_requires' => [ '0.30', 1 ], |
233
|
|
|
|
|
|
|
'build_requires' => [ '0.07', 1 ], |
234
|
|
|
|
|
|
|
'conflicts' => [ '0.07', 1 ], |
235
|
|
|
|
|
|
|
'recommends' => [ '0.08', 1 ], |
236
|
|
|
|
|
|
|
'requires' => [ '0.07', 1 ], |
237
|
|
|
|
|
|
|
'get_options' => [ '0.26', 0 ], |
238
|
|
|
|
|
|
|
'meta_add' => [ '0.28', 0 ], |
239
|
|
|
|
|
|
|
'pm_files' => [ '0.19', 0 ], |
240
|
|
|
|
|
|
|
'pod_files' => [ '0.19', 0 ], |
241
|
|
|
|
|
|
|
'xs_files' => [ '0.19', 0 ], |
242
|
|
|
|
|
|
|
'install_path' => [ '0.19', 0 ], |
243
|
|
|
|
|
|
|
); |
244
|
3
|
|
|
|
|
60
|
|
245
|
|
|
|
|
|
|
@AUTOLOADED = ( keys %HASH, keys %ARRAY, keys %ALIASES, keys %FLAGS ); |
246
|
3
|
|
|
|
|
57
|
|
247
|
|
|
|
|
|
|
@DEFINED = qw( |
248
|
|
|
|
|
|
|
all_from abstract_from author_from license_from perl_version |
249
|
|
|
|
|
|
|
perl_version_from install_script install_as_core install_as_cpan |
250
|
|
|
|
|
|
|
install_as_site install_as_vendor WriteAll auto_install auto_bundle |
251
|
|
|
|
|
|
|
bundle bundle_deps auto_bundle_deps can_use can_run can_cc |
252
|
|
|
|
|
|
|
requires_external_bin requires_external_cc get_file check_nmake |
253
|
|
|
|
|
|
|
interactive release_testing automated_testing win32 winlike |
254
|
|
|
|
|
|
|
author_context install_share auto_features extra_compiler_flags |
255
|
|
|
|
|
|
|
extra_linker_flags module_name no_index PL_files script_files test_files |
256
|
|
|
|
|
|
|
tap_harness_args subclass create_build_script get_builder build_class |
257
|
|
|
|
|
|
|
repository bugtracker meta_merge cygwin |
258
|
3
|
|
|
|
|
34
|
); |
259
|
|
|
|
|
|
|
@EXPORT = ( 'AUTOLOAD', @DEFINED, @AUTOLOADED ); |
260
|
3
|
|
|
|
|
15187
|
|
261
|
|
|
|
|
|
|
$DB::single = 1; |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
} ## end BEGIN |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# The autoload handles 4 types of "similar" routines, for 45 names. |
266
|
12
|
|
|
12
|
|
18
|
sub AUTOLOAD { |
267
|
12
|
|
|
|
|
57
|
my $full_sub = $AUTOLOAD; |
268
|
|
|
|
|
|
|
my ($sub) = $AUTOLOAD =~ m{\A.*::([^:]*)\z}x; |
269
|
12
|
100
|
|
|
|
32
|
|
270
|
1
|
|
|
|
|
2
|
if ( exists $ALIASES{$sub} ) { |
271
|
1
|
|
|
3
|
1
|
46
|
my $alias = $ALIASES{$sub}; |
|
3
|
|
|
|
|
38
|
|
|
3
|
|
|
|
|
5
|
|
272
|
|
|
|
|
|
|
eval <<"END_OF_CODE"; |
273
|
|
|
|
|
|
|
sub $full_sub { |
274
|
|
|
|
|
|
|
$alias(\@_); |
275
|
|
|
|
|
|
|
return; |
276
|
|
|
|
|
|
|
} |
277
|
1
|
|
|
|
|
2
|
END_OF_CODE |
|
1
|
|
|
|
|
21
|
|
278
|
|
|
|
|
|
|
goto &{$full_sub}; |
279
|
|
|
|
|
|
|
} |
280
|
11
|
100
|
|
|
|
23
|
|
281
|
6
|
|
|
|
|
13
|
if ( exists $FLAGS{$sub} ) { |
282
|
6
|
100
|
|
|
|
15
|
my $boolean_version = $FLAGS{$sub}[0]; |
283
|
6
|
100
|
|
|
|
13
|
my $boolean_default = $FLAGS{$sub}[1] ? ' || 1' : q{}; |
284
|
6
|
|
50
|
1
|
1
|
372
|
my $boolean_normal = $FLAGS{$sub}[1] ? q{!!} : q{}; |
|
1
|
|
50
|
1
|
1
|
6
|
|
|
1
|
|
|
1
|
1
|
2
|
|
|
1
|
|
|
1
|
1
|
4
|
|
|
1
|
|
|
1
|
1
|
2
|
|
|
1
|
|
|
1
|
1
|
3
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
2
|
|
285
|
|
|
|
|
|
|
eval <<"END_OF_CODE"; |
286
|
|
|
|
|
|
|
sub $full_sub { |
287
|
|
|
|
|
|
|
my \$argument = shift$boolean_default; |
288
|
|
|
|
|
|
|
\$ARGS{$sub} = $boolean_normal \$argument; |
289
|
|
|
|
|
|
|
_mb_required('$boolean_version'); |
290
|
|
|
|
|
|
|
return; |
291
|
|
|
|
|
|
|
} |
292
|
6
|
|
|
|
|
7
|
END_OF_CODE |
|
6
|
|
|
|
|
144
|
|
293
|
|
|
|
|
|
|
goto &{$full_sub}; |
294
|
|
|
|
|
|
|
} ## end if ( exists $FLAGS{$sub...}) |
295
|
5
|
100
|
|
|
|
12
|
|
296
|
|
|
|
|
|
|
if ( exists $ARRAY{$sub} ) { |
297
|
2
|
|
|
|
|
4
|
|
298
|
2
|
|
|
|
|
9
|
my $array_version = $ARRAY{$sub}; |
299
|
|
|
|
|
|
|
my $code_array = <<"END_OF_CODE"; |
300
|
|
|
|
|
|
|
sub $full_sub { |
301
|
|
|
|
|
|
|
my \$argument = shift; |
302
|
|
|
|
|
|
|
if ( 'ARRAY' eq ref \$argument ) { |
303
|
|
|
|
|
|
|
foreach my \$f ( \@{\$argument} ) { |
304
|
|
|
|
|
|
|
$sub(\$f); |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
return; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
my \@array; |
310
|
|
|
|
|
|
|
if (exists \$ARGS{$sub}) { |
311
|
|
|
|
|
|
|
\$ARGS{$sub} = [ \@{ \$ARGS{$sub} }, \$argument ]; |
312
|
|
|
|
|
|
|
} else { |
313
|
|
|
|
|
|
|
\$ARGS{$sub} = [ \$argument ]; |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
_mb_required('$array_version'); |
316
|
|
|
|
|
|
|
return; |
317
|
|
|
|
|
|
|
} |
318
|
2
|
50
|
|
1
|
1
|
292
|
END_OF_CODE |
|
1
|
50
|
|
1
|
1
|
3
|
|
|
1
|
50
|
|
|
|
5
|
|
|
0
|
50
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
5
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
4
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
5
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
2
|
|
319
|
2
|
|
|
|
|
5
|
eval $code_array; |
|
2
|
|
|
|
|
53
|
|
320
|
|
|
|
|
|
|
goto &{$full_sub}; |
321
|
|
|
|
|
|
|
} ## end if ( exists $ARRAY{$sub...}) |
322
|
3
|
50
|
|
|
|
8
|
|
323
|
3
|
|
|
|
|
6
|
if ( exists $HASH{$sub} ) { |
324
|
3
|
|
|
|
|
4
|
_create_hashref($sub); |
325
|
3
|
50
|
|
|
|
7
|
my $hash_version = $HASH{$sub}[0]; |
326
|
3
|
|
|
|
|
13
|
my $hash_default = $HASH{$sub}[1] ? ' || 0' : q{}; |
327
|
|
|
|
|
|
|
my $code_hash = <<"END_OF_CODE"; |
328
|
|
|
|
|
|
|
sub $full_sub { |
329
|
|
|
|
|
|
|
my \$argument1 = shift; |
330
|
|
|
|
|
|
|
my \$argument2 = shift$hash_default; |
331
|
|
|
|
|
|
|
if ( 'HASH' eq ref \$argument1 ) { |
332
|
|
|
|
|
|
|
my ( \$k, \$v ); |
333
|
|
|
|
|
|
|
while ( ( \$k, \$v ) = each \%{\$argument1} ) { |
334
|
|
|
|
|
|
|
$sub( \$k, \$v ); |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
return; |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
\$ARGS{$sub}{\$argument1} = \$argument2; |
340
|
|
|
|
|
|
|
_mb_required('$hash_version'); |
341
|
|
|
|
|
|
|
return; |
342
|
|
|
|
|
|
|
} |
343
|
3
|
50
|
100
|
4
|
1
|
344
|
END_OF_CODE |
|
4
|
50
|
50
|
1
|
1
|
7
|
|
|
4
|
50
|
100
|
3
|
1
|
12
|
|
|
4
|
|
|
|
|
10
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
45
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
4
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
11
|
|
|
3
|
|
|
|
|
7
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
6
|
|
344
|
3
|
|
|
|
|
5
|
eval $code_hash; |
|
3
|
|
|
|
|
64
|
|
345
|
|
|
|
|
|
|
goto &{$full_sub}; |
346
|
|
|
|
|
|
|
} ## end if ( exists $HASH{$sub...}) |
347
|
0
|
|
|
|
|
0
|
|
348
|
|
|
|
|
|
|
croak "$sub cannot be found"; |
349
|
|
|
|
|
|
|
} ## end sub AUTOLOAD |
350
|
|
|
|
|
|
|
|
351
|
17
|
|
|
17
|
|
20
|
sub _mb_required { |
352
|
17
|
100
|
|
|
|
49
|
my $version = shift; |
353
|
4
|
|
|
|
|
5
|
if ( $version > $mb_required ) { |
354
|
|
|
|
|
|
|
$mb_required = $version; |
355
|
17
|
|
|
|
|
268
|
} |
356
|
|
|
|
|
|
|
return; |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
0
|
0
|
|
0
|
|
0
|
sub _installdir { |
360
|
0
|
0
|
|
|
|
0
|
return $Config{'sitelibexp'} unless ( defined $ARGS{install_type} ); |
361
|
0
|
0
|
|
|
|
0
|
return $Config{'sitelibexp'} if ( 'site' eq $ARGS{install_type} ); |
362
|
0
|
0
|
|
|
|
0
|
return $Config{'privlibexp'} if ( 'perl' eq $ARGS{install_type} ); |
363
|
0
|
|
|
|
|
0
|
return $Config{'vendorlibexp'} if ( 'vendor' eq $ARGS{install_type} ); |
364
|
|
|
|
|
|
|
croak 'Invalid install type'; |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
0
|
|
|
0
|
|
0
|
sub _create_arrayref { |
368
|
0
|
0
|
|
|
|
0
|
my $name = shift; |
369
|
0
|
|
|
|
|
0
|
unless ( exists $ARGS{$name} ) { |
370
|
|
|
|
|
|
|
$ARGS{$name} = []; |
371
|
0
|
|
|
|
|
0
|
} |
372
|
|
|
|
|
|
|
return; |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
|
376
|
3
|
|
|
3
|
|
5
|
sub _create_hashref { |
377
|
3
|
50
|
|
|
|
7
|
my $name = shift; |
378
|
3
|
|
|
|
|
6
|
unless ( exists $ARGS{$name} ) { |
379
|
|
|
|
|
|
|
$ARGS{$name} = {}; |
380
|
3
|
|
|
|
|
6
|
} |
381
|
|
|
|
|
|
|
return; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
0
|
|
|
0
|
|
0
|
sub _create_hashref_arrayref { |
385
|
0
|
|
|
|
|
0
|
my $name1 = shift; |
386
|
0
|
0
|
|
|
|
0
|
my $name2 = shift; |
387
|
0
|
|
|
|
|
0
|
unless ( exists $ARGS{$name1}{$name2} ) { |
388
|
|
|
|
|
|
|
$ARGS{$name1}{$name2} = []; |
389
|
0
|
|
|
|
|
0
|
} |
390
|
|
|
|
|
|
|
return; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
0
|
|
|
0
|
|
0
|
sub _slurp_file { |
394
|
0
|
|
|
|
|
0
|
my $name = shift; |
395
|
|
|
|
|
|
|
my $file_handle; |
396
|
0
|
0
|
|
|
|
0
|
|
397
|
0
|
|
|
|
|
0
|
if ( $] < 5.006 ) { |
398
|
0
|
|
|
|
|
0
|
require Symbol; |
399
|
0
|
0
|
|
|
|
0
|
$file_handle = Symbol::gensym(); |
400
|
|
|
|
|
|
|
open $file_handle, "<$name" |
401
|
|
|
|
|
|
|
or croak $!; |
402
|
0
|
0
|
|
|
|
0
|
} else { |
403
|
|
|
|
|
|
|
open $file_handle, '<', $name |
404
|
|
|
|
|
|
|
or croak $!; |
405
|
|
|
|
|
|
|
} |
406
|
0
|
|
|
|
|
0
|
|
407
|
0
|
|
|
|
|
0
|
local $/ = undef; # enable localized slurp mode |
408
|
|
|
|
|
|
|
my $content = <$file_handle>; |
409
|
0
|
|
|
|
|
0
|
|
410
|
0
|
|
|
|
|
0
|
close $file_handle; |
411
|
|
|
|
|
|
|
return $content; |
412
|
|
|
|
|
|
|
} ## end sub _slurp_file |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
# Module::Install syntax below. |
415
|
|
|
|
|
|
|
|
416
|
0
|
|
|
0
|
1
|
0
|
sub all_from { |
417
|
|
|
|
|
|
|
my $file = shift; |
418
|
0
|
|
|
|
|
0
|
|
419
|
0
|
|
|
|
|
0
|
abstract_from($file); |
420
|
0
|
|
|
|
|
0
|
author_from($file); |
421
|
0
|
|
|
|
|
0
|
version_from($file); |
422
|
0
|
|
|
|
|
0
|
license_from($file); |
423
|
0
|
|
|
|
|
0
|
perl_version_from($file); |
424
|
|
|
|
|
|
|
return; |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
|
427
|
0
|
|
|
0
|
1
|
0
|
sub abstract_from { |
428
|
|
|
|
|
|
|
my $file = shift; |
429
|
0
|
|
|
|
|
0
|
|
430
|
0
|
|
|
|
|
0
|
require ExtUtils::MM_Unix; |
431
|
|
|
|
|
|
|
abstract( |
432
|
|
|
|
|
|
|
bless( { DISTNAME => $ARGS{module_name} }, 'ExtUtils::MM_Unix' ) |
433
|
|
|
|
|
|
|
->parse_abstract($file) ); |
434
|
0
|
|
|
|
|
0
|
|
435
|
|
|
|
|
|
|
return; |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
# Borrowed from Module::Install::Metadata->author_from |
439
|
0
|
|
|
0
|
1
|
0
|
sub author_from { |
440
|
0
|
|
|
|
|
0
|
my $file = shift; |
441
|
0
|
|
|
|
|
0
|
my $content = _slurp_file($file); |
442
|
|
|
|
|
|
|
my $author; |
443
|
0
|
0
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
|
444
|
|
|
|
|
|
|
if ($content =~ m{ |
445
|
|
|
|
|
|
|
=head \d \s+ (?:authors?)\b \s* |
446
|
|
|
|
|
|
|
(.*?) |
447
|
|
|
|
|
|
|
=head \d |
448
|
|
|
|
|
|
|
}ixms |
449
|
|
|
|
|
|
|
) |
450
|
|
|
|
|
|
|
{ |
451
|
|
|
|
|
|
|
|
452
|
0
|
|
|
|
|
0
|
# Grab all author lines. |
453
|
|
|
|
|
|
|
my $authors = $1; |
454
|
|
|
|
|
|
|
|
455
|
0
|
|
|
|
|
0
|
# Now break up each line. |
456
|
0
|
|
|
|
|
0
|
while ( $authors =~ m{\G([^\n]+) \s*}gcixms ) { |
457
|
|
|
|
|
|
|
$author = $1; |
458
|
|
|
|
|
|
|
|
459
|
0
|
|
|
|
|
0
|
# Convert E and E into the right characters. |
460
|
0
|
|
|
|
|
0
|
$author =~ s{E}{<}g; |
461
|
|
|
|
|
|
|
$author =~ s{E}{>}g; |
462
|
|
|
|
|
|
|
|
463
|
0
|
0
|
|
|
|
0
|
# Remove new-style C<< >> markers. |
464
|
0
|
|
|
|
|
0
|
if ( $author =~ m{\A(.*?) \s* C<< \s* (.*?) \s* >>}msx ) { |
465
|
|
|
|
|
|
|
$author = "$1 $2"; |
466
|
0
|
|
|
|
|
0
|
} |
467
|
|
|
|
|
|
|
dist_author($author); |
468
|
|
|
|
|
|
|
} ## end while ( $authors =~ m{\G([^\n]+) \s*}gcixms) |
469
|
|
|
|
|
|
|
} elsif ( |
470
|
|
|
|
|
|
|
$content =~ m{ |
471
|
|
|
|
|
|
|
=head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* |
472
|
|
|
|
|
|
|
.*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* |
473
|
|
|
|
|
|
|
([^\n]*) |
474
|
|
|
|
|
|
|
}ixms |
475
|
|
|
|
|
|
|
) |
476
|
0
|
|
|
|
|
0
|
{ |
477
|
|
|
|
|
|
|
$author = $1; |
478
|
|
|
|
|
|
|
|
479
|
0
|
|
|
|
|
0
|
# Convert E and E into the right characters. |
480
|
0
|
|
|
|
|
0
|
$author =~ s{E}{<}g; |
481
|
|
|
|
|
|
|
$author =~ s{E}{>}g; |
482
|
|
|
|
|
|
|
|
483
|
0
|
0
|
|
|
|
0
|
# Remove new-style C<< >> markers. |
484
|
0
|
|
|
|
|
0
|
if ( $author =~ m{\A(.*?) \s* C<< \s* (.*?) \s* >>}msx ) { |
485
|
|
|
|
|
|
|
$author = "$1 $2"; |
486
|
0
|
|
|
|
|
0
|
} |
487
|
|
|
|
|
|
|
dist_author($author); |
488
|
0
|
|
|
|
|
0
|
} else { |
489
|
|
|
|
|
|
|
carp "Cannot determine author info from $file"; |
490
|
|
|
|
|
|
|
} |
491
|
0
|
|
|
|
|
0
|
|
492
|
|
|
|
|
|
|
return; |
493
|
|
|
|
|
|
|
} ## end sub author_from |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
# Borrowed from Module::Install::Metadata->license_from |
496
|
0
|
|
|
0
|
1
|
0
|
sub license_from { |
497
|
0
|
|
|
|
|
0
|
my $file = shift; |
498
|
0
|
0
|
|
|
|
0
|
my $content = _slurp_file($file); |
499
|
|
|
|
|
|
|
if ($content =~ m{ |
500
|
|
|
|
|
|
|
( |
501
|
|
|
|
|
|
|
=head \d \s+ |
502
|
|
|
|
|
|
|
(?:licen[cs]e|licensing|copyright|legal)\b |
503
|
|
|
|
|
|
|
.*? |
504
|
|
|
|
|
|
|
) |
505
|
|
|
|
|
|
|
(=head\\d.*|=cut.*|) |
506
|
|
|
|
|
|
|
\z |
507
|
|
|
|
|
|
|
}ixms |
508
|
|
|
|
|
|
|
) |
509
|
0
|
|
|
|
|
0
|
{ |
510
|
|
|
|
|
|
|
my $license_text = $1; |
511
|
0
|
|
|
|
|
0
|
#<<< |
512
|
|
|
|
|
|
|
my @phrases = ( |
513
|
|
|
|
|
|
|
'under the same (?:terms|license) as perl itself' => 'perl', 1, |
514
|
|
|
|
|
|
|
'GNU general public license' => 'gpl', 1, |
515
|
|
|
|
|
|
|
'GNU public license' => 'gpl', 1, |
516
|
|
|
|
|
|
|
'GNU lesser general public license' => 'lgpl', 1, |
517
|
|
|
|
|
|
|
'GNU lesser public license' => 'lgpl', 1, |
518
|
|
|
|
|
|
|
'GNU library general public license' => 'lgpl', 1, |
519
|
|
|
|
|
|
|
'GNU library public license' => 'lgpl', 1, |
520
|
|
|
|
|
|
|
'BSD license' => 'bsd', 1, |
521
|
|
|
|
|
|
|
'Artistic license' => 'artistic', 1, |
522
|
|
|
|
|
|
|
'GPL' => 'gpl', 1, |
523
|
|
|
|
|
|
|
'LGPL' => 'lgpl', 1, |
524
|
|
|
|
|
|
|
'BSD' => 'bsd', 1, |
525
|
|
|
|
|
|
|
'Artistic' => 'artistic', 1, |
526
|
|
|
|
|
|
|
'MIT' => 'mit', 1, |
527
|
|
|
|
|
|
|
'proprietary' => 'restrictive', 0, |
528
|
|
|
|
|
|
|
); |
529
|
0
|
|
|
|
|
0
|
#>>> |
530
|
0
|
|
|
|
|
0
|
while ( my ( $pattern, $license, $osi ) = splice @phrases, 0, 3 ) { |
531
|
0
|
0
|
|
|
|
0
|
$pattern =~ s{\s+}{\\s+}g; |
532
|
0
|
|
|
|
|
0
|
if ( $license_text =~ /\b$pattern\b/ix ) { |
533
|
0
|
|
|
|
|
0
|
license($license); |
534
|
|
|
|
|
|
|
return; |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
} |
537
|
|
|
|
|
|
|
} ## end if ( $content =~ m{ ) (}) |
538
|
0
|
|
|
|
|
0
|
|
539
|
0
|
|
|
|
|
0
|
carp "Cannot determine license info from $file"; |
540
|
0
|
|
|
|
|
0
|
license('unknown'); |
541
|
|
|
|
|
|
|
return; |
542
|
|
|
|
|
|
|
} ## end sub license_from |
543
|
|
|
|
|
|
|
|
544
|
1
|
|
|
1
|
1
|
4
|
sub perl_version { |
545
|
1
|
|
|
|
|
2
|
requires( 'perl', @_ ); |
546
|
|
|
|
|
|
|
return; |
547
|
|
|
|
|
|
|
} |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
# Borrowed from Module::Install::Metadata->license_from |
550
|
0
|
|
|
0
|
1
|
0
|
sub perl_version_from { |
551
|
0
|
|
|
|
|
0
|
my $file = shift; |
552
|
0
|
0
|
|
|
|
0
|
my $content = _slurp_file($file); |
553
|
|
|
|
|
|
|
if ($content =~ m{ |
554
|
|
|
|
|
|
|
^ # Start of LINE, not start of STRING. |
555
|
|
|
|
|
|
|
(?:use|require) \s* |
556
|
|
|
|
|
|
|
v? |
557
|
|
|
|
|
|
|
([\d_\.]+) |
558
|
|
|
|
|
|
|
\s* ; |
559
|
|
|
|
|
|
|
}ixms |
560
|
|
|
|
|
|
|
) |
561
|
0
|
|
|
|
|
0
|
{ |
562
|
0
|
|
|
|
|
0
|
my $perl_version = $1; |
563
|
0
|
|
|
|
|
0
|
$perl_version =~ s{_}{}g; |
564
|
|
|
|
|
|
|
perl_version($perl_version); |
565
|
0
|
|
|
|
|
0
|
} else { |
566
|
|
|
|
|
|
|
carp "Cannot determine perl version info from $file"; |
567
|
|
|
|
|
|
|
} |
568
|
0
|
|
|
|
|
0
|
|
569
|
|
|
|
|
|
|
return; |
570
|
|
|
|
|
|
|
} ## end sub perl_version_from |
571
|
|
|
|
|
|
|
|
572
|
0
|
|
|
0
|
1
|
0
|
sub install_script { |
573
|
0
|
|
|
|
|
0
|
my @scripts = @_; |
574
|
0
|
0
|
0
|
|
|
0
|
foreach my $script (@scripts) { |
|
|
0
|
|
|
|
|
|
575
|
0
|
|
|
|
|
0
|
if ( -f $script ) { |
576
|
|
|
|
|
|
|
script_files($_); |
577
|
0
|
|
|
|
|
0
|
} elsif ( -d 'script' and -f "script/$script" ) { |
578
|
|
|
|
|
|
|
script_files("script/$script"); |
579
|
0
|
|
|
|
|
0
|
} else { |
580
|
|
|
|
|
|
|
croak "Cannot find script '$script'"; |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
} |
583
|
0
|
|
|
|
|
0
|
|
584
|
|
|
|
|
|
|
return; |
585
|
|
|
|
|
|
|
} ## end sub install_script |
586
|
|
|
|
|
|
|
|
587
|
0
|
|
|
0
|
1
|
0
|
sub install_as_core { |
588
|
|
|
|
|
|
|
return installdirs('perl'); |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
|
591
|
0
|
|
|
0
|
1
|
0
|
sub install_as_cpan { |
592
|
|
|
|
|
|
|
return installdirs('site'); |
593
|
|
|
|
|
|
|
} |
594
|
|
|
|
|
|
|
|
595
|
0
|
|
|
0
|
1
|
0
|
sub install_as_site { |
596
|
|
|
|
|
|
|
return installdirs('site'); |
597
|
|
|
|
|
|
|
} |
598
|
|
|
|
|
|
|
|
599
|
0
|
|
|
0
|
1
|
0
|
sub install_as_vendor { |
600
|
|
|
|
|
|
|
return installdirs('vendor'); |
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
|
603
|
0
|
|
|
0
|
1
|
0
|
sub WriteAll { ## no critic(Capitalization) |
604
|
0
|
|
|
|
|
0
|
my $answer = create_build_script(); |
605
|
|
|
|
|
|
|
return $answer; |
606
|
|
|
|
|
|
|
} |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
# Module::Install::AutoInstall |
609
|
|
|
|
|
|
|
|
610
|
0
|
|
|
0
|
1
|
0
|
sub auto_install { |
611
|
|
|
|
|
|
|
croak 'auto_install is deprecated'; |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
# Module::Install::Bundle |
615
|
|
|
|
|
|
|
|
616
|
0
|
|
|
0
|
1
|
0
|
sub auto_bundle { |
617
|
|
|
|
|
|
|
croak 'auto_bundle is deprecated'; |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
|
620
|
0
|
|
|
0
|
1
|
0
|
sub bundle { |
621
|
|
|
|
|
|
|
croak 'bundle is deprecated'; |
622
|
|
|
|
|
|
|
} |
623
|
|
|
|
|
|
|
|
624
|
0
|
|
|
0
|
1
|
0
|
sub bundle_deps { |
625
|
|
|
|
|
|
|
croak 'bundle_deps is deprecated'; |
626
|
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
|
628
|
0
|
|
|
0
|
1
|
0
|
sub auto_bundle_deps { |
629
|
|
|
|
|
|
|
croak 'auto_bundle_deps is deprecated'; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
# Module::Install::Can |
633
|
|
|
|
|
|
|
|
634
|
0
|
|
|
0
|
1
|
0
|
sub can_use { |
635
|
|
|
|
|
|
|
my ( $mod, $ver ) = @_; |
636
|
0
|
|
|
|
|
0
|
|
637
|
0
|
|
|
|
|
0
|
my $file = $mod; |
638
|
0
|
0
|
|
|
|
0
|
$file =~ s{::|\\}{/}g; |
639
|
|
|
|
|
|
|
$file .= '.pm' unless $file =~ /\.pm$/i; |
640
|
0
|
|
|
|
|
0
|
|
641
|
0
|
|
0
|
|
|
0
|
local $@ = undef; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
642
|
|
|
|
|
|
|
return eval { require $file; $mod->VERSION( $ver || 0 ); 1 }; |
643
|
|
|
|
|
|
|
} |
644
|
|
|
|
|
|
|
|
645
|
0
|
|
|
0
|
1
|
0
|
sub can_run { |
646
|
0
|
|
|
|
|
0
|
my $cmd = shift; |
647
|
0
|
0
|
|
|
|
0
|
require ExtUtils::MakeMaker; |
648
|
|
|
|
|
|
|
if ( $^O eq 'cygwin' ) { |
649
|
|
|
|
|
|
|
|
650
|
0
|
|
|
|
|
0
|
# MM->maybe_command is fixed in 6.51_01 for Cygwin. |
651
|
|
|
|
|
|
|
ExtUtils::MakeMaker->import(6.52); |
652
|
|
|
|
|
|
|
} |
653
|
0
|
|
|
|
|
0
|
|
654
|
0
|
0
|
0
|
|
|
0
|
my $_cmd = $cmd; |
655
|
|
|
|
|
|
|
return $_cmd if ( -x $_cmd or $_cmd = MM->maybe_command($_cmd) ); |
656
|
0
|
|
|
|
|
0
|
|
657
|
|
|
|
|
|
|
for my $dir ( ( split /$Config::Config{path_sep}/x, $ENV{PATH} ), q{.} ) |
658
|
0
|
0
|
|
|
|
0
|
{ |
659
|
0
|
|
|
|
|
0
|
next if $dir eq q{}; |
660
|
0
|
0
|
0
|
|
|
0
|
my $abs = File::Spec->catfile( $dir, $cmd ); |
661
|
|
|
|
|
|
|
return $abs if ( -x $abs or $abs = MM->maybe_command($abs) ); |
662
|
|
|
|
|
|
|
} |
663
|
0
|
|
|
|
|
0
|
|
664
|
|
|
|
|
|
|
return; |
665
|
|
|
|
|
|
|
} ## end sub can_run |
666
|
|
|
|
|
|
|
|
667
|
0
|
|
|
0
|
1
|
0
|
sub can_cc { |
668
|
0
|
|
|
|
|
0
|
return eval { |
669
|
0
|
|
|
|
|
0
|
require ExtUtils::CBuilder; |
670
|
|
|
|
|
|
|
ExtUtils::CBuilder->new()->have_compiler(); |
671
|
|
|
|
|
|
|
}; |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
# Module::Install::External |
675
|
|
|
|
|
|
|
|
676
|
0
|
|
|
0
|
1
|
0
|
sub requires_external_bin { |
677
|
0
|
0
|
|
|
|
0
|
my ( $bin, $version ) = @_; |
678
|
0
|
|
|
|
|
0
|
if ($version) { |
679
|
|
|
|
|
|
|
croak 'requires_external_bin does not support versions yet'; |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
|
682
|
0
|
|
|
|
|
0
|
# Locate the bin |
683
|
0
|
|
|
|
|
0
|
print "Locating required external dependency bin: $bin..."; |
684
|
0
|
0
|
|
|
|
0
|
my $found_bin = can_run($bin); |
685
|
0
|
|
|
|
|
0
|
if ($found_bin) { |
686
|
|
|
|
|
|
|
print " found at $found_bin.\n"; |
687
|
0
|
|
|
|
|
0
|
} else { |
688
|
0
|
|
|
|
|
0
|
print " missing.\n"; |
689
|
0
|
|
|
|
|
0
|
print "Unresolvable missing external dependency.\n"; |
690
|
0
|
|
|
|
|
0
|
print "Please install '$bin' seperately and try again.\n"; |
|
0
|
|
|
|
|
0
|
|
691
|
|
|
|
|
|
|
print {*STDERR} |
692
|
0
|
|
|
|
|
0
|
"NA: Unable to build distribution on this platform.\n"; |
693
|
|
|
|
|
|
|
exit 0; |
694
|
|
|
|
|
|
|
} |
695
|
0
|
|
|
|
|
0
|
|
696
|
|
|
|
|
|
|
return 1; |
697
|
|
|
|
|
|
|
} ## end sub requires_external_bin |
698
|
|
|
|
|
|
|
|
699
|
0
|
0
|
|
0
|
1
|
0
|
sub requires_external_cc { |
700
|
0
|
|
|
|
|
0
|
unless ( can_cc() ) { |
701
|
0
|
|
|
|
|
0
|
print "Unresolvable missing external dependency.\n"; |
702
|
0
|
|
|
|
|
0
|
print "This package requires a C compiler.\n"; |
|
0
|
|
|
|
|
0
|
|
703
|
|
|
|
|
|
|
print {*STDERR} |
704
|
0
|
|
|
|
|
0
|
"NA: Unable to build distribution on this platform.\n"; |
705
|
|
|
|
|
|
|
exit 0; |
706
|
|
|
|
|
|
|
} |
707
|
0
|
|
|
|
|
0
|
|
708
|
|
|
|
|
|
|
return 1; |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
# Module::Install::Fetch |
712
|
|
|
|
|
|
|
|
713
|
0
|
|
|
0
|
1
|
0
|
sub get_file { |
714
|
|
|
|
|
|
|
croak |
715
|
|
|
|
|
|
|
'get_file is not supported - replace by code in a Module::Build subclass.'; |
716
|
|
|
|
|
|
|
} |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
# Module::Install::Win32 |
719
|
|
|
|
|
|
|
|
720
|
0
|
|
|
0
|
1
|
0
|
sub check_nmake { |
721
|
|
|
|
|
|
|
croak |
722
|
|
|
|
|
|
|
'check_nmake is not supported - replace by code in a Module::Build subclass.'; |
723
|
|
|
|
|
|
|
} |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
# Module::Install::With |
726
|
|
|
|
|
|
|
|
727
|
0
|
|
|
0
|
1
|
0
|
sub release_testing { |
728
|
|
|
|
|
|
|
return !!$ENV{RELEASE_TESTING}; |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
|
731
|
0
|
|
|
0
|
1
|
0
|
sub automated_testing { |
732
|
|
|
|
|
|
|
return !!$ENV{AUTOMATED_TESTING}; |
733
|
|
|
|
|
|
|
} |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
# Mostly borrowed from Scalar::Util::openhandle, since I should |
736
|
|
|
|
|
|
|
# not use modules that were non-core in 5.005. |
737
|
0
|
|
|
0
|
|
0
|
sub _openhandle { |
738
|
0
|
|
0
|
|
|
0
|
my $fh = shift; |
739
|
|
|
|
|
|
|
my $rt = reftype($fh) || q{}; |
740
|
0
|
0
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
|
741
|
|
|
|
|
|
|
return ( ( defined fileno $fh ) ? $fh : undef ) |
742
|
|
|
|
|
|
|
if $rt eq 'IO'; |
743
|
0
|
0
|
|
|
|
0
|
|
744
|
0
|
|
|
|
|
0
|
if ( $rt ne 'GLOB' ) { |
745
|
|
|
|
|
|
|
return; |
746
|
|
|
|
|
|
|
} |
747
|
0
|
0
|
0
|
|
|
0
|
|
748
|
|
|
|
|
|
|
return ( tied *{$fh} or defined fileno $fh ) ? $fh : undef; |
749
|
|
|
|
|
|
|
} ## end sub _openhandle |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
# Mostly borrowed from IO::Interactive::is_interactive, since I should |
752
|
|
|
|
|
|
|
# not use modules that were non-core in 5.005. |
753
|
|
|
|
|
|
|
sub interactive { |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
# If we're doing automated testing, we assume that we don't have |
756
|
0
|
0
|
|
0
|
1
|
0
|
# a terminal, even if we otherwise would. |
757
|
|
|
|
|
|
|
return 0 if automated_testing(); |
758
|
|
|
|
|
|
|
|
759
|
0
|
0
|
|
|
|
0
|
# Not interactive if output is not to terminal... |
760
|
|
|
|
|
|
|
return 0 if not -t *STDOUT; |
761
|
|
|
|
|
|
|
|
762
|
0
|
0
|
|
|
|
0
|
# If *ARGV is opened, we're interactive if... |
763
|
|
|
|
|
|
|
if ( _openhandle(*ARGV) ) { |
764
|
|
|
|
|
|
|
|
765
|
0
|
0
|
0
|
|
|
0
|
# ...it's currently opened to the magic '-' file |
766
|
|
|
|
|
|
|
return -t *STDIN if defined $ARGV && $ARGV eq q{-}; |
767
|
|
|
|
|
|
|
|
768
|
0
|
0
|
0
|
|
|
0
|
# ...it's at end-of-file and the next file is the magic '-' file |
769
|
|
|
|
|
|
|
return @ARGV > 0 && $ARGV[0] eq q{-} && -t *STDIN if eof *ARGV; |
770
|
|
|
|
|
|
|
|
771
|
0
|
|
|
|
|
0
|
# ...it's directly attached to the terminal |
772
|
|
|
|
|
|
|
return -t *ARGV; |
773
|
|
|
|
|
|
|
} |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
# If *ARGV isn't opened, it will be interactive if *STDIN is attached |
776
|
|
|
|
|
|
|
# to a terminal. |
777
|
0
|
|
|
|
|
0
|
else { |
778
|
|
|
|
|
|
|
return -t *STDIN; |
779
|
|
|
|
|
|
|
} |
780
|
|
|
|
|
|
|
} ## end sub interactive |
781
|
|
|
|
|
|
|
|
782
|
0
|
|
|
0
|
1
|
0
|
sub win32 { |
783
|
|
|
|
|
|
|
return !!( $^O eq 'MSWin32' ); |
784
|
|
|
|
|
|
|
} |
785
|
|
|
|
|
|
|
|
786
|
0
|
|
|
0
|
1
|
0
|
sub cygwin { |
787
|
|
|
|
|
|
|
return !!( $^O eq 'cygwin' ); |
788
|
|
|
|
|
|
|
} |
789
|
|
|
|
|
|
|
|
790
|
0
|
|
0
|
0
|
1
|
0
|
sub winlike { |
791
|
|
|
|
|
|
|
return !!( $^O eq 'MSWin32' or $^O eq 'cygwin' ); |
792
|
|
|
|
|
|
|
} |
793
|
|
|
|
|
|
|
|
794
|
0
|
0
|
|
0
|
1
|
0
|
sub author_context { |
795
|
0
|
0
|
|
|
|
0
|
return 1 if -d 'inc/.author'; |
796
|
0
|
0
|
|
|
|
0
|
return 1 if -d 'inc/_author'; |
797
|
0
|
0
|
|
|
|
0
|
return 1 if -d '.svn'; |
798
|
0
|
0
|
|
|
|
0
|
return 1 if -f '.cvsignore'; |
799
|
0
|
0
|
|
|
|
0
|
return 1 if -f '.gitignore'; |
800
|
0
|
|
|
|
|
0
|
return 1 if -f 'MANIFEST.SKIP'; |
801
|
|
|
|
|
|
|
return 0; |
802
|
|
|
|
|
|
|
} |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
# Module::Install::Share |
805
|
|
|
|
|
|
|
|
806
|
0
|
|
|
0
|
|
0
|
sub _scan_dir { |
807
|
|
|
|
|
|
|
my ( $srcdir, $destdir, $unixdir, $type, $files ) = @_; |
808
|
0
|
|
|
|
|
0
|
|
809
|
|
|
|
|
|
|
my $type_files = $type . '_files'; |
810
|
0
|
0
|
|
|
|
0
|
|
811
|
|
|
|
|
|
|
$ARGS{$type_files} = {} unless exists $ARGS{"$type_files"}; |
812
|
0
|
|
|
|
|
0
|
|
813
|
|
|
|
|
|
|
my $dir_handle; |
814
|
0
|
0
|
|
|
|
0
|
|
815
|
0
|
|
|
|
|
0
|
if ( $] < 5.006 ) { |
816
|
0
|
|
|
|
|
0
|
require Symbol; |
817
|
|
|
|
|
|
|
$dir_handle = Symbol::gensym(); |
818
|
|
|
|
|
|
|
} |
819
|
0
|
0
|
|
|
|
0
|
|
820
|
|
|
|
|
|
|
opendir $dir_handle, $srcdir or croak $!; |
821
|
|
|
|
|
|
|
|
822
|
0
|
|
|
|
|
0
|
FILE: |
823
|
0
|
0
|
|
|
|
0
|
foreach my $direntry ( readdir $dir_handle ) { |
824
|
0
|
0
|
|
|
|
0
|
if ( -d catdir( $srcdir, $direntry ) ) { |
825
|
0
|
0
|
|
|
|
0
|
next FILE if ( $direntry eq q{.} ); |
826
|
0
|
|
|
|
|
0
|
next FILE if ( $direntry eq q{..} ); |
827
|
|
|
|
|
|
|
_scan_dir( |
828
|
|
|
|
|
|
|
catdir( $srcdir, $direntry ), |
829
|
|
|
|
|
|
|
catdir( $destdir, $direntry ), |
830
|
|
|
|
|
|
|
File::Spec::Unix->catdir( $unixdir, $direntry ), |
831
|
|
|
|
|
|
|
$type, |
832
|
|
|
|
|
|
|
$files |
833
|
|
|
|
|
|
|
); |
834
|
0
|
|
|
|
|
0
|
} else { |
835
|
0
|
|
|
|
|
0
|
my $sourcefile = catfile( $srcdir, $direntry ); |
836
|
0
|
0
|
|
|
|
0
|
my $unixfile = File::Spec::Unix->catfile( $unixdir, $direntry ); |
837
|
0
|
|
|
|
|
0
|
if ( exists $files->{$unixfile} ) { |
838
|
|
|
|
|
|
|
$ARGS{$type_files}{$sourcefile} = |
839
|
|
|
|
|
|
|
catfile( $destdir, $direntry ); |
840
|
|
|
|
|
|
|
} |
841
|
|
|
|
|
|
|
} |
842
|
|
|
|
|
|
|
} ## end foreach my $direntry ( readdir...) |
843
|
0
|
|
|
|
|
0
|
|
844
|
|
|
|
|
|
|
closedir $dir_handle; |
845
|
0
|
|
|
|
|
0
|
|
846
|
|
|
|
|
|
|
return; |
847
|
|
|
|
|
|
|
} ## end sub _scan_dir |
848
|
|
|
|
|
|
|
|
849
|
0
|
0
|
|
0
|
1
|
0
|
sub install_share { |
850
|
0
|
0
|
|
|
|
0
|
my $dir = @_ ? pop : 'share'; |
851
|
|
|
|
|
|
|
my $type = @_ ? shift : 'dist'; |
852
|
0
|
0
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
|
|
853
|
|
|
|
|
|
|
unless ( defined $type |
854
|
|
|
|
|
|
|
and ( ( $type eq 'module' ) or ( $type eq 'dist' ) ) ) |
855
|
0
|
|
|
|
|
0
|
{ |
856
|
|
|
|
|
|
|
croak "Illegal or invalid share dir type '$type'"; |
857
|
0
|
0
|
0
|
|
|
0
|
} |
858
|
0
|
|
|
|
|
0
|
unless ( defined $dir and -d $dir ) { |
859
|
|
|
|
|
|
|
croak 'Illegal or missing directory install_share param'; |
860
|
|
|
|
|
|
|
} |
861
|
0
|
|
|
|
|
0
|
|
862
|
0
|
|
|
|
|
0
|
require File::Spec::Unix; |
863
|
0
|
|
|
|
|
0
|
require ExtUtils::Manifest; |
864
|
0
|
0
|
|
|
|
0
|
my $files = ExtUtils::Manifest::maniread(); |
865
|
0
|
|
|
|
|
0
|
if ( 0 == scalar(%$files) ) { |
866
|
|
|
|
|
|
|
croak 'Empty or no MANIFEST file'; |
867
|
0
|
|
|
|
|
0
|
} |
868
|
|
|
|
|
|
|
my $installation_path; |
869
|
|
|
|
|
|
|
my $sharecode; |
870
|
0
|
0
|
|
|
|
0
|
|
871
|
0
|
0
|
|
|
|
0
|
if ( $type eq 'dist' ) { |
872
|
|
|
|
|
|
|
croak 'Too many parameters to install_share' if @_; |
873
|
0
|
|
|
|
|
0
|
|
874
|
|
|
|
|
|
|
my $dist = $ARGS{'dist_name'}; |
875
|
0
|
|
|
|
|
0
|
|
876
|
|
|
|
|
|
|
$installation_path = |
877
|
0
|
|
|
|
|
0
|
catdir( _installdir(), qw(auto share dist), $dist ); |
878
|
0
|
|
|
|
|
0
|
_scan_dir( $dir, 'share', $dir, 'share', $files ); |
879
|
0
|
|
|
|
|
0
|
push @install_types, 'share'; |
880
|
|
|
|
|
|
|
$sharecode = 'share'; |
881
|
0
|
|
|
|
|
0
|
} else { |
882
|
|
|
|
|
|
|
my $module = shift; |
883
|
0
|
0
|
|
|
|
0
|
|
884
|
0
|
|
|
|
|
0
|
unless ( defined $module ) { |
885
|
|
|
|
|
|
|
croak "Missing or invalid module name '$module'"; |
886
|
|
|
|
|
|
|
} |
887
|
0
|
|
|
|
|
0
|
|
888
|
0
|
|
|
|
|
0
|
$module =~ s/::/-/g; |
889
|
|
|
|
|
|
|
$installation_path = |
890
|
0
|
|
|
|
|
0
|
catdir( _installdir(), qw(auto share module), $module ); |
891
|
0
|
|
|
|
|
0
|
$sharecode = 'share_d' . $sharemod_used; |
892
|
0
|
|
|
|
|
0
|
_scan_dir( $dir, $sharecode, $dir, $sharecode, $files ); |
893
|
0
|
|
|
|
|
0
|
push @install_types, $sharecode; |
894
|
|
|
|
|
|
|
$sharemod_used++; |
895
|
|
|
|
|
|
|
} ## end else [ if ( $type eq 'dist' )] |
896
|
|
|
|
|
|
|
|
897
|
0
|
|
|
|
|
0
|
# Set the path to install to. |
898
|
|
|
|
|
|
|
install_path( $sharecode, $installation_path ); |
899
|
|
|
|
|
|
|
|
900
|
0
|
0
|
|
|
|
0
|
# This helps for testing purposes... |
901
|
|
|
|
|
|
|
if ( $Module::Build::VERSION >= 0.31 ) { |
902
|
0
|
|
|
0
|
|
0
|
Module::Build->add_property( $sharecode . '_files', |
|
0
|
|
|
|
|
0
|
|
903
|
|
|
|
|
|
|
default => sub { return {} } ); |
904
|
|
|
|
|
|
|
} |
905
|
|
|
|
|
|
|
|
906
|
0
|
|
|
|
|
0
|
# 99% of the time we don't want to index a shared dir |
907
|
|
|
|
|
|
|
no_index($dir); |
908
|
|
|
|
|
|
|
|
909
|
0
|
|
|
|
|
0
|
# This construction requires 0.26. |
910
|
0
|
|
|
|
|
0
|
_mb_required('0.26'); |
911
|
|
|
|
|
|
|
return; |
912
|
|
|
|
|
|
|
} ## end sub install_share |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
# Module::Build syntax |
915
|
|
|
|
|
|
|
|
916
|
0
|
|
|
0
|
|
0
|
sub _af_hashref { |
917
|
0
|
0
|
|
|
|
0
|
my $feature = shift; |
918
|
0
|
|
|
|
|
0
|
unless ( exists $ARGS{auto_features} ) { |
919
|
|
|
|
|
|
|
$ARGS{auto_features} = {}; |
920
|
0
|
0
|
|
|
|
0
|
} |
921
|
0
|
|
|
|
|
0
|
unless ( exists $ARGS{auto_features}{$feature} ) { |
922
|
0
|
|
|
|
|
0
|
$ARGS{auto_features}{$feature} = {}; |
923
|
|
|
|
|
|
|
$ARGS{auto_features}{$feature}{requires} = {}; |
924
|
0
|
|
|
|
|
0
|
} |
925
|
|
|
|
|
|
|
return; |
926
|
|
|
|
|
|
|
} |
927
|
|
|
|
|
|
|
|
928
|
0
|
|
|
0
|
1
|
0
|
sub auto_features { |
929
|
0
|
|
|
|
|
0
|
my $feature = shift; |
930
|
0
|
|
|
|
|
0
|
my $type = shift; |
931
|
0
|
|
|
|
|
0
|
my $param1 = shift; |
932
|
0
|
|
|
|
|
0
|
my $param2 = shift; |
933
|
|
|
|
|
|
|
_af_hashref($type); |
934
|
0
|
0
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
|
935
|
0
|
|
|
|
|
0
|
if ( 'description' eq $type ) { |
936
|
|
|
|
|
|
|
$ARGS{auto_features}{$feature}{description} = $param1; |
937
|
0
|
|
|
|
|
0
|
} elsif ( 'requires' eq $type ) { |
938
|
|
|
|
|
|
|
$ARGS{auto_features}{$feature}{requires}{$param1} = $param2; |
939
|
0
|
|
|
|
|
0
|
} else { |
940
|
|
|
|
|
|
|
croak "Invalid type $type for auto_features"; |
941
|
0
|
|
|
|
|
0
|
} |
942
|
0
|
|
|
|
|
0
|
_mb_required('0.26'); |
943
|
|
|
|
|
|
|
return; |
944
|
|
|
|
|
|
|
} ## end sub auto_features |
945
|
|
|
|
|
|
|
|
946
|
0
|
|
|
0
|
1
|
0
|
sub extra_compiler_flags { |
947
|
0
|
0
|
|
|
|
0
|
my $flag = shift; |
948
|
0
|
|
|
|
|
0
|
if ( 'ARRAY' eq ref $flag ) { |
|
0
|
|
|
|
|
0
|
|
949
|
0
|
|
|
|
|
0
|
foreach my $f ( @{$flag} ) { |
950
|
|
|
|
|
|
|
extra_compiler_flags($f); |
951
|
|
|
|
|
|
|
} |
952
|
|
|
|
|
|
|
} |
953
|
0
|
0
|
|
|
|
0
|
|
954
|
0
|
|
|
|
|
0
|
if ( $flag =~ m{\s} ) { |
955
|
0
|
|
|
|
|
0
|
my @flags = split m{\s+}, $flag; |
956
|
0
|
|
|
|
|
0
|
foreach my $f (@flags) { |
957
|
|
|
|
|
|
|
extra_compiler_flags($f); |
958
|
|
|
|
|
|
|
} |
959
|
0
|
|
|
|
|
0
|
} else { |
960
|
0
|
|
|
|
|
0
|
_create_arrayref('extra_compiler_flags'); |
|
0
|
|
|
|
|
0
|
|
961
|
|
|
|
|
|
|
push @{ $ARGS{'extra_compiler_flags'} }, $flag; |
962
|
0
|
|
|
|
|
0
|
} |
963
|
0
|
|
|
|
|
0
|
_mb_required('0.19'); |
964
|
|
|
|
|
|
|
return; |
965
|
|
|
|
|
|
|
} ## end sub extra_compiler_flags |
966
|
|
|
|
|
|
|
|
967
|
0
|
|
|
0
|
1
|
0
|
sub extra_linker_flags { |
968
|
0
|
0
|
|
|
|
0
|
my $flag = shift; |
969
|
0
|
|
|
|
|
0
|
if ( 'ARRAY' eq ref $flag ) { |
|
0
|
|
|
|
|
0
|
|
970
|
0
|
|
|
|
|
0
|
foreach my $f ( @{$flag} ) { |
971
|
|
|
|
|
|
|
extra_linker_flags($f); |
972
|
|
|
|
|
|
|
} |
973
|
|
|
|
|
|
|
} |
974
|
0
|
0
|
|
|
|
0
|
|
975
|
0
|
|
|
|
|
0
|
if ( $flag =~ m{\s} ) { |
976
|
0
|
|
|
|
|
0
|
my @flags = split m{\s+}, $flag; |
977
|
0
|
|
|
|
|
0
|
foreach my $f (@flags) { |
978
|
|
|
|
|
|
|
extra_linker_flags($f); |
979
|
|
|
|
|
|
|
} |
980
|
0
|
|
|
|
|
0
|
} else { |
981
|
0
|
|
|
|
|
0
|
_create_arrayref('extra_linker_flags'); |
|
0
|
|
|
|
|
0
|
|
982
|
|
|
|
|
|
|
push @{ $ARGS{'extra_linker_flags'} }, $flag; |
983
|
0
|
|
|
|
|
0
|
} |
984
|
0
|
|
|
|
|
0
|
_mb_required('0.19'); |
985
|
|
|
|
|
|
|
return; |
986
|
|
|
|
|
|
|
} ## end sub extra_linker_flags |
987
|
|
|
|
|
|
|
|
988
|
1
|
|
|
1
|
1
|
3
|
sub module_name { |
989
|
1
|
|
|
|
|
2
|
my ($name) = shift; |
990
|
1
|
50
|
|
|
|
4
|
$ARGS{'module_name'} = $name; |
991
|
1
|
|
|
|
|
2
|
unless ( exists $ARGS{'dist_name'} ) { |
992
|
1
|
|
|
|
|
3
|
my $dist_name = $name; |
993
|
1
|
|
|
|
|
5
|
$dist_name =~ s/::/-/g; |
994
|
|
|
|
|
|
|
dist_name($dist_name); |
995
|
1
|
|
|
|
|
3
|
} |
996
|
1
|
|
|
|
|
2
|
_mb_required('0.03'); |
997
|
|
|
|
|
|
|
return; |
998
|
|
|
|
|
|
|
} |
999
|
|
|
|
|
|
|
|
1000
|
0
|
|
|
0
|
1
|
0
|
sub no_index { |
1001
|
0
|
|
0
|
|
|
0
|
my $name = pop; |
1002
|
|
|
|
|
|
|
my $type = shift || 'directory'; |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
# TODO: compatibility code. |
1005
|
0
|
|
|
|
|
0
|
|
1006
|
0
|
|
|
|
|
0
|
_create_hashref('no_index'); |
1007
|
0
|
|
|
|
|
0
|
_create_hashref_arrayref( 'no_index', $type ); |
|
0
|
|
|
|
|
0
|
|
1008
|
0
|
|
|
|
|
0
|
push @{ $ARGS{'no_index'}{$type} }, $name; |
1009
|
0
|
|
|
|
|
0
|
_mb_required('0.28'); |
1010
|
|
|
|
|
|
|
return; |
1011
|
|
|
|
|
|
|
} ## end sub no_index |
1012
|
|
|
|
|
|
|
|
1013
|
0
|
|
|
0
|
1
|
0
|
sub PL_files { ## no critic(Capitalization) |
1014
|
0
|
|
0
|
|
|
0
|
my $pl_file = shift; |
1015
|
0
|
0
|
|
|
|
0
|
my $pm_file = shift || []; |
1016
|
0
|
|
|
|
|
0
|
if ( 'HASH' eq ref $pl_file ) { |
1017
|
0
|
|
|
|
|
0
|
my ( $k, $v ); |
|
0
|
|
|
|
|
0
|
|
1018
|
0
|
|
|
|
|
0
|
while ( ( $k, $v ) = each %{$pl_file} ) { |
1019
|
|
|
|
|
|
|
PL_files( $k, $v ); |
1020
|
|
|
|
|
|
|
} |
1021
|
|
|
|
|
|
|
} |
1022
|
0
|
|
|
|
|
0
|
|
1023
|
0
|
|
|
|
|
0
|
_create_hashref('PL_files'); |
1024
|
0
|
|
|
|
|
0
|
$ARGS{PL_files}{$pl_file} = $pm_file; |
1025
|
0
|
|
|
|
|
0
|
_mb_required('0.06'); |
1026
|
|
|
|
|
|
|
return; |
1027
|
|
|
|
|
|
|
} ## end sub PL_files |
1028
|
|
|
|
|
|
|
|
1029
|
0
|
|
|
0
|
1
|
0
|
sub meta_merge { |
1030
|
0
|
|
|
|
|
0
|
my $key = shift; |
1031
|
0
|
0
|
|
|
|
0
|
my $value = shift; |
1032
|
0
|
|
|
|
|
0
|
if ( 'HASH' eq ref $key ) { |
1033
|
0
|
|
|
|
|
0
|
my ( $k, $v ); |
|
0
|
|
|
|
|
0
|
|
1034
|
0
|
|
|
|
|
0
|
while ( ( $k, $v ) = each %{$key} ) { |
1035
|
|
|
|
|
|
|
meta_merge( $k, $v ); |
1036
|
0
|
|
|
|
|
0
|
} |
1037
|
|
|
|
|
|
|
return; |
1038
|
|
|
|
|
|
|
} |
1039
|
|
|
|
|
|
|
|
1040
|
0
|
0
|
|
|
|
0
|
# Allow omitting hashrefs, if there's one more parameter. |
|
|
0
|
|
|
|
|
|
1041
|
0
|
|
|
|
|
0
|
if ( 1 == scalar @_ ) { |
1042
|
0
|
|
|
|
|
0
|
meta_merge( $key, { $value => shift } ); |
1043
|
|
|
|
|
|
|
return; |
1044
|
0
|
|
|
|
|
0
|
} elsif ( 0 != scalar @_ ) { |
1045
|
|
|
|
|
|
|
confess 'Too many parameters to meta_merge'; |
1046
|
|
|
|
|
|
|
} |
1047
|
0
|
0
|
0
|
|
|
0
|
|
1048
|
|
|
|
|
|
|
if ( ( defined $ARGS{meta_merge}{$key} ) |
1049
|
|
|
|
|
|
|
and ( ref $value ne ref $ARGS{meta_merge}{$key} ) ) |
1050
|
0
|
|
|
|
|
0
|
{ |
1051
|
|
|
|
|
|
|
confess |
1052
|
|
|
|
|
|
|
'Mismatch between value to merge into meta information and value already there'; |
1053
|
|
|
|
|
|
|
} |
1054
|
0
|
0
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
|
1055
|
0
|
|
|
|
|
0
|
if ( 'HASH' eq ref $ARGS{meta_merge}{$key} ) { |
1056
|
0
|
|
|
|
|
0
|
$ARGS{meta_merge}{$key} = |
|
0
|
|
|
|
|
0
|
|
1057
|
|
|
|
|
|
|
{ ( %{ $ARGS{meta_merge}{$key} } ), ( %{$value} ) }; |
1058
|
0
|
|
|
|
|
0
|
} elsif ( 'ARRAY' eq ref $ARGS{meta_merge}{$key} ) { |
1059
|
0
|
|
|
|
|
0
|
$ARGS{meta_merge}{$key} = |
|
0
|
|
|
|
|
0
|
|
1060
|
|
|
|
|
|
|
\( @{ $ARGS{meta_merge}{$key} }, @{$value} ); |
1061
|
0
|
|
|
|
|
0
|
} else { |
1062
|
|
|
|
|
|
|
$ARGS{meta_merge}{$key} = $value; |
1063
|
|
|
|
|
|
|
} |
1064
|
0
|
|
|
|
|
0
|
|
1065
|
0
|
|
|
|
|
0
|
_mb_required('0.28'); |
1066
|
|
|
|
|
|
|
return; |
1067
|
|
|
|
|
|
|
} ## end sub meta_merge |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
|
1070
|
0
|
|
|
0
|
1
|
0
|
sub repository { |
1071
|
0
|
|
|
|
|
0
|
my $url = shift; |
1072
|
0
|
|
|
|
|
0
|
meta_merge( 'resources', 'repository' => $url ); |
1073
|
|
|
|
|
|
|
return; |
1074
|
|
|
|
|
|
|
} |
1075
|
|
|
|
|
|
|
|
1076
|
0
|
|
|
0
|
1
|
0
|
sub bugtracker { |
1077
|
0
|
|
|
|
|
0
|
my $url = shift; |
1078
|
0
|
|
|
|
|
0
|
meta_merge( 'resources', 'bugtracker' => $url ); |
1079
|
|
|
|
|
|
|
return; |
1080
|
|
|
|
|
|
|
} |
1081
|
|
|
|
|
|
|
|
1082
|
0
|
|
|
0
|
1
|
0
|
sub script_files { |
1083
|
0
|
0
|
|
|
|
0
|
my $file = shift; |
1084
|
0
|
|
|
|
|
0
|
if ( 'ARRAY' eq ref $file ) { |
|
0
|
|
|
|
|
0
|
|
1085
|
0
|
|
|
|
|
0
|
foreach my $f ( @{$file} ) { |
1086
|
|
|
|
|
|
|
script_files($f); |
1087
|
|
|
|
|
|
|
} |
1088
|
|
|
|
|
|
|
} |
1089
|
0
|
0
|
|
|
|
0
|
|
1090
|
0
|
0
|
|
|
|
0
|
if ( -d $file ) { |
1091
|
0
|
0
|
|
|
|
0
|
if ( exists $ARGS{'script_files'} ) { |
1092
|
0
|
|
|
|
|
0
|
if ( 'ARRAY' eq ref $ARGS{'script_files'} ) { |
1093
|
|
|
|
|
|
|
croak |
1094
|
|
|
|
|
|
|
"cannot add directory $file to a list of script_files"; |
1095
|
0
|
|
|
|
|
0
|
} else { |
1096
|
|
|
|
|
|
|
croak |
1097
|
|
|
|
|
|
|
"attempt to overwrite string script_files with $file failed"; |
1098
|
|
|
|
|
|
|
} |
1099
|
0
|
|
|
|
|
0
|
} else { |
1100
|
|
|
|
|
|
|
$ARGS{'script_files'} = $file; |
1101
|
|
|
|
|
|
|
} |
1102
|
0
|
|
|
|
|
0
|
} else { |
1103
|
0
|
|
|
|
|
0
|
_create_arrayref('script_files'); |
|
0
|
|
|
|
|
0
|
|
1104
|
|
|
|
|
|
|
push @{ $ARGS{'script_files'} }, $file; |
1105
|
0
|
|
|
|
|
0
|
} |
1106
|
0
|
|
|
|
|
0
|
_mb_required('0.18'); |
1107
|
|
|
|
|
|
|
return; |
1108
|
|
|
|
|
|
|
} ## end sub script_files |
1109
|
|
|
|
|
|
|
|
1110
|
0
|
|
|
0
|
1
|
0
|
sub test_files { |
1111
|
0
|
0
|
|
|
|
0
|
my $file = shift; |
1112
|
0
|
|
|
|
|
0
|
if ( 'ARRAY' eq ref $file ) { |
|
0
|
|
|
|
|
0
|
|
1113
|
0
|
|
|
|
|
0
|
foreach my $f ( @{$file} ) { |
1114
|
|
|
|
|
|
|
test_files($f); |
1115
|
|
|
|
|
|
|
} |
1116
|
|
|
|
|
|
|
} |
1117
|
0
|
0
|
|
|
|
0
|
|
1118
|
0
|
0
|
|
|
|
0
|
if ( $file =~ /[*?]/ ) { |
1119
|
0
|
0
|
|
|
|
0
|
if ( exists $ARGS{'test_files'} ) { |
1120
|
0
|
|
|
|
|
0
|
if ( 'ARRAY' eq ref $ARGS{'test_files'} ) { |
1121
|
|
|
|
|
|
|
croak 'cannot add a glob to a list of test_files'; |
1122
|
0
|
|
|
|
|
0
|
} else { |
1123
|
|
|
|
|
|
|
croak 'attempt to overwrite string test_files failed'; |
1124
|
|
|
|
|
|
|
} |
1125
|
0
|
|
|
|
|
0
|
} else { |
1126
|
|
|
|
|
|
|
$ARGS{'test_files'} = $file; |
1127
|
|
|
|
|
|
|
} |
1128
|
0
|
|
|
|
|
0
|
} else { |
1129
|
0
|
|
|
|
|
0
|
_create_arrayref('test_files'); |
|
0
|
|
|
|
|
0
|
|
1130
|
|
|
|
|
|
|
push @{ $ARGS{'test_files'} }, $file; |
1131
|
0
|
|
|
|
|
0
|
} |
1132
|
0
|
|
|
|
|
0
|
_mb_required('0.23'); |
1133
|
|
|
|
|
|
|
return; |
1134
|
|
|
|
|
|
|
} ## end sub test_files |
1135
|
|
|
|
|
|
|
|
1136
|
0
|
|
|
0
|
1
|
0
|
sub tap_harness_args { |
1137
|
0
|
|
|
|
|
0
|
my ($thargs) = shift; |
1138
|
0
|
|
|
|
|
0
|
$ARGS{'tap_harness_args'} = $thargs; |
1139
|
0
|
|
|
|
|
0
|
use_tap_harness(1); |
1140
|
|
|
|
|
|
|
return; |
1141
|
|
|
|
|
|
|
} |
1142
|
|
|
|
|
|
|
|
1143
|
0
|
|
|
0
|
1
|
0
|
sub build_class { |
1144
|
|
|
|
|
|
|
my $further_class = $ARGS{build_class} = shift; |
1145
|
0
|
|
|
|
|
0
|
|
1146
|
0
|
0
|
|
|
|
0
|
eval "require $further_class;"; |
1147
|
|
|
|
|
|
|
die "Can't find custom build class '$further_class'" if $@; |
1148
|
0
|
|
|
|
|
0
|
|
1149
|
|
|
|
|
|
|
copy_package($further_class, 'true'); |
1150
|
0
|
|
|
|
|
0
|
|
1151
|
|
|
|
|
|
|
sync_interface($further_class); |
1152
|
0
|
|
|
|
|
0
|
|
1153
|
0
|
|
|
|
|
0
|
_mb_required('0.28'); |
1154
|
|
|
|
|
|
|
return; |
1155
|
|
|
|
|
|
|
} |
1156
|
|
|
|
|
|
|
|
1157
|
|
|
|
|
|
|
sub subclass { |
1158
|
0
|
|
|
0
|
1
|
0
|
# '$class->' will enable the further subclassing of custom subclass |
1159
|
0
|
|
|
|
|
0
|
sync_interface($class->subclass(@_)); |
1160
|
|
|
|
|
|
|
return; |
1161
|
|
|
|
|
|
|
} |
1162
|
|
|
|
|
|
|
|
1163
|
1
|
|
|
1
|
1
|
3
|
sub create_build_script { |
1164
|
1
|
|
|
|
|
34
|
get_builder(); |
1165
|
1
|
|
|
|
|
640016
|
$object->create_build_script; |
1166
|
|
|
|
|
|
|
return $object; |
1167
|
|
|
|
|
|
|
} |
1168
|
|
|
|
|
|
|
|
1169
|
|
|
|
|
|
|
# Required to get a builder for later use. |
1170
|
|
|
|
|
|
|
sub get_builder { |
1171
|
1
|
50
|
|
1
|
1
|
5
|
|
|
0
|
|
|
|
|
0
|
|
1172
|
1
|
|
|
|
|
19
|
if ( $mb_required < 0.07 ) { $mb_required = '0.07'; } |
1173
|
|
|
|
|
|
|
build_requires( 'Module::Build', $mb_required ); |
1174
|
1
|
50
|
|
|
|
5
|
|
1175
|
1
|
|
|
|
|
6
|
if ( $mb_required > 0.2999 ) { |
1176
|
|
|
|
|
|
|
configure_requires( 'Module::Build', $mb_required ); |
1177
|
|
|
|
|
|
|
} |
1178
|
1
|
50
|
|
|
|
4
|
|
1179
|
1
|
|
|
|
|
20
|
unless ( defined $object ) { |
1180
|
1
|
|
|
|
|
119848
|
$object = $class->new(%ARGS); |
1181
|
|
|
|
|
|
|
$object_created = 1; |
1182
|
|
|
|
|
|
|
} |
1183
|
1
|
|
|
|
|
22
|
|
1184
|
0
|
|
|
|
|
0
|
foreach my $type (@install_types) { |
1185
|
|
|
|
|
|
|
$object->add_build_element($type); |
1186
|
|
|
|
|
|
|
} |
1187
|
1
|
|
|
|
|
8
|
|
1188
|
|
|
|
|
|
|
return $object; |
1189
|
|
|
|
|
|
|
} ## end sub get_builder |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
sub sync_interface { |
1193
|
0
|
|
|
0
|
0
|
0
|
# subclass needs be already 'required', as it will be introspected |
1194
|
|
|
|
|
|
|
my $subclass = shift; |
1195
|
|
|
|
|
|
|
|
1196
|
0
|
|
|
|
|
0
|
# Properties of current builder class |
1197
|
|
|
|
|
|
|
my @current_all_properties = $class->valid_properties; |
1198
|
|
|
|
|
|
|
|
1199
|
0
|
|
|
|
|
0
|
# Hashed variant for convenient checking of presense |
|
0
|
|
|
|
|
0
|
|
1200
|
|
|
|
|
|
|
my %current_all_properties = map { $_ => '' } @current_all_properties; |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
|
1203
|
0
|
|
|
|
|
0
|
# Properties of subclass |
1204
|
0
|
|
|
|
|
0
|
my @all_properties = $subclass->valid_properties; |
|
0
|
|
|
|
|
0
|
|
1205
|
0
|
|
|
|
|
0
|
my %array_properties = map { $_ => '' } $subclass->array_properties; |
|
0
|
|
|
|
|
0
|
|
1206
|
|
|
|
|
|
|
my %hash_properties = map { $_ => '' } $subclass->hash_properties; |
1207
|
0
|
|
|
|
|
0
|
|
1208
|
|
|
|
|
|
|
$class = $subclass; |
1209
|
0
|
|
|
|
|
0
|
|
1210
|
|
|
|
|
|
|
foreach my $property (@all_properties) { |
1211
|
0
|
0
|
|
|
|
0
|
# Skipping already presented properties |
1212
|
|
|
|
|
|
|
next if defined $current_all_properties{$property}; |
1213
|
0
|
0
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
|
1214
|
0
|
|
|
|
|
0
|
if (defined $hash_properties{$property}) { |
1215
|
|
|
|
|
|
|
additional_hash($property) |
1216
|
0
|
|
|
|
|
0
|
} elsif (defined $array_properties{$property}) { |
1217
|
|
|
|
|
|
|
additional_array($property) |
1218
|
0
|
|
|
|
|
0
|
} else { |
1219
|
|
|
|
|
|
|
additional_flag($property) |
1220
|
|
|
|
|
|
|
} |
1221
|
|
|
|
|
|
|
} |
1222
|
|
|
|
|
|
|
} |
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
|
1225
|
0
|
|
|
0
|
0
|
0
|
sub additional { |
1226
|
0
|
0
|
|
|
|
0
|
my ($additional_type, $additional_name) = @_; |
1227
|
0
|
|
|
|
|
0
|
if (not defined $additional_name) { |
1228
|
|
|
|
|
|
|
croak 'additional requires a name.'; |
1229
|
|
|
|
|
|
|
} |
1230
|
0
|
0
|
|
|
|
0
|
|
1231
|
0
|
|
|
|
|
0
|
unless($class->valid_property($additional_name)) { |
1232
|
|
|
|
|
|
|
croak "Property '$additional_name' not found in $class"; |
1233
|
|
|
|
|
|
|
} |
1234
|
0
|
0
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1235
|
0
|
|
|
|
|
0
|
if ( 'array' eq lc $additional_type ) { |
1236
|
|
|
|
|
|
|
$ARRAY{$additional_name} = 0.07; |
1237
|
0
|
|
|
|
|
0
|
} elsif ( 'hash' eq lc $additional_type ) { |
1238
|
|
|
|
|
|
|
$HASH{$additional_name} = [ 0.07, 0 ]; |
1239
|
0
|
|
|
|
|
0
|
} elsif ( 'flag' eq lc $additional_type ) { |
1240
|
|
|
|
|
|
|
$FLAGS{$additional_name} = [ 0.07, 0 ]; |
1241
|
0
|
|
|
|
|
0
|
} else { |
1242
|
|
|
|
|
|
|
croak 'additional requires two parameters: a type (array, hash, or flag) and a name.'; |
1243
|
|
|
|
|
|
|
} |
1244
|
3
|
|
|
3
|
|
29
|
|
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
743
|
|
1245
|
|
|
|
|
|
|
no strict 'refs'; |
1246
|
0
|
|
|
|
|
0
|
|
1247
|
|
|
|
|
|
|
my $symbol = "${export_to}::$additional_name"; |
1248
|
|
|
|
|
|
|
|
1249
|
0
|
|
|
|
|
0
|
# Create a stub in the caller package |
|
0
|
|
|
|
|
0
|
|
1250
|
|
|
|
|
|
|
\&{$symbol}; |
1251
|
|
|
|
|
|
|
} |
1252
|
|
|
|
|
|
|
|
1253
|
0
|
|
|
0
|
1
|
0
|
sub additional_array { |
1254
|
0
|
0
|
|
|
|
0
|
my $additional_name = shift; |
1255
|
0
|
|
|
|
|
0
|
croak 'additional_array needs a name to define' if not defined $additional_name; |
1256
|
|
|
|
|
|
|
additional('array', $additional_name); |
1257
|
|
|
|
|
|
|
} |
1258
|
|
|
|
|
|
|
|
1259
|
0
|
|
|
0
|
1
|
0
|
sub additional_flag { |
1260
|
0
|
0
|
|
|
|
0
|
my $additional_name = shift; |
1261
|
0
|
|
|
|
|
0
|
croak 'additional_flag needs a name to define' if not defined $additional_name; |
1262
|
|
|
|
|
|
|
additional('flag', $additional_name); |
1263
|
|
|
|
|
|
|
} |
1264
|
|
|
|
|
|
|
|
1265
|
0
|
|
|
0
|
1
|
0
|
sub additional_hash { |
1266
|
0
|
0
|
|
|
|
0
|
my $additional_name = shift; |
1267
|
0
|
|
|
|
|
0
|
croak 'additional_hash needs a name to define' if not defined $additional_name; |
1268
|
|
|
|
|
|
|
additional('hash', $additional_name); |
1269
|
|
|
|
|
|
|
} |
1270
|
|
|
|
|
|
|
|
1271
|
0
|
|
|
0
|
|
0
|
sub _debug_print { |
1272
|
0
|
|
|
|
|
0
|
require Data::Dumper; |
1273
|
|
|
|
|
|
|
my $d = Data::Dumper->new( [ \%ARGS, \$mb_required ], |
1274
|
0
|
|
|
|
|
0
|
[qw(*ARGS *mb_required)] ); |
1275
|
0
|
|
|
|
|
0
|
print $d->Indent(1)->Dump(); |
1276
|
|
|
|
|
|
|
return; |
1277
|
|
|
|
|
|
|
} |
1278
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
1; |