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