ext/CPANPLUS/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: