diff options
Diffstat (limited to 'Master/tlpkg/tlperl0/lib/CPANPLUS/Internals/Constants.pm')
-rwxr-xr-x | Master/tlpkg/tlperl0/lib/CPANPLUS/Internals/Constants.pm | 375 |
1 files changed, 375 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl0/lib/CPANPLUS/Internals/Constants.pm b/Master/tlpkg/tlperl0/lib/CPANPLUS/Internals/Constants.pm new file mode 100755 index 00000000000..1a38200dfb7 --- /dev/null +++ b/Master/tlpkg/tlperl0/lib/CPANPLUS/Internals/Constants.pm @@ -0,0 +1,375 @@ +package CPANPLUS::Internals::Constants; + +use strict; + +use CPANPLUS::Error; + +use Config; +use File::Spec; +use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; + +require Exporter; +use vars qw[$VERSION @ISA @EXPORT]; + +use Package::Constants; + +@ISA = qw[Exporter]; +@EXPORT = Package::Constants->list( __PACKAGE__ ); + + +sub constants { @EXPORT }; + +use constant INSTALLER_BUILD + => 'CPANPLUS::Dist::Build'; +use constant INSTALLER_MM => 'CPANPLUS::Dist::MM'; +use constant INSTALLER_SAMPLE + => 'CPANPLUS::Dist::Sample'; +use constant INSTALLER_BASE => 'CPANPLUS::Dist::Base'; +use constant INSTALLER_AUTOBUNDLE + => 'CPANPLUS::Dist::Autobundle'; + +use constant SHELL_DEFAULT => 'CPANPLUS::Shell::Default'; +use constant SHELL_CLASSIC => 'CPANPLUS::Shell::Classic'; + +use constant CONFIG => 'CPANPLUS::Config'; +use constant CONFIG_USER => 'CPANPLUS::Config::User'; +use constant CONFIG_SYSTEM => 'CPANPLUS::Config::System'; +use constant CONFIG_BOXED => 'CPANPLUS::Config::Boxed'; + +use constant DEFAULT_SOURCE_ENGINE + => 'CPANPLUS::Internals::Source::Memory'; + +use constant TARGET_INIT => 'init'; +use constant TARGET_CREATE => 'create'; +use constant TARGET_PREPARE => 'prepare'; +use constant TARGET_INSTALL => 'install'; +use constant TARGET_IGNORE => 'ignore'; + +use constant ON_WIN32 => $^O eq 'MSWin32'; +use constant ON_NETWARE => $^O eq 'NetWare'; +use constant ON_CYGWIN => $^O eq 'cygwin'; +use constant ON_VMS => $^O eq 'VMS'; + +use constant DOT_CPANPLUS => ON_VMS ? '_cpanplus' : '.cpanplus'; + +use constant OPT_AUTOFLUSH => '-MCPANPLUS::Internals::Utils::Autoflush'; + +use constant UNKNOWN_DL_LOCATION + => 'UNKNOWN-ORIGIN'; + +use constant NMAKE => 'nmake.exe'; +use constant NMAKE_URL => + 'ftp://ftp.microsoft.com/Softlib/MSLFILES/nmake15.exe'; + +use constant INSTALL_VIA_PACKAGE_MANAGER + => sub { my $fmt = $_[0] or return; + return 1 if $fmt ne INSTALLER_BUILD and + $fmt ne INSTALLER_MM; + }; + +use constant IS_CODEREF => sub { ref $_[-1] eq 'CODE' }; +use constant IS_MODOBJ => sub { UNIVERSAL::isa($_[-1], + 'CPANPLUS::Module') }; +use constant IS_FAKE_MODOBJ => sub { UNIVERSAL::isa($_[-1], + 'CPANPLUS::Module::Fake') }; +use constant IS_AUTHOBJ => sub { UNIVERSAL::isa($_[-1], + 'CPANPLUS::Module::Author') }; +use constant IS_FAKE_AUTHOBJ + => sub { UNIVERSAL::isa($_[-1], + 'CPANPLUS::Module::Author::Fake') }; + +use constant IS_CONFOBJ => sub { UNIVERSAL::isa($_[-1], + 'CPANPLUS::Configure') }; + +use constant IS_RVOBJ => sub { UNIVERSAL::isa($_[-1], + 'CPANPLUS::Backend::RV') }; + +use constant IS_INTERNALS_OBJ + => sub { UNIVERSAL::isa($_[-1], + 'CPANPLUS::Internals') }; + +use constant IS_FILE => sub { return 1 if -e $_[-1] }; + +use constant FILE_EXISTS => sub { + my $file = $_[-1]; + return 1 if IS_FILE->($file); + local $Carp::CarpLevel = + $Carp::CarpLevel+2; + error(loc( q[File '%1' does not exist], + $file)); + return; + }; + +use constant FILE_READABLE => sub { + my $file = $_[-1]; + return 1 if -e $file && -r _; + local $Carp::CarpLevel = + $Carp::CarpLevel+2; + error( loc( q[File '%1' is not readable ]. + q[or does not exist], $file)); + return; + }; +use constant IS_DIR => sub { return 1 if -d $_[-1] }; + +use constant DIR_EXISTS => sub { + my $dir = $_[-1]; + return 1 if IS_DIR->($dir); + local $Carp::CarpLevel = + $Carp::CarpLevel+2; + error(loc(q[Dir '%1' does not exist], + $dir)); + return; + }; + + ### On VMS, if the $Config{make} is either MMK + ### or MMS, then the makefile is 'DESCRIP.MMS'. +use constant MAKEFILE => sub { my $file = + (ON_VMS and + $Config::Config{make} =~ /MM[S|K]/i) + ? 'DESCRIP.MMS' + : 'Makefile'; + + return @_ + ? File::Spec->catfile( @_, $file ) + : $file; + }; +use constant MAKEFILE_PL => sub { return @_ + ? File::Spec->catfile( @_, + 'Makefile.PL' ) + : 'Makefile.PL'; + }; +use constant BUILD_PL => sub { return @_ + ? File::Spec->catfile( @_, + 'Build.PL' ) + : 'Build.PL'; + }; + +use constant META_YML => sub { return @_ + ? File::Spec->catfile( @_, 'META.yml' ) + : 'META.yml'; + }; + +use constant MYMETA_YML => sub { return @_ + ? File::Spec->catfile( @_, 'MYMETA.yml' ) + : 'MYMETA.yml'; + }; + +use constant BLIB => sub { return @_ + ? File::Spec->catfile(@_, 'blib') + : 'blib'; + }; + +use constant LIB => 'lib'; +use constant LIB_DIR => sub { return @_ + ? File::Spec->catdir(@_, LIB) + : LIB; + }; +use constant AUTO => 'auto'; +use constant LIB_AUTO_DIR => sub { return @_ + ? File::Spec->catdir(@_, LIB, AUTO) + : File::Spec->catdir(LIB, AUTO) + }; +use constant ARCH => 'arch'; +use constant ARCH_DIR => sub { return @_ + ? File::Spec->catdir(@_, ARCH) + : ARCH; + }; +use constant ARCH_AUTO_DIR => sub { return @_ + ? File::Spec->catdir(@_,ARCH,AUTO) + : File::Spec->catdir(ARCH,AUTO) + }; + +use constant BLIB_LIBDIR => sub { return @_ + ? File::Spec->catdir( + @_, BLIB->(), LIB ) + : File::Spec->catdir( BLIB->(), LIB ); + }; + +use constant CONFIG_USER_LIB_DIR => sub { + require CPANPLUS::Internals::Utils; + LIB_DIR->( + CPANPLUS::Internals::Utils->_home_dir, + DOT_CPANPLUS + ); + }; +use constant CONFIG_USER_FILE => sub { + File::Spec->catfile( + CONFIG_USER_LIB_DIR->(), + split('::', CONFIG_USER), + ) . '.pm'; + }; +use constant CONFIG_SYSTEM_FILE => sub { + require CPANPLUS::Internals; + require File::Basename; + my $dir = File::Basename::dirname( + $INC{'CPANPLUS/Internals.pm'} + ); + + ### XXX use constants + File::Spec->catfile( + $dir, qw[Config System.pm] + ); + }; + +use constant README => sub { my $obj = $_[0]; + my $pkg = $obj->package_name; + $pkg .= '-' . $obj->package_version . + '.readme'; + return $pkg; + }; +use constant META_EXT => 'meta'; + +use constant META => sub { my $obj = $_[0]; + my $pkg = $obj->package_name; + $pkg .= '-' . $obj->package_version . + '.' . META_EXT; + return $pkg; + }; + +use constant OPEN_FILE => sub { + my($file, $mode) = (@_, ''); + my $fh; + open $fh, "$mode" . $file + or error(loc( + "Could not open file '%1': %2", + $file, $!)); + return $fh if $fh; + return; + }; + +use constant OPEN_DIR => sub { + my $dir = shift; + my $dh; + opendir $dh, $dir or error(loc( + "Could not open dir '%1': %2", $dir, $! + )); + + return $dh if $dh; + return; + }; + +use constant READ_DIR => sub { + my $dir = shift; + my $dh = OPEN_DIR->( $dir ) or return; + + ### exclude . and .. + my @files = grep { $_ !~ /^\.{1,2}/ } + readdir($dh); + + ### Remove trailing dot on VMS when + ### using VMS syntax. + if( ON_VMS ) { + s/(?<!\^)\.$// for @files; + } + + return @files; + }; + +use constant STRIP_GZ_SUFFIX + => sub { + my $file = $_[0] or return; + $file =~ s/.gz$//i; + return $file; + }; + +use constant CHECKSUMS => 'CHECKSUMS'; +use constant PGP_HEADER => '-----BEGIN PGP SIGNED MESSAGE-----'; +use constant ENV_CPANPLUS_CONFIG + => 'PERL5_CPANPLUS_CONFIG'; +use constant ENV_CPANPLUS_IS_EXECUTING + => 'PERL5_CPANPLUS_IS_EXECUTING'; +use constant DEFAULT_EMAIL => 'cpanplus@example.com'; +use constant CPANPLUS_UA => sub { ### for the version number ### + require CPANPLUS::Internals; + "CPANPLUS/$CPANPLUS::Internals::VERSION" + }; +use constant TESTERS_URL => sub { + 'http://cpantesters.org/distro/'. + uc(substr($_[0],0,1)) .'/'. $_[0] . '.yaml'; + }; +use constant TESTERS_DETAILS_URL + => sub { + 'http://cpantesters.org/distro/'. + uc(substr($_[0],0,1)) .'/'. $_[0]; + }; + +use constant CREATE_FILE_URI + => sub { + my $dir = $_[0] or return; + return $dir =~ m|^/| + ? 'file://' . $dir + : 'file:///' . $dir; + }; + +use constant EMPTY_DSLIP => ' '; + +use constant CUSTOM_AUTHOR_ID + => 'LOCAL'; + +use constant DOT_SHELL_DEFAULT_RC + => '.shell-default.rc'; + +use constant SOURCE_SQLITE_DB + => 'db.sql'; + +use constant PREREQ_IGNORE => 0; +use constant PREREQ_INSTALL => 1; +use constant PREREQ_ASK => 2; +use constant PREREQ_BUILD => 3; +use constant BOOLEANS => [0,1]; +use constant CALLING_FUNCTION + => sub { my $lvl = $_[0] || 0; + return join '::', (caller(2+$lvl))[3] + }; +use constant PERL_CORE => 'perl'; +use constant STORABLE_EXT => '.stored'; + +use constant GET_XS_FILES => sub { my $dir = $_[0] or return; + require File::Find; + my @files; + File::Find::find( + sub { push @files, $File::Find::name + if $File::Find::name =~ /\.xs$/i + }, $dir ); + + return @files; + }; + +use constant INSTALL_LOG_FILE + => sub { my $obj = shift or return; + my $name = $obj->name; $name =~ s/::/-/g; + $name .= '-'. $obj->version; + $name .= '-'. scalar(time) . '.log'; + return $name; + }; + +use constant ON_OLD_CYGWIN => do { ON_CYGWIN and $] < 5.008 + ? loc( + "Your perl version for %1 is too low; ". + "Require %2 or higher for this function", + $^O, '5.8.0' ) + : ''; + }; + +### XXX these 2 are probably obsolete -- check & remove; +use constant DOT_EXISTS => '.exists'; + +use constant QUOTE_PERL_ONE_LINER + => sub { my $line = shift or return; + + ### use double quotes on these systems + return qq["$line"] + if ON_WIN32 || ON_NETWARE || ON_VMS; + + ### single quotes on the rest + return qq['$line']; + }; + +1; + +# Local variables: +# c-indentation-style: bsd +# c-basic-offset: 4 +# indent-tabs-mode: nil +# End: +# vim: expandtab shiftwidth=4: |