1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
|
package CPANPLUS::Internals::Constants;
use strict;
use CPANPLUS::Error;
use Config;
use File::Spec;
use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
require Exporter;
use vars qw[$VERSION @ISA @EXPORT];
use Package::Constants;
@ISA = qw[Exporter];
@EXPORT = Package::Constants->list( __PACKAGE__ );
sub constants { @EXPORT };
use constant INSTALLER_BUILD
=> 'CPANPLUS::Dist::Build';
use constant INSTALLER_MM => 'CPANPLUS::Dist::MM';
use constant INSTALLER_SAMPLE
=> 'CPANPLUS::Dist::Sample';
use constant INSTALLER_BASE => 'CPANPLUS::Dist::Base';
use constant INSTALLER_AUTOBUNDLE
=> 'CPANPLUS::Dist::Autobundle';
use constant SHELL_DEFAULT => 'CPANPLUS::Shell::Default';
use constant SHELL_CLASSIC => 'CPANPLUS::Shell::Classic';
use constant CONFIG => 'CPANPLUS::Config';
use constant CONFIG_USER => 'CPANPLUS::Config::User';
use constant CONFIG_SYSTEM => 'CPANPLUS::Config::System';
use constant CONFIG_BOXED => 'CPANPLUS::Config::Boxed';
use constant DEFAULT_SOURCE_ENGINE
=> 'CPANPLUS::Internals::Source::Memory';
use constant TARGET_INIT => 'init';
use constant TARGET_CREATE => 'create';
use constant TARGET_PREPARE => 'prepare';
use constant TARGET_INSTALL => 'install';
use constant TARGET_IGNORE => 'ignore';
use constant ON_WIN32 => $^O eq 'MSWin32';
use constant ON_NETWARE => $^O eq 'NetWare';
use constant ON_CYGWIN => $^O eq 'cygwin';
use constant ON_VMS => $^O eq 'VMS';
use constant DOT_CPANPLUS => ON_VMS ? '_cpanplus' : '.cpanplus';
use constant OPT_AUTOFLUSH => '-MCPANPLUS::Internals::Utils::Autoflush';
use constant UNKNOWN_DL_LOCATION
=> 'UNKNOWN-ORIGIN';
use constant NMAKE => 'nmake.exe';
use constant NMAKE_URL =>
'ftp://ftp.microsoft.com/Softlib/MSLFILES/nmake15.exe';
use constant INSTALL_VIA_PACKAGE_MANAGER
=> sub { my $fmt = $_[0] or return;
return 1 if $fmt ne INSTALLER_BUILD and
$fmt ne INSTALLER_MM;
};
use constant IS_CODEREF => sub { ref $_[-1] eq 'CODE' };
use constant IS_MODOBJ => sub { UNIVERSAL::isa($_[-1],
'CPANPLUS::Module') };
use constant IS_FAKE_MODOBJ => sub { UNIVERSAL::isa($_[-1],
'CPANPLUS::Module::Fake') };
use constant IS_AUTHOBJ => sub { UNIVERSAL::isa($_[-1],
'CPANPLUS::Module::Author') };
use constant IS_FAKE_AUTHOBJ
=> sub { UNIVERSAL::isa($_[-1],
'CPANPLUS::Module::Author::Fake') };
use constant IS_CONFOBJ => sub { UNIVERSAL::isa($_[-1],
'CPANPLUS::Configure') };
use constant IS_RVOBJ => sub { UNIVERSAL::isa($_[-1],
'CPANPLUS::Backend::RV') };
use constant IS_INTERNALS_OBJ
=> sub { UNIVERSAL::isa($_[-1],
'CPANPLUS::Internals') };
use constant IS_FILE => sub { return 1 if -e $_[-1] };
use constant FILE_EXISTS => sub {
my $file = $_[-1];
return 1 if IS_FILE->($file);
local $Carp::CarpLevel =
$Carp::CarpLevel+2;
error(loc( q[File '%1' does not exist],
$file));
return;
};
use constant FILE_READABLE => sub {
my $file = $_[-1];
return 1 if -e $file && -r _;
local $Carp::CarpLevel =
$Carp::CarpLevel+2;
error( loc( q[File '%1' is not readable ].
q[or does not exist], $file));
return;
};
use constant IS_DIR => sub { return 1 if -d $_[-1] };
use constant DIR_EXISTS => sub {
my $dir = $_[-1];
return 1 if IS_DIR->($dir);
local $Carp::CarpLevel =
$Carp::CarpLevel+2;
error(loc(q[Dir '%1' does not exist],
$dir));
return;
};
### On VMS, if the $Config{make} is either MMK
### or MMS, then the makefile is 'DESCRIP.MMS'.
use constant MAKEFILE => sub { my $file =
(ON_VMS and
$Config::Config{make} =~ /MM[S|K]/i)
? 'DESCRIP.MMS'
: 'Makefile';
return @_
? File::Spec->catfile( @_, $file )
: $file;
};
use constant MAKEFILE_PL => sub { return @_
? File::Spec->catfile( @_,
'Makefile.PL' )
: 'Makefile.PL';
};
use constant BUILD_PL => sub { return @_
? File::Spec->catfile( @_,
'Build.PL' )
: 'Build.PL';
};
use constant META_YML => sub { return @_
? File::Spec->catfile( @_, 'META.yml' )
: 'META.yml';
};
use constant MYMETA_YML => sub { return @_
? File::Spec->catfile( @_, 'MYMETA.yml' )
: 'MYMETA.yml';
};
use constant META_JSON => sub { return @_
? File::Spec->catfile( @_, 'META.json' )
: 'META.json';
};
use constant MYMETA_JSON => sub { return @_
? File::Spec->catfile( @_, 'MYMETA.json' )
: 'MYMETA.json';
};
use constant BLIB => sub { return @_
? File::Spec->catfile(@_, 'blib')
: 'blib';
};
use constant LIB => 'lib';
use constant LIB_DIR => sub { return @_
? File::Spec->catdir(@_, LIB)
: LIB;
};
use constant AUTO => 'auto';
use constant LIB_AUTO_DIR => sub { return @_
? File::Spec->catdir(@_, LIB, AUTO)
: File::Spec->catdir(LIB, AUTO)
};
use constant ARCH => 'arch';
use constant ARCH_DIR => sub { return @_
? File::Spec->catdir(@_, ARCH)
: ARCH;
};
use constant ARCH_AUTO_DIR => sub { return @_
? File::Spec->catdir(@_,ARCH,AUTO)
: File::Spec->catdir(ARCH,AUTO)
};
use constant BLIB_LIBDIR => sub { return @_
? File::Spec->catdir(
@_, BLIB->(), LIB )
: File::Spec->catdir( BLIB->(), LIB );
};
use constant CONFIG_USER_LIB_DIR => sub {
require CPANPLUS::Internals::Utils;
LIB_DIR->(
CPANPLUS::Internals::Utils->_home_dir,
DOT_CPANPLUS
);
};
use constant CONFIG_USER_FILE => sub {
File::Spec->catfile(
CONFIG_USER_LIB_DIR->(),
split('::', CONFIG_USER),
) . '.pm';
};
use constant CONFIG_SYSTEM_FILE => sub {
require CPANPLUS::Internals;
require File::Basename;
my $dir = File::Basename::dirname(
$INC{'CPANPLUS/Internals.pm'}
);
### XXX use constants
File::Spec->catfile(
$dir, qw[Config System.pm]
);
};
use constant README => sub { my $obj = $_[0];
my $pkg = $obj->package_name;
$pkg .= '-' . $obj->package_version .
'.readme';
return $pkg;
};
use constant META_EXT => 'meta';
use constant META => sub { my $obj = $_[0];
my $pkg = $obj->package_name;
$pkg .= '-' . $obj->package_version .
'.' . META_EXT;
return $pkg;
};
use constant OPEN_FILE => sub {
my($file, $mode) = (@_, '');
my $fh;
open $fh, "$mode" . $file
or error(loc(
"Could not open file '%1': %2",
$file, $!));
return $fh if $fh;
return;
};
use constant OPEN_DIR => sub {
my $dir = shift;
my $dh;
opendir $dh, $dir or error(loc(
"Could not open dir '%1': %2", $dir, $!
));
return $dh if $dh;
return;
};
use constant READ_DIR => sub {
my $dir = shift;
my $dh = OPEN_DIR->( $dir ) or return;
### exclude . and ..
my @files = grep { $_ !~ /^\.{1,2}/ }
readdir($dh);
### Remove trailing dot on VMS when
### using VMS syntax.
if( ON_VMS ) {
s/(?<!\^)\.$// for @files;
}
return @files;
};
use constant STRIP_GZ_SUFFIX
=> sub {
my $file = $_[0] or return;
$file =~ s/.gz$//i;
return $file;
};
use constant CHECKSUMS => 'CHECKSUMS';
use constant PGP_HEADER => '-----BEGIN PGP SIGNED MESSAGE-----';
use constant ENV_CPANPLUS_CONFIG
=> 'PERL5_CPANPLUS_CONFIG';
use constant ENV_CPANPLUS_IS_EXECUTING
=> 'PERL5_CPANPLUS_IS_EXECUTING';
use constant DEFAULT_EMAIL => 'cpanplus@example.com';
use constant CPANPLUS_UA => sub { ### for the version number ###
require CPANPLUS::Internals;
"CPANPLUS/$CPANPLUS::Internals::VERSION"
};
use constant TESTERS_URL => sub {
'http://cpantesters.org/distro/'.
uc(substr($_[0],0,1)) .'/'. $_[0] . '.yaml';
};
use constant TESTERS_DETAILS_URL
=> sub {
'http://cpantesters.org/distro/'.
uc(substr($_[0],0,1)) .'/'. $_[0];
};
use constant CREATE_FILE_URI
=> sub {
my $dir = $_[0] or return;
return $dir =~ m|^/|
? 'file://' . $dir
: 'file:///' . $dir;
};
use constant EMPTY_DSLIP => ' ';
use constant CUSTOM_AUTHOR_ID
=> 'LOCAL';
use constant DOT_SHELL_DEFAULT_RC
=> '.shell-default.rc';
use constant SOURCE_SQLITE_DB
=> 'db.sql';
use constant PREREQ_IGNORE => 0;
use constant PREREQ_INSTALL => 1;
use constant PREREQ_ASK => 2;
use constant PREREQ_BUILD => 3;
use constant BOOLEANS => [0,1];
use constant CALLING_FUNCTION
=> sub { my $lvl = $_[0] || 0;
return join '::', (caller(2+$lvl))[3]
};
use constant PERL_CORE => 'perl';
use constant PERL_WRAPPER => 'use strict; BEGIN { my $old = select STDERR; $|++; select $old; $|++; $0 = shift(@ARGV); my $rv = do($0); die $@ if $@; }';
use constant STORABLE_EXT => '.stored';
use constant GET_XS_FILES => sub { my $dir = $_[0] or return;
require File::Find;
my @files;
File::Find::find(
sub { push @files, $File::Find::name
if $File::Find::name =~ /\.xs$/i
}, $dir );
return @files;
};
use constant INSTALL_LOG_FILE
=> sub { my $obj = shift or return;
my $name = $obj->name; $name =~ s/::/-/g;
$name .= '-'. $obj->version;
$name .= '-'. scalar(time) . '.log';
return $name;
};
use constant ON_OLD_CYGWIN => do { ON_CYGWIN and $] < 5.008
? loc(
"Your perl version for %1 is too low; ".
"Require %2 or higher for this function",
$^O, '5.8.0' )
: '';
};
### XXX these 2 are probably obsolete -- check & remove;
use constant DOT_EXISTS => '.exists';
use constant QUOTE_PERL_ONE_LINER
=> sub { my $line = shift or return;
### use double quotes on these systems
return qq["$line"]
if ON_WIN32 || ON_NETWARE || ON_VMS;
### single quotes on the rest
return qq['$line'];
};
1;
# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4:
|
