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 | |
16 | |
17 | $VERSION = 0.01; |
18 | @ISA = qw[Exporter]; |
19 | @EXPORT = Package::Constants->list( __PACKAGE__ ); |
20 | |
21 | |
22 | sub constants { @EXPORT }; |
23 | |
24 | use constant INSTALLER_BUILD |
25 | => 'CPANPLUS::Dist::Build'; |
26 | use constant INSTALLER_MM => 'CPANPLUS::Dist::MM'; |
27 | use constant INSTALLER_SAMPLE |
28 | => 'CPANPLUS::Dist::Sample'; |
29 | use constant INSTALLER_BASE => 'CPANPLUS::Dist::Base'; |
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 | |
39 | use constant TARGET_CREATE => 'create'; |
40 | use constant TARGET_PREPARE => 'prepare'; |
41 | use constant TARGET_INSTALL => 'install'; |
42 | use constant TARGET_IGNORE => 'ignore'; |
5bc5f6dc |
43 | |
44 | use constant ON_WIN32 => $^O eq 'MSWin32'; |
45 | use constant ON_NETWARE => $^O eq 'NetWare'; |
46 | use constant ON_CYGWIN => $^O eq 'cygwin'; |
47 | use constant ON_VMS => $^O eq 'VMS'; |
48 | |
49 | use constant DOT_CPANPLUS => ON_VMS ? '_cpanplus' : '.cpanplus'; |
6aaee015 |
50 | |
51 | use constant OPT_AUTOFLUSH => '-MCPANPLUS::Internals::Utils::Autoflush'; |
52 | |
53 | use constant UNKNOWN_DL_LOCATION |
54 | => 'UNKNOWN-ORIGIN'; |
55 | |
56 | use constant NMAKE => 'nmake.exe'; |
57 | use constant NMAKE_URL => |
58 | 'ftp://ftp.microsoft.com/Softlib/MSLFILES/nmake15.exe'; |
59 | |
60 | use 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 | |
66 | use constant IS_CODEREF => sub { ref $_[-1] eq 'CODE' }; |
67 | use constant IS_MODOBJ => sub { UNIVERSAL::isa($_[-1], |
68 | 'CPANPLUS::Module') }; |
69 | use constant IS_FAKE_MODOBJ => sub { UNIVERSAL::isa($_[-1], |
70 | 'CPANPLUS::Module::Fake') }; |
71 | use constant IS_AUTHOBJ => sub { UNIVERSAL::isa($_[-1], |
72 | 'CPANPLUS::Module::Author') }; |
73 | use constant IS_FAKE_AUTHOBJ |
74 | => sub { UNIVERSAL::isa($_[-1], |
75 | 'CPANPLUS::Module::Author::Fake') }; |
76 | |
77 | use constant IS_CONFOBJ => sub { UNIVERSAL::isa($_[-1], |
78 | 'CPANPLUS::Configure') }; |
79 | |
80 | use constant IS_RVOBJ => sub { UNIVERSAL::isa($_[-1], |
81 | 'CPANPLUS::Backend::RV') }; |
82 | |
83 | use constant IS_INTERNALS_OBJ |
84 | => sub { UNIVERSAL::isa($_[-1], |
85 | 'CPANPLUS::Internals') }; |
86 | |
87 | use constant IS_FILE => sub { return 1 if -e $_[-1] }; |
88 | |
89 | use 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 | |
99 | use 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 | }; |
108 | use constant IS_DIR => sub { return 1 if -d $_[-1] }; |
109 | |
110 | use 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'. |
122 | use 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 |
132 | use constant MAKEFILE_PL => sub { return @_ |
133 | ? File::Spec->catfile( @_, |
134 | 'Makefile.PL' ) |
135 | : 'Makefile.PL'; |
6aaee015 |
136 | }; |
137 | use constant BUILD_PL => sub { return @_ |
138 | ? File::Spec->catfile( @_, |
139 | 'Build.PL' ) |
140 | : 'Build.PL'; |
141 | }; |
142 | |
143 | use constant BLIB => sub { return @_ |
144 | ? File::Spec->catfile(@_, 'blib') |
145 | : 'blib'; |
146 | }; |
147 | |
148 | use constant LIB => 'lib'; |
149 | use constant LIB_DIR => sub { return @_ |
150 | ? File::Spec->catdir(@_, LIB) |
151 | : LIB; |
152 | }; |
153 | use constant AUTO => 'auto'; |
154 | use constant LIB_AUTO_DIR => sub { return @_ |
155 | ? File::Spec->catdir(@_, LIB, AUTO) |
156 | : File::Spec->catdir(LIB, AUTO) |
157 | }; |
158 | use constant ARCH => 'arch'; |
159 | use constant ARCH_DIR => sub { return @_ |
160 | ? File::Spec->catdir(@_, ARCH) |
161 | : ARCH; |
162 | }; |
163 | use constant ARCH_AUTO_DIR => sub { return @_ |
164 | ? File::Spec->catdir(@_,ARCH,AUTO) |
165 | : File::Spec->catdir(ARCH,AUTO) |
166 | }; |
167 | |
168 | use constant BLIB_LIBDIR => sub { return @_ |
169 | ? File::Spec->catdir( |
170 | @_, BLIB->(), LIB ) |
171 | : File::Spec->catdir( BLIB->(), LIB ); |
172 | }; |
173 | |
174 | use 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 | }; |
181 | use constant CONFIG_USER_FILE => sub { |
182 | File::Spec->catfile( |
183 | CONFIG_USER_LIB_DIR->(), |
184 | split('::', CONFIG_USER), |
185 | ) . '.pm'; |
186 | }; |
187 | use 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 | |
200 | use constant README => sub { my $obj = $_[0]; |
201 | my $pkg = $obj->package_name; |
202 | $pkg .= '-' . $obj->package_version . |
203 | '.readme'; |
204 | return $pkg; |
205 | }; |
206 | use 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 | |
217 | use 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 | |
228 | use constant READ_DIR => sub { |
229 | my $dir = shift; |
230 | my $dh = OPEN_DIR->( $dir ) or return; |
231 | |
232 | ### exclude . and .. |
233 | my @files = grep { $_ !~ /^\.{1,2}/ } |
234 | readdir($dh); |
235 | |
236 | return @files; |
237 | }; |
238 | |
6aaee015 |
239 | use constant STRIP_GZ_SUFFIX |
240 | => sub { |
241 | my $file = $_[0] or return; |
242 | $file =~ s/.gz$//i; |
243 | return $file; |
244 | }; |
245 | |
246 | use constant CHECKSUMS => 'CHECKSUMS'; |
247 | use constant PGP_HEADER => '-----BEGIN PGP SIGNED MESSAGE-----'; |
248 | use constant ENV_CPANPLUS_CONFIG |
249 | => 'PERL5_CPANPLUS_CONFIG'; |
250 | use constant ENV_CPANPLUS_IS_EXECUTING |
251 | => 'PERL5_CPANPLUS_IS_EXECUTING'; |
252 | use constant DEFAULT_EMAIL => 'cpanplus@example.com'; |
253 | use constant CPANPLUS_UA => sub { ### for the version number ### |
254 | require CPANPLUS::Internals; |
255 | "CPANPLUS/$CPANPLUS::Internals::VERSION" |
256 | }; |
257 | use constant TESTERS_URL => sub { |
258 | "http://testers.cpan.org/show/" . |
259 | $_[0] .".yaml" |
260 | }; |
261 | use constant TESTERS_DETAILS_URL |
262 | => sub { |
263 | 'http://testers.cpan.org/show/' . |
264 | $_[0] . '.html'; |
265 | }; |
266 | |
267 | use constant CREATE_FILE_URI |
268 | => sub { |
269 | my $dir = $_[0] or return; |
270 | return $dir =~ m|^/| |
271 | ? 'file:/' . $dir |
272 | : 'file://' . $dir; |
273 | }; |
274 | |
5bc5f6dc |
275 | use constant CUSTOM_AUTHOR_ID |
276 | => 'LOCAL'; |
277 | |
6aaee015 |
278 | use constant DOT_SHELL_DEFAULT_RC |
279 | => '.shell-default.rc'; |
280 | |
281 | use constant PREREQ_IGNORE => 0; |
282 | use constant PREREQ_INSTALL => 1; |
283 | use constant PREREQ_ASK => 2; |
284 | use constant PREREQ_BUILD => 3; |
285 | use constant BOOLEANS => [0,1]; |
286 | use constant CALLING_FUNCTION |
287 | => sub { my $lvl = $_[0] || 0; |
288 | return join '::', (caller(2+$lvl))[3] |
289 | }; |
290 | use constant PERL_CORE => 'perl'; |
291 | |
292 | use constant GET_XS_FILES => sub { my $dir = $_[0] or return; |
293 | require File::Find; |
294 | my @files; |
295 | File::Find::find( |
296 | sub { push @files, $File::Find::name |
297 | if $File::Find::name =~ /\.xs$/i |
298 | }, $dir ); |
299 | |
300 | return @files; |
301 | }; |
302 | |
303 | use constant INSTALL_LOG_FILE |
304 | => sub { my $obj = shift or return; |
305 | my $name = $obj->name; $name =~ s/::/-/g; |
306 | $name .= '-'. $obj->version; |
307 | $name .= '-'. scalar(time) . '.log'; |
308 | return $name; |
309 | }; |
310 | |
6aaee015 |
311 | use constant ON_OLD_CYGWIN => do { ON_CYGWIN and $] < 5.008 |
312 | ? loc( |
313 | "Your perl version for %1 is too low; ". |
314 | "Require %2 or higher for this function", |
315 | $^O, '5.8.0' ) |
316 | : ''; |
317 | }; |
318 | |
319 | ### XXX these 2 are probably obsolete -- check & remove; |
320 | use constant DOT_EXISTS => '.exists'; |
321 | |
322 | use constant QUOTE_PERL_ONE_LINER |
323 | => sub { my $line = shift or return; |
324 | |
325 | ### use double quotes on these systems |
326 | return qq["$line"] |
327 | if ON_WIN32 || ON_NETWARE || ON_VMS; |
328 | |
329 | ### single quotes on the rest |
330 | return qq['$line']; |
331 | }; |
332 | |
333 | 1; |
334 | |
335 | # Local variables: |
336 | # c-indentation-style: bsd |
337 | # c-basic-offset: 4 |
338 | # indent-tabs-mode: nil |
339 | # End: |
340 | # vim: expandtab shiftwidth=4: |