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