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