Commit | Line | Data |
6aaee015 |
1 | package CPANPLUS::Internals::Constants; |
2 | |
3 | use strict; |
4 | |
5 | use CPANPLUS::Error; |
6 | |
5bc5f6dc |
7 | use Config; |
6aaee015 |
8 | use File::Spec; |
9 | use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; |
10 | |
11 | require Exporter; |
12 | use vars qw[$VERSION @ISA @EXPORT]; |
13 | |
14 | use Package::Constants; |
15 | |
6aaee015 |
16 | @ISA = qw[Exporter]; |
17 | @EXPORT = Package::Constants->list( __PACKAGE__ ); |
18 | |
19 | |
20 | sub constants { @EXPORT }; |
21 | |
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'; |
4443dd53 |
27 | use constant INSTALLER_BASE => 'CPANPLUS::Dist::Base'; |
28 | use constant INSTALLER_AUTOBUNDLE |
29 | => 'CPANPLUS::Dist::Autobundle'; |
6aaee015 |
30 | |
494f1016 |
31 | use constant SHELL_DEFAULT => 'CPANPLUS::Shell::Default'; |
32 | use constant SHELL_CLASSIC => 'CPANPLUS::Shell::Classic'; |
33 | |
6aaee015 |
34 | use constant CONFIG => 'CPANPLUS::Config'; |
35 | use constant CONFIG_USER => 'CPANPLUS::Config::User'; |
36 | use constant CONFIG_SYSTEM => 'CPANPLUS::Config::System'; |
622d31ac |
37 | use constant CONFIG_BOXED => 'CPANPLUS::Config::Boxed'; |
6aaee015 |
38 | |
4443dd53 |
39 | use constant DEFAULT_SOURCE_ENGINE |
40 | => 'CPANPLUS::Internals::Source::Memory'; |
41 | |
8bc57f96 |
42 | use constant TARGET_INIT => 'init'; |
6aaee015 |
43 | use constant TARGET_CREATE => 'create'; |
44 | use constant TARGET_PREPARE => 'prepare'; |
45 | use constant TARGET_INSTALL => 'install'; |
46 | use constant TARGET_IGNORE => 'ignore'; |
5bc5f6dc |
47 | |
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'; |
52 | |
53 | use constant DOT_CPANPLUS => ON_VMS ? '_cpanplus' : '.cpanplus'; |
6aaee015 |
54 | |
55 | use constant OPT_AUTOFLUSH => '-MCPANPLUS::Internals::Utils::Autoflush'; |
56 | |
57 | use constant UNKNOWN_DL_LOCATION |
58 | => 'UNKNOWN-ORIGIN'; |
59 | |
60 | use constant NMAKE => 'nmake.exe'; |
61 | use constant NMAKE_URL => |
62 | 'ftp://ftp.microsoft.com/Softlib/MSLFILES/nmake15.exe'; |
63 | |
64 | use constant INSTALL_VIA_PACKAGE_MANAGER |
65 | => sub { my $fmt = $_[0] or return; |
66 | return 1 if $fmt ne INSTALLER_BUILD and |
67 | $fmt ne INSTALLER_MM; |
68 | }; |
69 | |
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') }; |
80 | |
81 | use constant IS_CONFOBJ => sub { UNIVERSAL::isa($_[-1], |
82 | 'CPANPLUS::Configure') }; |
83 | |
84 | use constant IS_RVOBJ => sub { UNIVERSAL::isa($_[-1], |
85 | 'CPANPLUS::Backend::RV') }; |
86 | |
87 | use constant IS_INTERNALS_OBJ |
88 | => sub { UNIVERSAL::isa($_[-1], |
89 | 'CPANPLUS::Internals') }; |
90 | |
91 | use constant IS_FILE => sub { return 1 if -e $_[-1] }; |
92 | |
93 | use constant FILE_EXISTS => sub { |
94 | my $file = $_[-1]; |
95 | return 1 if IS_FILE->($file); |
96 | local $Carp::CarpLevel = |
97 | $Carp::CarpLevel+2; |
98 | error(loc( q[File '%1' does not exist], |
99 | $file)); |
100 | return; |
101 | }; |
102 | |
103 | use constant FILE_READABLE => sub { |
104 | my $file = $_[-1]; |
105 | return 1 if -e $file && -r _; |
106 | local $Carp::CarpLevel = |
107 | $Carp::CarpLevel+2; |
108 | error( loc( q[File '%1' is not readable ]. |
109 | q[or does not exist], $file)); |
110 | return; |
111 | }; |
112 | use constant IS_DIR => sub { return 1 if -d $_[-1] }; |
113 | |
114 | use constant DIR_EXISTS => sub { |
115 | my $dir = $_[-1]; |
116 | return 1 if IS_DIR->($dir); |
117 | local $Carp::CarpLevel = |
118 | $Carp::CarpLevel+2; |
119 | error(loc(q[Dir '%1' does not exist], |
120 | $dir)); |
121 | return; |
122 | }; |
5bc5f6dc |
123 | |
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 = |
127 | (ON_VMS and |
128 | $Config::Config{make} =~ /MM[S|K]/i) |
129 | ? 'DESCRIP.MMS' |
130 | : 'Makefile'; |
131 | |
132 | return @_ |
133 | ? File::Spec->catfile( @_, $file ) |
134 | : $file; |
135 | }; |
6aaee015 |
136 | use constant MAKEFILE_PL => sub { return @_ |
137 | ? File::Spec->catfile( @_, |
138 | 'Makefile.PL' ) |
139 | : 'Makefile.PL'; |
6aaee015 |
140 | }; |
141 | use constant BUILD_PL => sub { return @_ |
142 | ? File::Spec->catfile( @_, |
143 | 'Build.PL' ) |
144 | : 'Build.PL'; |
145 | }; |
4443dd53 |
146 | |
147 | use constant META_YML => sub { return @_ |
148 | ? File::Spec->catfile( @_, 'META.yml' ) |
149 | : 'META.yml'; |
150 | }; |
151 | |
6aaee015 |
152 | use constant BLIB => sub { return @_ |
153 | ? File::Spec->catfile(@_, 'blib') |
154 | : 'blib'; |
155 | }; |
156 | |
157 | use constant LIB => 'lib'; |
158 | use constant LIB_DIR => sub { return @_ |
159 | ? File::Spec->catdir(@_, LIB) |
160 | : LIB; |
161 | }; |
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) |
166 | }; |
167 | use constant ARCH => 'arch'; |
168 | use constant ARCH_DIR => sub { return @_ |
169 | ? File::Spec->catdir(@_, ARCH) |
170 | : ARCH; |
171 | }; |
172 | use constant ARCH_AUTO_DIR => sub { return @_ |
173 | ? File::Spec->catdir(@_,ARCH,AUTO) |
174 | : File::Spec->catdir(ARCH,AUTO) |
175 | }; |
176 | |
177 | use constant BLIB_LIBDIR => sub { return @_ |
178 | ? File::Spec->catdir( |
179 | @_, BLIB->(), LIB ) |
180 | : File::Spec->catdir( BLIB->(), LIB ); |
181 | }; |
182 | |
183 | use constant CONFIG_USER_LIB_DIR => sub { |
184 | require CPANPLUS::Internals::Utils; |
185 | LIB_DIR->( |
186 | CPANPLUS::Internals::Utils->_home_dir, |
187 | DOT_CPANPLUS |
188 | ); |
189 | }; |
190 | use constant CONFIG_USER_FILE => sub { |
191 | File::Spec->catfile( |
192 | CONFIG_USER_LIB_DIR->(), |
193 | split('::', CONFIG_USER), |
194 | ) . '.pm'; |
195 | }; |
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'} |
201 | ); |
202 | |
203 | ### XXX use constants |
204 | File::Spec->catfile( |
205 | $dir, qw[Config System.pm] |
206 | ); |
207 | }; |
208 | |
209 | use constant README => sub { my $obj = $_[0]; |
210 | my $pkg = $obj->package_name; |
211 | $pkg .= '-' . $obj->package_version . |
212 | '.readme'; |
213 | return $pkg; |
214 | }; |
4443dd53 |
215 | use constant META_EXT => 'meta'; |
216 | |
217 | use constant META => sub { my $obj = $_[0]; |
218 | my $pkg = $obj->package_name; |
219 | $pkg .= '-' . $obj->package_version . |
220 | '.' . META_EXT; |
221 | return $pkg; |
222 | }; |
223 | |
6aaee015 |
224 | use constant OPEN_FILE => sub { |
225 | my($file, $mode) = (@_, ''); |
226 | my $fh; |
227 | open $fh, "$mode" . $file |
228 | or error(loc( |
229 | "Could not open file '%1': %2", |
230 | $file, $!)); |
231 | return $fh if $fh; |
232 | return; |
233 | }; |
5bc5f6dc |
234 | |
235 | use constant OPEN_DIR => sub { |
236 | my $dir = shift; |
237 | my $dh; |
238 | opendir $dh, $dir or error(loc( |
239 | "Could not open dir '%1': %2", $dir, $! |
240 | )); |
241 | |
242 | return $dh if $dh; |
243 | return; |
244 | }; |
245 | |
246 | use constant READ_DIR => sub { |
247 | my $dir = shift; |
248 | my $dh = OPEN_DIR->( $dir ) or return; |
249 | |
250 | ### exclude . and .. |
5879cbe1 |
251 | my @files = grep { $_ !~ /^\.{1,2}/ } |
5bc5f6dc |
252 | readdir($dh); |
5879cbe1 |
253 | |
254 | ### Remove trailing dot on VMS when |
255 | ### using VMS syntax. |
256 | if( ON_VMS ) { |
257 | s/(?<!\^)\.$// for @files; |
258 | } |
5bc5f6dc |
259 | |
260 | return @files; |
261 | }; |
262 | |
6aaee015 |
263 | use constant STRIP_GZ_SUFFIX |
264 | => sub { |
265 | my $file = $_[0] or return; |
266 | $file =~ s/.gz$//i; |
267 | return $file; |
268 | }; |
269 | |
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" |
280 | }; |
281 | use constant TESTERS_URL => sub { |
a3de5d0b |
282 | 'http://cpantesters.org/distro/'. |
283 | uc(substr($_[0],0,1)) .'/'. $_[0] . '.yaml'; |
6aaee015 |
284 | }; |
285 | use constant TESTERS_DETAILS_URL |
286 | => sub { |
a3de5d0b |
287 | 'http://cpantesters.org/distro/'. |
288 | uc(substr($_[0],0,1)) .'/'. $_[0]; |
6aaee015 |
289 | }; |
290 | |
291 | use constant CREATE_FILE_URI |
292 | => sub { |
293 | my $dir = $_[0] or return; |
294 | return $dir =~ m|^/| |
5879cbe1 |
295 | ? 'file://' . $dir |
296 | : 'file:///' . $dir; |
6aaee015 |
297 | }; |
298 | |
5879cbe1 |
299 | use constant EMPTY_DSLIP => ' '; |
300 | |
5bc5f6dc |
301 | use constant CUSTOM_AUTHOR_ID |
302 | => 'LOCAL'; |
303 | |
6aaee015 |
304 | use constant DOT_SHELL_DEFAULT_RC |
305 | => '.shell-default.rc'; |
4443dd53 |
306 | |
307 | use constant SOURCE_SQLITE_DB |
308 | => 'db.sql'; |
6aaee015 |
309 | |
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] |
318 | }; |
319 | use constant PERL_CORE => 'perl'; |
a0995fd4 |
320 | use constant STORABLE_EXT => '.stored'; |
6aaee015 |
321 | |
322 | use constant GET_XS_FILES => sub { my $dir = $_[0] or return; |
323 | require File::Find; |
324 | my @files; |
325 | File::Find::find( |
326 | sub { push @files, $File::Find::name |
327 | if $File::Find::name =~ /\.xs$/i |
328 | }, $dir ); |
329 | |
330 | return @files; |
331 | }; |
332 | |
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'; |
338 | return $name; |
339 | }; |
340 | |
6aaee015 |
341 | use constant ON_OLD_CYGWIN => do { ON_CYGWIN and $] < 5.008 |
342 | ? loc( |
343 | "Your perl version for %1 is too low; ". |
344 | "Require %2 or higher for this function", |
345 | $^O, '5.8.0' ) |
346 | : ''; |
347 | }; |
348 | |
349 | ### XXX these 2 are probably obsolete -- check & remove; |
350 | use constant DOT_EXISTS => '.exists'; |
351 | |
352 | use constant QUOTE_PERL_ONE_LINER |
353 | => sub { my $line = shift or return; |
354 | |
355 | ### use double quotes on these systems |
356 | return qq["$line"] |
357 | if ON_WIN32 || ON_NETWARE || ON_VMS; |
358 | |
359 | ### single quotes on the rest |
360 | return qq['$line']; |
361 | }; |
362 | |
363 | 1; |
364 | |
365 | # Local variables: |
366 | # c-indentation-style: bsd |
367 | # c-basic-offset: 4 |
368 | # indent-tabs-mode: nil |
369 | # End: |
370 | # vim: expandtab shiftwidth=4: |