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

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