This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
update to CPANPLUS 0.88
[perl5.git] / lib / CPANPLUS / Internals / Constants.pm
1 package CPANPLUS::Internals::Constants;
2
3 use strict;
4
5 use CPANPLUS::Error;
6
7 use Config;
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 @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';
27 use constant INSTALLER_BASE => 'CPANPLUS::Dist::Base';  
28 use constant INSTALLER_AUTOBUNDLE
29                             => 'CPANPLUS::Dist::Autobundle';
30
31 use constant SHELL_DEFAULT  => 'CPANPLUS::Shell::Default';
32 use constant SHELL_CLASSIC  => 'CPANPLUS::Shell::Classic';
33
34 use constant CONFIG         => 'CPANPLUS::Config';
35 use constant CONFIG_USER    => 'CPANPLUS::Config::User';
36 use constant CONFIG_SYSTEM  => 'CPANPLUS::Config::System';
37 use constant CONFIG_BOXED   => 'CPANPLUS::Config::Boxed';
38
39 use constant DEFAULT_SOURCE_ENGINE
40                             => 'CPANPLUS::Internals::Source::Memory';
41
42 use constant TARGET_INIT    => 'init';
43 use constant TARGET_CREATE  => 'create';
44 use constant TARGET_PREPARE => 'prepare';
45 use constant TARGET_INSTALL => 'install';
46 use constant TARGET_IGNORE  => 'ignore';
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'; 
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                             };   
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                             };                   
136 use constant MAKEFILE_PL    => sub { return @_
137                                         ? File::Spec->catfile( @_,
138                                                             'Makefile.PL' )
139                                         : 'Makefile.PL';
140                             }; 
141 use constant BUILD_PL       => sub { return @_
142                                         ? File::Spec->catfile( @_,
143                                                             'Build.PL' )
144                                         : 'Build.PL';
145                             };
146                       
147 use constant META_YML       => sub { return @_
148                                         ? File::Spec->catfile( @_, 'META.yml' )
149                                         : 'META.yml';
150                             }; 
151
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                             };
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                             
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                             };      
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 ..
251                                     my @files =  grep { $_ !~ /^\.{1,2}/ }
252                                                     readdir($dh);
253
254                                     ### Remove trailing dot on VMS when
255                                     ### using VMS syntax.
256                                     if( ON_VMS ) {
257                                         s/(?<!\^)\.$// for @files;
258                                     }
259                                     
260                                     return @files;
261                             };  
262
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 {
282                                     'http://cpantesters.org/distro/'.
283                                     uc(substr($_[0],0,1)) .'/'. $_[0] . '.yaml';
284                                 };
285 use constant TESTERS_DETAILS_URL
286                             => sub {
287                                     'http://cpantesters.org/distro/'.
288                                     uc(substr($_[0],0,1)) .'/'. $_[0];
289                                 };         
290
291 use constant CREATE_FILE_URI    
292                             => sub { 
293                                     my $dir = $_[0] or return;
294                                     return $dir =~ m|^/| 
295                                         ? 'file://'  . $dir
296                                         : 'file:///' . $dir;   
297                             };        
298
299 use constant EMPTY_DSLIP    => '     ';
300
301 use constant CUSTOM_AUTHOR_ID
302                             => 'LOCAL';
303
304 use constant DOT_SHELL_DEFAULT_RC
305                             => '.shell-default.rc';
306                             
307 use constant SOURCE_SQLITE_DB
308                             => 'db.sql';
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';
320 use constant STORABLE_EXT   => '.stored';
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
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: