PageRenderTime 47ms CodeModel.GetById 16ms RepoModel.GetById 0ms app.codeStats 0ms

/cpan/CPANPLUS-Dist-Build/t/inc/conf.pl

https://github.com/dougwilson/perl
Perl | 295 lines | 138 code | 50 blank | 107 comment | 25 complexity | 993ff5acbf72ee7b401f61e31a07abe2 MD5 | raw file
  1. ### On VMS, the ENV is not reset after the program terminates.
  2. ### So reset it here explicitly
  3. my ($old_env_path, $old_env_perl5lib);
  4. BEGIN {
  5. use FindBin;
  6. use File::Spec;
  7. ### paths to our own 'lib' and 'inc' dirs
  8. ### include them, relative from t/
  9. my @paths = map { "$FindBin::Bin/$_" } qw[../lib inc];
  10. ### absolute'ify the paths in @INC;
  11. my @rel2abs = map { File::Spec->rel2abs( $_ ) }
  12. grep { not File::Spec->file_name_is_absolute( $_ ) } @INC;
  13. ### use require to make devel::cover happy
  14. require lib;
  15. for ( @paths, @rel2abs ) {
  16. my $l = 'lib';
  17. $l->import( $_ )
  18. }
  19. use Config;
  20. ### and add them to the environment, so shellouts get them
  21. $old_env_perl5lib = $ENV{'PERL5LIB'};
  22. $ENV{'PERL5LIB'} = join $Config{'path_sep'},
  23. grep { defined } $ENV{'PERL5LIB'}, @paths, @rel2abs;
  24. ### add CPANPLUS' bin dir to the front of $ENV{PATH}, so that cpanp-run-perl
  25. ### and friends get picked up, only under PERL_CORE though.
  26. $old_env_path = $ENV{PATH};
  27. if ( $ENV{PERL_CORE} ) {
  28. $ENV{'PATH'} = join $Config{'path_sep'},
  29. grep { defined } "$FindBin::Bin/../../../utils", $ENV{'PATH'};
  30. }
  31. ### Fix up the path to perl, as we're about to chdir
  32. ### but only under perlcore, or if the path contains delimiters,
  33. ### meaning it's relative, but not looked up in your $PATH
  34. $^X = File::Spec->rel2abs( $^X )
  35. if $ENV{PERL_CORE} or ( $^X =~ m|[/\\]| );
  36. ### chdir to our own test dir, so we know all files are relative
  37. ### to this point, no matter whether run from perlcore tests or
  38. ### regular CPAN installs
  39. chdir "$FindBin::Bin" if -d "$FindBin::Bin"
  40. }
  41. BEGIN {
  42. use IPC::Cmd;
  43. ### Win32 has issues with redirecting FD's properly in IPC::Run:
  44. ### Can't redirect fd #4 on Win32 at IPC/Run.pm line 2801
  45. $IPC::Cmd::USE_IPC_RUN = 0 if $^O eq 'MSWin32';
  46. $IPC::Cmd::USE_IPC_RUN = 0 if $^O eq 'MSWin32';
  47. }
  48. ### Use a $^O comparison, as depending on module at this time
  49. ### may cause weird errors/warnings
  50. END {
  51. if ($^O eq 'VMS') {
  52. ### VMS environment variables modified by this test need to be put back
  53. ### path is "magic" on VMS, we can not tell if it really existed before
  54. ### this was run, because VMS will magically pretend that a PATH
  55. ### environment variable exists set to the current working directory
  56. $ENV{PATH} = $old_env_path;
  57. if (defined $old_env_perl5lib) {
  58. $ENV{PERL5LIB} = $old_env_perl5lib;
  59. } else {
  60. delete $ENV{PERL5LIB};
  61. }
  62. }
  63. }
  64. use strict;
  65. use CPANPLUS::Configure;
  66. use CPANPLUS::Error ();
  67. use File::Path qw[rmtree];
  68. use FileHandle;
  69. use File::Basename qw[basename];
  70. { ### Force the ignoring of .po files for L::M::S
  71. $INC{'Locale::Maketext::Lexicon.pm'} = __FILE__;
  72. $Locale::Maketext::Lexicon::VERSION = 0;
  73. }
  74. my $Env = 'PERL5_CPANPLUS_TEST_VERBOSE';
  75. # prereq has to be in our package file && core!
  76. use constant TEST_CONF_PREREQ => 'Cwd';
  77. use constant TEST_CONF_MODULE => 'Foo::Bar::EU::NOXS';
  78. use constant TEST_CONF_MODULE_SUB => 'Foo::Bar::EU::NOXS::Sub';
  79. use constant TEST_CONF_AUTHOR => 'EUNOXS';
  80. use constant TEST_CONF_INST_MODULE => 'Foo::Bar';
  81. use constant TEST_CONF_INVALID_MODULE => 'fnurk';
  82. use constant TEST_CONF_MIRROR_DIR => 'dummy-localmirror';
  83. use constant TEST_CONF_CPAN_DIR => 'dummy-CPAN';
  84. use constant TEST_CONF_CPANPLUS_DIR => 'dummy-cpanplus';
  85. use constant TEST_CONF_INSTALL_DIR => File::Spec->rel2abs(
  86. File::Spec->catdir(
  87. TEST_CONF_CPANPLUS_DIR,
  88. 'install'
  89. )
  90. );
  91. ### we might need this Some Day when we're installing into
  92. ### our own sandbox. see t/20.t for details
  93. # use constant TEST_INSTALL_DIR => do {
  94. # my $dir = File::Spec->rel2abs( 'dummy-perl' );
  95. #
  96. # ### clean up paths if we are on win32
  97. # ### dirs with spaces will be.. bad :(
  98. # $^O eq 'MSWin32'
  99. # ? Win32::GetShortPathName( $dir )
  100. # : $dir;
  101. # };
  102. # use constant TEST_INSTALL_DIR_LIB
  103. # => File::Spec->catdir( TEST_INSTALL_DIR, 'lib' );
  104. # use constant TEST_INSTALL_DIR_BIN
  105. # => File::Spec->catdir( TEST_INSTALL_DIR, 'bin' );
  106. # use constant TEST_INSTALL_DIR_MAN1
  107. # => File::Spec->catdir( TEST_INSTALL_DIR, 'man', 'man1' );
  108. # use constant TEST_INSTALL_DIR_MAN3
  109. # => File::Spec->catdir( TEST_INSTALL_DIR, 'man', 'man3' );
  110. # use constant TEST_INSTALL_DIR_ARCH
  111. # => File::Spec->catdir( TEST_INSTALL_DIR, 'arch' );
  112. #
  113. # use constant TEST_INSTALL_EU_MM_FLAGS =>
  114. # ' INSTALLDIRS=site' .
  115. # ' INSTALLSITELIB=' . TEST_INSTALL_DIR_LIB .
  116. # ' INSTALLSITEARCH=' . TEST_INSTALL_DIR_ARCH . # .packlist
  117. # ' INSTALLARCHLIB=' . TEST_INSTALL_DIR_ARCH . # perllocal.pod
  118. # ' INSTALLSITEBIN=' . TEST_INSTALL_DIR_BIN .
  119. # ' INSTALLSCRIPT=' . TEST_INSTALL_DIR_BIN .
  120. # ' INSTALLSITEMAN1DIR=' . TEST_INSTALL_DIR_MAN1 .
  121. # ' INSTALLSITEMAN3DIR=' . TEST_INSTALL_DIR_MAN3;
  122. sub dummy_cpan_dir {
  123. ### VMS needs this in directory format for rel2abs
  124. my $test_dir = $^O eq 'VMS'
  125. ? File::Spec->catdir(TEST_CONF_CPAN_DIR)
  126. : TEST_CONF_CPAN_DIR;
  127. ### Convert to an absolute file specification
  128. my $abs_test_dir = File::Spec->rel2abs($test_dir);
  129. ### According to John M: the hosts path needs to be in UNIX format.
  130. ### File::Spec::Unix->rel2abs does not work at all on VMS
  131. $abs_test_dir = VMS::Filespec::unixify( $abs_test_dir ) if $^O eq 'VMS';
  132. return $abs_test_dir;
  133. }
  134. sub gimme_conf {
  135. ### don't load any other configs than the heuristic one
  136. ### during tests. They might hold broken/incorrect data
  137. ### for our test suite. Bug [perl #43629] showed this.
  138. my $conf = CPANPLUS::Configure->new( load_configs => 0 );
  139. my $dummy_cpan = dummy_cpan_dir();
  140. $conf->set_conf( hosts => [ {
  141. path => $dummy_cpan,
  142. scheme => 'file',
  143. } ],
  144. );
  145. $conf->set_conf( base => File::Spec->rel2abs(TEST_CONF_CPANPLUS_DIR));
  146. $conf->set_conf( dist_type => '' );
  147. $conf->set_conf( signature => 0 );
  148. $conf->set_conf( verbose => 1 ) if $ENV{ $Env };
  149. ### never use a pager in the test suite
  150. $conf->set_program( pager => '' );
  151. ### dmq tells us that we should run with /nologo
  152. ### if using nmake, as it's very noisy otherwise.
  153. { my $make = $conf->get_program('make');
  154. if( $make and basename($make) =~ /^nmake/i ) {
  155. $conf->set_conf( makeflags => '/nologo' );
  156. }
  157. }
  158. ### CPANPLUS::Config checks 3 specific scenarios first
  159. ### when looking for cpanp-run-perl: parallel to cpanp,
  160. ### parallel to CPANPLUS.pm, or installed into a custom
  161. ### prefix like /tmp/foo. Only *THEN* does it check the
  162. ### the path.
  163. ### If the perl core is extracted to a directory that has
  164. ### cpanp-run-perl installed the same amount of 'uplevels'
  165. ### as the /tmp/foo prefix, we'll pull in the wrong script
  166. ### by accident.
  167. ### Since we set the path to cpanp-run-perl explicitly
  168. ### at the top of this script, it's best to update the config
  169. ### ourselves with a path lookup, rather than rely on its
  170. ### heuristics. Thanks to David Wheeler, Josh Jore and Vincent
  171. ### Pit for helping to track this down.
  172. if( $ENV{PERL_CORE} ) {
  173. $conf->set_program( "perlwrapper" => IPC::Cmd::can_run('cpanp-run-perl') );
  174. }
  175. $conf->set_conf( source_engine => $ENV{CPANPLUS_SOURCE_ENGINE} )
  176. if $ENV{CPANPLUS_SOURCE_ENGINE};
  177. _clean_test_dir( [
  178. $conf->get_conf('base'),
  179. TEST_CONF_MIRROR_DIR,
  180. # TEST_INSTALL_DIR_LIB,
  181. # TEST_INSTALL_DIR_BIN,
  182. # TEST_INSTALL_DIR_MAN1,
  183. # TEST_INSTALL_DIR_MAN3,
  184. ], ( $ENV{PERL_CORE} ? 0 : 1 ) );
  185. return $conf;
  186. };
  187. # placeholder
  188. ### clean these files if we're under perl core
  189. END {
  190. if ( $ENV{PERL_CORE} ) {
  191. _clean_test_dir( [
  192. gimme_conf->get_conf('base'),
  193. TEST_CONF_MIRROR_DIR,
  194. # TEST_INSTALL_DIR_LIB,
  195. # TEST_INSTALL_DIR_BIN,
  196. # TEST_INSTALL_DIR_MAN1,
  197. # TEST_INSTALL_DIR_MAN3,
  198. ], 0 ); # DO NOT be verbose under perl core -- makes tests fail
  199. }
  200. }
  201. ### whenever we start a new script, we want to clean out our
  202. ### old files from the test '.cpanplus' dir..
  203. sub _clean_test_dir {
  204. my $dirs = shift || [];
  205. my $verbose = shift || 0;
  206. for my $dir ( @$dirs ) {
  207. ### no point if it doesn't exist;
  208. next unless -d $dir;
  209. my $dh;
  210. opendir $dh, $dir or die "Could not open basedir '$dir': $!";
  211. while( my $file = readdir $dh ) {
  212. next if $file =~ /^\./; # skip dot files
  213. my $path = File::Spec->catfile( $dir, $file );
  214. ### directory, rmtree it
  215. if( -d $path ) {
  216. ### John Malmberg reports yet another VMS issue:
  217. ### A directory name on VMS in VMS format ends with .dir
  218. ### when it is referenced as a file.
  219. ### In UNIX format traditionally PERL on VMS does not remove the
  220. ### '.dir', however the VMS C library conversion routines do
  221. ### remove the '.dir' and the VMS C library routines can not
  222. ### handle the '.dir' being present on UNIX format filenames.
  223. ### So code doing the fixup has on VMS has to be able to handle
  224. ### both UNIX format names and VMS format names.
  225. ### XXX See http://www.xray.mpe.mpg.de/
  226. ### mailing-lists/perl5-porters/2007-10/msg00064.html
  227. ### for details -- the below regex could use some touchups
  228. ### according to John. M.
  229. $file =~ s/\.dir$//i if $^O eq 'VMS';
  230. my $dirpath = File::Spec->catdir( $dir, $file );
  231. print "# Deleting directory '$dirpath'\n" if $verbose;
  232. eval { rmtree( $dirpath ) };
  233. warn "Could not delete '$dirpath' while cleaning up '$dir'"
  234. if $@;
  235. ### regular file
  236. } else {
  237. print "# Deleting file '$path'\n" if $verbose;
  238. 1 while unlink $path;
  239. }
  240. }
  241. close $dh;
  242. }
  243. return 1;
  244. }
  245. 1;