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