[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
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:
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |