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                                     return @files;
 237                             };
 238
 239 use constant STRIP_GZ_SUFFIX
 240                             => sub {
 241                                     my $file = $_[0] or return;
 242                                     $file =~ s/.gz$//i;
 243                                     return $file;
 244                             };
 245
 246 use constant CHECKSUMS      => 'CHECKSUMS';
 247 use constant PGP_HEADER     => '-----BEGIN PGP SIGNED MESSAGE-----';
 248 use constant ENV_CPANPLUS_CONFIG
 249                             => 'PERL5_CPANPLUS_CONFIG';
 250 use constant ENV_CPANPLUS_IS_EXECUTING
 251                             => 'PERL5_CPANPLUS_IS_EXECUTING';
 252 use constant DEFAULT_EMAIL  => 'cpanplus@example.com';
 253 use constant CPANPLUS_UA    => sub { ### for the version number ###
 254                                      require CPANPLUS::Internals;
 255                                      "CPANPLUS/$CPANPLUS::Internals::VERSION"
 256                                 };
 257 use constant TESTERS_URL    => sub {
 258                                     "http://testers.cpan.org/show/" .
 259                                     $_[0] .".yaml"
 260                                 };
 261 use constant TESTERS_DETAILS_URL
 262                             => sub {
 263                                     'http://testers.cpan.org/show/' .
 264                                     $_[0] . '.html';
 265                                 };
 266
 267 use constant CREATE_FILE_URI
 268                             => sub {
 269                                     my $dir = $_[0] or return;
 270                                     return $dir =~ m|^/|
 271                                         ? 'file:/'  . $dir
 272                                         : 'file://' . $dir;
 273                             };
 274
 275 use constant CUSTOM_AUTHOR_ID
 276                             => 'LOCAL';
 277
 278 use constant DOT_SHELL_DEFAULT_RC
 279                             => '.shell-default.rc';
 280
 281 use constant PREREQ_IGNORE  => 0;
 282 use constant PREREQ_INSTALL => 1;
 283 use constant PREREQ_ASK     => 2;
 284 use constant PREREQ_BUILD   => 3;
 285 use constant BOOLEANS       => [0,1];
 286 use constant CALLING_FUNCTION
 287                             => sub { my $lvl = $_[0] || 0;
 288                                      return join '::', (caller(2+$lvl))[3]
 289                                 };
 290 use constant PERL_CORE      => 'perl';
 291
 292 use constant GET_XS_FILES   => sub { my $dir = $_[0] or return;
 293                                      require File::Find;
 294                                      my @files;
 295                                      File::Find::find(
 296                                         sub { push @files, $File::Find::name
 297                                                 if $File::Find::name =~ /\.xs$/i
 298                                         }, $dir );
 299
 300                                      return @files;
 301                                 };
 302
 303 use constant INSTALL_LOG_FILE
 304                             => sub { my $obj  = shift or return;
 305                                      my $name = $obj->name; $name =~ s/::/-/g;
 306                                      $name .= '-'. $obj->version;
 307                                      $name .= '-'. scalar(time) . '.log';
 308                                      return $name;
 309                                 };
 310
 311 use constant ON_OLD_CYGWIN  => do { ON_CYGWIN and $] < 5.008
 312                                     ? loc(
 313                                        "Your perl version for %1 is too low; ".
 314                                        "Require %2 or higher for this function",
 315                                        $^O, '5.8.0' )
 316                                     : '';
 317                                 };
 318
 319 ### XXX these 2 are probably obsolete -- check & remove;
 320 use constant DOT_EXISTS     => '.exists';
 321
 322 use constant QUOTE_PERL_ONE_LINER
 323                             => sub { my $line = shift or return;
 324
 325                                      ### use double quotes on these systems
 326                                      return qq["$line"]
 327                                         if ON_WIN32 || ON_NETWARE || ON_VMS;
 328
 329                                      ### single quotes on the rest
 330                                      return qq['$line'];
 331                             };
 332
 333 1;
 334
 335 # Local variables:
 336 # c-indentation-style: bsd
 337 # c-basic-offset: 4
 338 # indent-tabs-mode: nil
 339 # End:
 340 # vim: expandtab shiftwidth=4: