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