lib/CPANPLUS/t/inc/conf.pl

   1 BEGIN {
   2     use FindBin;
   3     use File::Spec;
   4
   5     ### paths to our own 'lib' and 'inc' dirs
   6     ### include them, relative from t/
   7     my @paths   = map { "$FindBin::Bin/$_" } qw[../lib inc];
   8
   9     ### absolute'ify the paths in @INC;
  10     my @rel2abs = map { File::Spec->rel2abs( $_ ) }
  11                     grep { not File::Spec->file_name_is_absolute( $_ ) } @INC;
  12
  13     ### use require to make devel::cover happy
  14     require lib;
  15     for ( @paths, @rel2abs ) {
  16         my $l = 'lib';
  17         $l->import( $_ )
  18     }
  19
  20     use Config;
  21
  22     ### and add them to the environment, so shellouts get them
  23     $ENV{'PERL5LIB'} = join ':',
  24                         grep { defined } $ENV{'PERL5LIB'}, @paths, @rel2abs;
  25
  26     ### add our own path to the front of $ENV{PATH}, so that cpanp-run-perl
  27     ### and friends get picked up
  28     $ENV{'PATH'} = join $Config{'path_sep'},
  29                     grep { defined } "$FindBin::Bin/../bin", $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
  37     ### chdir to our own test dir, so we know all files are relative
  38     ### to this point, no matter whether run from perlcore tests or
  39     ### regular CPAN installs
  40     chdir "$FindBin::Bin" if -d "$FindBin::Bin"
  41 }
  42
  43 BEGIN {
  44     use IPC::Cmd;
  45
  46     ### Win32 has issues with redirecting FD's properly in IPC::Run:
  47     ### Can't redirect fd #4 on Win32 at IPC/Run.pm line 2801
  48     $IPC::Cmd::USE_IPC_RUN = 0 if $^O eq 'MSWin32';
  49     $IPC::Cmd::USE_IPC_RUN = 0 if $^O eq 'MSWin32';
  50 }
  51
  52 use strict;
  53 use CPANPLUS::Configure;
  54 use CPANPLUS::Error ();
  55
  56 use File::Path      qw[rmtree];
  57 use FileHandle;
  58 use File::Basename  qw[basename];
  59
  60 {   ### Force the ignoring of .po files for L::M::S
  61     $INC{'Locale::Maketext::Lexicon.pm'} = __FILE__;
  62     $Locale::Maketext::Lexicon::VERSION = 0;
  63 }
  64
  65 # prereq has to be in our package file && core!
  66 use constant TEST_CONF_PREREQ           => 'Cwd';
  67 use constant TEST_CONF_MODULE           => 'Foo::Bar::EU::NOXS';
  68 use constant TEST_CONF_INST_MODULE      => 'Foo::Bar';
  69 use constant TEST_CONF_INVALID_MODULE   => 'fnurk';
  70 use constant TEST_CONF_MIRROR_DIR       => 'dummy-localmirror';
  71
  72 ### we might need this Some Day when we're installing into
  73 ### our own sandbox. see t/20.t for details
  74 # use constant TEST_INSTALL_DIR       => do {
  75 #     my $dir = File::Spec->rel2abs( 'dummy-perl' );
  76 #
  77 #     ### clean up paths if we are on win32
  78 #     ### dirs with spaces will be.. bad :(
  79 #     $^O eq 'MSWin32'
  80 #         ? Win32::GetShortPathName( $dir )
  81 #         : $dir;
  82 # };
  83
  84 # use constant TEST_INSTALL_DIR_LIB
  85 #     => File::Spec->catdir( TEST_INSTALL_DIR, 'lib' );
  86 # use constant TEST_INSTALL_DIR_BIN
  87 #     => File::Spec->catdir( TEST_INSTALL_DIR, 'bin' );
  88 # use constant TEST_INSTALL_DIR_MAN1
  89 #     => File::Spec->catdir( TEST_INSTALL_DIR, 'man', 'man1' );
  90 # use constant TEST_INSTALL_DIR_MAN3
  91 #     => File::Spec->catdir( TEST_INSTALL_DIR, 'man', 'man3' );
  92 # use constant TEST_INSTALL_DIR_ARCH
  93 #     => File::Spec->catdir( TEST_INSTALL_DIR, 'arch' );
  94 #
  95 # use constant TEST_INSTALL_EU_MM_FLAGS =>
  96 #     ' INSTALLDIRS=site' .
  97 #     ' INSTALLSITELIB='     . TEST_INSTALL_DIR_LIB .
  98 #     ' INSTALLSITEARCH='    . TEST_INSTALL_DIR_ARCH .    # .packlist
  99 #     ' INSTALLARCHLIB='     . TEST_INSTALL_DIR_ARCH .    # perllocal.pod
 100 #     ' INSTALLSITEBIN='     . TEST_INSTALL_DIR_BIN .
 101 #     ' INSTALLSCRIPT='      . TEST_INSTALL_DIR_BIN .
 102 #     ' INSTALLSITEMAN1DIR=' . TEST_INSTALL_DIR_MAN1 .
 103 #     ' INSTALLSITEMAN3DIR=' . TEST_INSTALL_DIR_MAN3;
 104
 105
 106 sub gimme_conf {
 107
 108     ### don't load any other configs than the heuristic one
 109     ### during tests. They might hold broken/incorrect data
 110     ### for our test suite. Bug [perl #43629] showed this.
 111     my $conf = CPANPLUS::Configure->new( load_configs => 0 );
 112     $conf->set_conf( hosts  => [ {
 113                         path        => 'dummy-CPAN',
 114                         scheme      => 'file',
 115                     } ],
 116     );
 117     $conf->set_conf( base       => 'dummy-cpanplus' );
 118     $conf->set_conf( dist_type  => '' );
 119     $conf->set_conf( signature  => 0 );
 120
 121     ### dmq tells us that we should run with /nologo
 122     ### if using nmake, as it's very noise otherwise.
 123     {   my $make = $conf->get_program('make');
 124         if( $make and basename($make) =~ /^nmake/i and
 125             $make !~ m|/nologo|
 126         ) {
 127             $make .= ' /nologo';
 128             $conf->set_program( make => $make );
 129         }
 130     }
 131
 132     _clean_test_dir( [
 133         $conf->get_conf('base'),
 134         TEST_CONF_MIRROR_DIR,
 135 #         TEST_INSTALL_DIR_LIB,
 136 #         TEST_INSTALL_DIR_BIN,
 137 #         TEST_INSTALL_DIR_MAN1,
 138 #         TEST_INSTALL_DIR_MAN3,
 139     ], (  $ENV{PERL_CORE} ? 0 : 1 ) );
 140
 141     return $conf;
 142 };
 143
 144 {
 145     my $fh;
 146     my $file = ".".basename($0).".output";
 147     sub output_handle {
 148         return $fh if $fh;
 149
 150         $fh = FileHandle->new(">$file")
 151                     or warn "Could not open output file '$file': $!";
 152
 153         $fh->autoflush(1);
 154         return $fh;
 155     }
 156
 157     sub output_file { return $file }
 158
 159
 160     my $env = 'PERL5_CPANPLUS_TEST_VERBOSE';
 161     ### redirect output from msg() and error() output to file
 162     unless( $ENV{$env} ) {
 163
 164         print "# To run tests in verbose mode, set ".
 165               "\$ENV{PERL5_CPANPLUS_TEST_VERBOSE} = 1\n" unless $ENV{PERL_CORE};
 166
 167         unlink $file;   # just in case
 168
 169         $CPANPLUS::Error::ERROR_FH  =
 170         $CPANPLUS::Error::ERROR_FH  = output_handle();
 171
 172         $CPANPLUS::Error::MSG_FH    =
 173         $CPANPLUS::Error::MSG_FH    = output_handle();
 174
 175     }
 176 }
 177
 178
 179 ### clean these files if we're under perl core
 180 END {
 181     if ( $ENV{PERL_CORE} ) {
 182         close output_handle(); 1 while unlink output_file();
 183
 184         _clean_test_dir( [
 185             gimme_conf->get_conf('base'),
 186             TEST_CONF_MIRROR_DIR,
 187     #         TEST_INSTALL_DIR_LIB,
 188     #         TEST_INSTALL_DIR_BIN,
 189     #         TEST_INSTALL_DIR_MAN1,
 190     #         TEST_INSTALL_DIR_MAN3,
 191         ], 0 ); # DO NOT be verbose under perl core -- makes tests fail
 192     }
 193 }
 194
 195
 196
 197 ### whenever we start a new script, we want to clean out our
 198 ### old files from the test '.cpanplus' dir..
 199 sub _clean_test_dir {
 200     my $dirs    = shift || [];
 201     my $verbose = shift || 0;
 202
 203     for my $dir ( @$dirs ) {
 204
 205         ### no point if it doesn't exist;
 206         next unless -d $dir;
 207
 208         my $dh;
 209         opendir $dh, $dir or die "Could not open basedir '$dir': $!";
 210         while( my $file = readdir $dh ) {
 211             next if $file =~ /^\./;  # skip dot files
 212
 213             my $path = File::Spec->catfile( $dir, $file );
 214
 215             ### directory, rmtree it
 216             if( -d $path ) {
 217                 print "# Deleting directory '$path'\n" if $verbose;
 218                 eval { rmtree( $path ) };
 219                 warn "Could not delete '$path' while cleaning up '$dir'" if $@;
 220
 221             ### regular file
 222             } else {
 223                 print "# Deleting file '$path'\n" if $verbose;
 224                 1 while unlink $path;
 225             }
 226         }
 227
 228         close $dh;
 229     }
 230
 231     return 1;
 232 }
 233 1;