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