1 package CPANPLUS::Internals::Constants;
9 use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
12 use vars qw[$VERSION @ISA @EXPORT];
14 use Package::Constants;
17 @EXPORT = Package::Constants->list( __PACKAGE__ );
20 sub constants { @EXPORT };
22 use constant INSTALLER_BUILD
23 => 'CPANPLUS::Dist::Build';
24 use constant INSTALLER_MM => 'CPANPLUS::Dist::MM';
25 use constant INSTALLER_SAMPLE
26 => 'CPANPLUS::Dist::Sample';
27 use constant INSTALLER_BASE => 'CPANPLUS::Dist::Base';
28 use constant INSTALLER_AUTOBUNDLE
29 => 'CPANPLUS::Dist::Autobundle';
31 use constant SHELL_DEFAULT => 'CPANPLUS::Shell::Default';
32 use constant SHELL_CLASSIC => 'CPANPLUS::Shell::Classic';
34 use constant CONFIG => 'CPANPLUS::Config';
35 use constant CONFIG_USER => 'CPANPLUS::Config::User';
36 use constant CONFIG_SYSTEM => 'CPANPLUS::Config::System';
37 use constant CONFIG_BOXED => 'CPANPLUS::Config::Boxed';
39 use constant DEFAULT_SOURCE_ENGINE
40 => 'CPANPLUS::Internals::Source::Memory';
42 use constant TARGET_INIT => 'init';
43 use constant TARGET_CREATE => 'create';
44 use constant TARGET_PREPARE => 'prepare';
45 use constant TARGET_INSTALL => 'install';
46 use constant TARGET_IGNORE => 'ignore';
48 use constant ON_WIN32 => $^O eq 'MSWin32';
49 use constant ON_NETWARE => $^O eq 'NetWare';
50 use constant ON_CYGWIN => $^O eq 'cygwin';
51 use constant ON_VMS => $^O eq 'VMS';
53 use constant DOT_CPANPLUS => ON_VMS ? '_cpanplus' : '.cpanplus';
55 use constant OPT_AUTOFLUSH => '-MCPANPLUS::Internals::Utils::Autoflush';
57 use constant UNKNOWN_DL_LOCATION
60 use constant NMAKE => 'nmake.exe';
61 use constant NMAKE_URL =>
62 'ftp://ftp.microsoft.com/Softlib/MSLFILES/nmake15.exe';
64 use constant INSTALL_VIA_PACKAGE_MANAGER
65 => sub { my $fmt = $_[0] or return;
66 return 1 if $fmt ne INSTALLER_BUILD and
70 use constant IS_CODEREF => sub { ref $_[-1] eq 'CODE' };
71 use constant IS_MODOBJ => sub { UNIVERSAL::isa($_[-1],
72 'CPANPLUS::Module') };
73 use constant IS_FAKE_MODOBJ => sub { UNIVERSAL::isa($_[-1],
74 'CPANPLUS::Module::Fake') };
75 use constant IS_AUTHOBJ => sub { UNIVERSAL::isa($_[-1],
76 'CPANPLUS::Module::Author') };
77 use constant IS_FAKE_AUTHOBJ
78 => sub { UNIVERSAL::isa($_[-1],
79 'CPANPLUS::Module::Author::Fake') };
81 use constant IS_CONFOBJ => sub { UNIVERSAL::isa($_[-1],
82 'CPANPLUS::Configure') };
84 use constant IS_RVOBJ => sub { UNIVERSAL::isa($_[-1],
85 'CPANPLUS::Backend::RV') };
87 use constant IS_INTERNALS_OBJ
88 => sub { UNIVERSAL::isa($_[-1],
89 'CPANPLUS::Internals') };
91 use constant IS_FILE => sub { return 1 if -e $_[-1] };
93 use constant FILE_EXISTS => sub {
95 return 1 if IS_FILE->($file);
96 local $Carp::CarpLevel =
98 error(loc( q[File '%1' does not exist],
103 use constant FILE_READABLE => sub {
105 return 1 if -e $file && -r _;
106 local $Carp::CarpLevel =
108 error( loc( q[File '%1' is not readable ].
109 q[or does not exist], $file));
112 use constant IS_DIR => sub { return 1 if -d $_[-1] };
114 use constant DIR_EXISTS => sub {
116 return 1 if IS_DIR->($dir);
117 local $Carp::CarpLevel =
119 error(loc(q[Dir '%1' does not exist],
124 ### On VMS, if the $Config{make} is either MMK
125 ### or MMS, then the makefile is 'DESCRIP.MMS'.
126 use constant MAKEFILE => sub { my $file =
128 $Config::Config{make} =~ /MM[S|K]/i)
133 ? File::Spec->catfile( @_, $file )
136 use constant MAKEFILE_PL => sub { return @_
137 ? File::Spec->catfile( @_,
141 use constant BUILD_PL => sub { return @_
142 ? File::Spec->catfile( @_,
147 use constant META_YML => sub { return @_
148 ? File::Spec->catfile( @_, 'META.yml' )
152 use constant BLIB => sub { return @_
153 ? File::Spec->catfile(@_, 'blib')
157 use constant LIB => 'lib';
158 use constant LIB_DIR => sub { return @_
159 ? File::Spec->catdir(@_, LIB)
162 use constant AUTO => 'auto';
163 use constant LIB_AUTO_DIR => sub { return @_
164 ? File::Spec->catdir(@_, LIB, AUTO)
165 : File::Spec->catdir(LIB, AUTO)
167 use constant ARCH => 'arch';
168 use constant ARCH_DIR => sub { return @_
169 ? File::Spec->catdir(@_, ARCH)
172 use constant ARCH_AUTO_DIR => sub { return @_
173 ? File::Spec->catdir(@_,ARCH,AUTO)
174 : File::Spec->catdir(ARCH,AUTO)
177 use constant BLIB_LIBDIR => sub { return @_
178 ? File::Spec->catdir(
180 : File::Spec->catdir( BLIB->(), LIB );
183 use constant CONFIG_USER_LIB_DIR => sub {
184 require CPANPLUS::Internals::Utils;
186 CPANPLUS::Internals::Utils->_home_dir,
190 use constant CONFIG_USER_FILE => sub {
192 CONFIG_USER_LIB_DIR->(),
193 split('::', CONFIG_USER),
196 use constant CONFIG_SYSTEM_FILE => sub {
197 require CPANPLUS::Internals;
198 require File::Basename;
199 my $dir = File::Basename::dirname(
200 $INC{'CPANPLUS/Internals.pm'}
203 ### XXX use constants
205 $dir, qw[Config System.pm]
209 use constant README => sub { my $obj = $_[0];
210 my $pkg = $obj->package_name;
211 $pkg .= '-' . $obj->package_version .
215 use constant META_EXT => 'meta';
217 use constant META => sub { my $obj = $_[0];
218 my $pkg = $obj->package_name;
219 $pkg .= '-' . $obj->package_version .
224 use constant OPEN_FILE => sub {
225 my($file, $mode) = (@_, '');
227 open $fh, "$mode" . $file
229 "Could not open file '%1': %2",
235 use constant OPEN_DIR => sub {
238 opendir $dh, $dir or error(loc(
239 "Could not open dir '%1': %2", $dir, $!
246 use constant READ_DIR => sub {
248 my $dh = OPEN_DIR->( $dir ) or return;
251 my @files = grep { $_ !~ /^\.{1,2}/ }
254 ### Remove trailing dot on VMS when
255 ### using VMS syntax.
257 s/(?<!\^)\.$// for @files;
263 use constant STRIP_GZ_SUFFIX
265 my $file = $_[0] or return;
270 use constant CHECKSUMS => 'CHECKSUMS';
271 use constant PGP_HEADER => '-----BEGIN PGP SIGNED MESSAGE-----';
272 use constant ENV_CPANPLUS_CONFIG
273 => 'PERL5_CPANPLUS_CONFIG';
274 use constant ENV_CPANPLUS_IS_EXECUTING
275 => 'PERL5_CPANPLUS_IS_EXECUTING';
276 use constant DEFAULT_EMAIL => 'cpanplus@example.com';
277 use constant CPANPLUS_UA => sub { ### for the version number ###
278 require CPANPLUS::Internals;
279 "CPANPLUS/$CPANPLUS::Internals::VERSION"
281 use constant TESTERS_URL => sub {
282 'http://cpantesters.org/distro/'.
283 uc(substr($_[0],0,1)) .'/'. $_[0] . '.yaml';
285 use constant TESTERS_DETAILS_URL
287 'http://cpantesters.org/distro/'.
288 uc(substr($_[0],0,1)) .'/'. $_[0];
291 use constant CREATE_FILE_URI
293 my $dir = $_[0] or return;
299 use constant EMPTY_DSLIP => ' ';
301 use constant CUSTOM_AUTHOR_ID
304 use constant DOT_SHELL_DEFAULT_RC
305 => '.shell-default.rc';
307 use constant SOURCE_SQLITE_DB
310 use constant PREREQ_IGNORE => 0;
311 use constant PREREQ_INSTALL => 1;
312 use constant PREREQ_ASK => 2;
313 use constant PREREQ_BUILD => 3;
314 use constant BOOLEANS => [0,1];
315 use constant CALLING_FUNCTION
316 => sub { my $lvl = $_[0] || 0;
317 return join '::', (caller(2+$lvl))[3]
319 use constant PERL_CORE => 'perl';
320 use constant STORABLE_EXT => '.stored';
322 use constant GET_XS_FILES => sub { my $dir = $_[0] or return;
326 sub { push @files, $File::Find::name
327 if $File::Find::name =~ /\.xs$/i
333 use constant INSTALL_LOG_FILE
334 => sub { my $obj = shift or return;
335 my $name = $obj->name; $name =~ s/::/-/g;
336 $name .= '-'. $obj->version;
337 $name .= '-'. scalar(time) . '.log';
341 use constant ON_OLD_CYGWIN => do { ON_CYGWIN and $] < 5.008
343 "Your perl version for %1 is too low; ".
344 "Require %2 or higher for this function",
349 ### XXX these 2 are probably obsolete -- check & remove;
350 use constant DOT_EXISTS => '.exists';
352 use constant QUOTE_PERL_ONE_LINER
353 => sub { my $line = shift or return;
355 ### use double quotes on these systems
357 if ON_WIN32 || ON_NETWARE || ON_VMS;
359 ### single quotes on the rest
366 # c-indentation-style: bsd
368 # indent-tabs-mode: nil
370 # vim: expandtab shiftwidth=4: