The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
### On VMS, the ENV is not reset after the program terminates.
### So reset it here explicitly
my ($old_env_path, $old_env_perl5lib);
BEGIN {
    use FindBin;
    use File::Spec;

    ### paths to our own 'lib' and 'inc' dirs
    ### include them, relative from t/
    my @paths   = map { "$FindBin::Bin/$_" } qw[../lib inc];

    ### absolute'ify the paths in @INC;
    my @rel2abs = map { File::Spec->rel2abs( $_ ) }
                    grep { not File::Spec->file_name_is_absolute( $_ ) } @INC;

    ### use require to make devel::cover happy
    require lib;
    for ( @paths, @rel2abs ) {
        my $l = 'lib';
        $l->import( $_ )
    }

    use Config;

    ### and add them to the environment, so shellouts get them
    $old_env_perl5lib = $ENV{'PERL5LIB'};
    $ENV{'PERL5LIB'}  = join $Config{'path_sep'},
                        grep { defined } $ENV{'PERL5LIB'}, @paths, @rel2abs;

    ### add our own path to the front of $ENV{PATH}, so that cpanp-run-perl
    ### and friends get picked up
    $old_env_path = $ENV{PATH};
    if ( $ENV{PERL_CORE} ) {
      $ENV{'PATH'}  = join $Config{'path_sep'},
                    grep { defined } "$FindBin::Bin/../../../utils", $ENV{'PATH'};
    }
    else {
      $ENV{'PATH'}  = join $Config{'path_sep'},
                    grep { defined } "$FindBin::Bin/../bin", $ENV{'PATH'};
    }

    ### Fix up the path to perl, as we're about to chdir
    ### but only under perlcore, or if the path contains delimiters,
    ### meaning it's relative, but not looked up in your $PATH
    $^X = File::Spec->rel2abs( $^X )
        if $ENV{PERL_CORE} or ( $^X =~ m|[/\\]| );

    ### chdir to our own test dir, so we know all files are relative
    ### to this point, no matter whether run from perlcore tests or
    ### regular CPAN installs
    chdir "$FindBin::Bin" if -d "$FindBin::Bin"
}

BEGIN {
    use IPC::Cmd;

    ### Win32 has issues with redirecting FD's properly in IPC::Run:
    ### Can't redirect fd #4 on Win32 at IPC/Run.pm line 2801
    $IPC::Cmd::USE_IPC_RUN = 0 if $^O eq 'MSWin32';
    $IPC::Cmd::USE_IPC_RUN = 0 if $^O eq 'MSWin32';
}

### Use a $^O comparison, as depending on module at this time
### may cause weird errors/warnings
END {
    if ($^O eq 'VMS') {
        ### VMS environment variables modified by this test need to be put back
        ### path is "magic" on VMS, we can not tell if it really existed before
        ### this was run, because VMS will magically pretend that a PATH
        ### environment variable exists set to the current working directory
        $ENV{PATH} = $old_env_path;

        if (defined $old_env_perl5lib) {
            $ENV{PERL5LIB} = $old_env_perl5lib;
        } else {
            delete $ENV{PERL5LIB};
        }
    }
}

use strict;
use CPANPLUS::Configure;
use CPANPLUS::Error ();

use File::Path      qw[rmtree];
use FileHandle;
use File::Basename  qw[basename];
use File::Temp      qw[tempdir];

{   ### Force the ignoring of .po files for L::M::S
    $INC{'Locale::Maketext::Lexicon.pm'} = __FILE__;
    $Locale::Maketext::Lexicon::VERSION = 0;
}

my $Env = 'PERL5_CPANPLUS_TEST_VERBOSE';

# prereq has to be in our package file && core!
use constant TEST_CONF_PREREQ           => 'Cwd';
use constant TEST_CONF_MODULE           => 'Foo::Bar::EU::NOXS';
use constant TEST_CONF_MODULE_SUB       => 'Foo::Bar::EU::NOXS::Sub';
use constant TEST_CONF_AUTHOR           => 'EUNOXS';
use constant TEST_CONF_INST_MODULE      => 'Foo::Bar';
use constant TEST_CONF_INVALID_MODULE   => 'fnurk';
use constant TEST_CONF_MIRROR_DIR       => 'dummy-localmirror';
use constant TEST_CONF_CPAN_DIR         => 'dummy-CPAN';
use constant TEST_CONF_CPANPLUS_DIR     => tempdir( DIR => 'dummy-cpanplus', CLEANUP => 1 );
use constant TEST_CONF_INSTALL_DIR      => File::Spec->rel2abs(
                                                File::Spec->catdir(
                                                    TEST_CONF_CPANPLUS_DIR,
                                                    'install'
                                                )
                                            );

sub dummy_cpan_dir {
    ### VMS needs this in directory format for rel2abs
    my $test_dir = $^O eq 'VMS'
                    ? File::Spec->catdir(TEST_CONF_CPAN_DIR)
                    : TEST_CONF_CPAN_DIR;

    ### Convert to an absolute file specification
    my $abs_test_dir = File::Spec->rel2abs($test_dir);

    ### According to John M: the hosts path needs to be in UNIX format.
    ### File::Spec::Unix->rel2abs does not work at all on VMS
    $abs_test_dir    = VMS::Filespec::unixify( $abs_test_dir ) if $^O eq 'VMS';

    return $abs_test_dir;
}

sub gimme_conf {

    ### don't load any other configs than the heuristic one
    ### during tests. They might hold broken/incorrect data
    ### for our test suite. Bug [perl #43629] showed this.
    local $ENV{PERL5_CPANPLUS_HOME} = '';

    my $conf = CPANPLUS::Configure->new( load_configs => 0 );

    my $dummy_cpan = dummy_cpan_dir();

    $conf->set_conf( hosts  => [ {
                        path        => $dummy_cpan,
                        scheme      => 'file',
                    } ],
    );
    $conf->set_conf( base       => File::Spec->rel2abs(TEST_CONF_CPANPLUS_DIR));
    $conf->set_conf( dist_type  => '' );
    $conf->set_conf( signature  => 0 );
    $conf->set_conf( allow_unknown_prereqs => 1 ); # just to make sure, eh
    $conf->set_conf( verbose    => 1 ) if $ENV{ $Env };

    ### never use a pager in the test suite
    $conf->set_program( pager   => '' );

    $conf->set_conf( enable_custom_sources => 0 );

    ### dmq tells us that we should run with /nologo
    ### if using nmake, as it's very noisy otherwise.
    {   my $make = $conf->get_program('make');
        if( $make and basename($make) =~ /^nmake/i ) {
            $conf->set_conf( makeflags => '/nologo' );
        }
    }

    ### CPANPLUS::Config checks 3 specific scenarios first
    ### when looking for cpanp-run-perl: parallel to cpanp,
    ### parallel to CPANPLUS.pm, or installed into a custom
    ### prefix like /tmp/foo. Only *THEN* does it check the
    ### the path.
    ### If the perl core is extracted to a directory that has
    ### cpanp-run-perl installed the same amount of 'uplevels'
    ### as the /tmp/foo prefix, we'll pull in the wrong script
    ### by accident.
    ### Since we set the path to cpanp-run-perl explicitly
    ### at the top of this script, it's best to update the config
    ### ourselves with a path lookup, rather than rely on its
    ### heuristics. Thanks to David Wheeler, Josh Jore and Vincent
    ### Pit for helping to track this down.
    if( $ENV{PERL_CORE} ) {
        $conf->set_program( "perlwrapper" => IPC::Cmd::can_run('cpanp-run-perl') );
    }

    $conf->set_conf( source_engine =>  $ENV{CPANPLUS_SOURCE_ENGINE} )
        if $ENV{CPANPLUS_SOURCE_ENGINE};

    _clean_test_dir( [
        $conf->get_conf('base'),
        TEST_CONF_MIRROR_DIR,
#         TEST_INSTALL_DIR_LIB,
#         TEST_INSTALL_DIR_BIN,
#         TEST_INSTALL_DIR_MAN1,
#         TEST_INSTALL_DIR_MAN3,
    ], (  $ENV{PERL_CORE} ? 0 : 1 ) );

    return $conf;
};

{
    my $fh;
    my $file = ".".basename($0).".output";
    sub output_handle {
        return $fh if $fh;

        $fh = FileHandle->new(">$file")
                    or warn "Could not open output file '$file': $!";

        $fh->autoflush(1);
        return $fh;
    }

    sub output_file { return $file }



    ### redirect output from msg() and error() output to file
    unless( $ENV{$Env} ) {

        print "# To run tests in verbose mode, set ".
              "\$ENV{$Env} = 1\n" unless $ENV{PERL_CORE};

        1 while unlink $file;   # just in case

        $CPANPLUS::Error::ERROR_FH  =
        $CPANPLUS::Error::ERROR_FH  = output_handle();

        $CPANPLUS::Error::MSG_FH    =
        $CPANPLUS::Error::MSG_FH    = output_handle();

    }
}


### clean these files if we're under perl core
END {
    if ( $ENV{PERL_CORE} ) {
        close output_handle(); 1 while unlink output_file();

        _clean_test_dir( [
            gimme_conf->get_conf('base'),
            TEST_CONF_MIRROR_DIR,
    #         TEST_INSTALL_DIR_LIB,
    #         TEST_INSTALL_DIR_BIN,
    #         TEST_INSTALL_DIR_MAN1,
    #         TEST_INSTALL_DIR_MAN3,
        ], 0 ); # DO NOT be verbose under perl core -- makes tests fail
    }
}

### whenever we start a new script, we want to clean out our
### old files from the test '.cpanplus' dir..
sub _clean_test_dir {
    my $dirs    = shift || [];
    my $verbose = shift || 0;

    for my $dir ( @$dirs ) {

        ### no point if it doesn't exist;
        next unless -d $dir;

        my $dh;
        opendir $dh, $dir or die "Could not open basedir '$dir': $!";
        while( my $file = readdir $dh ) {
            next if $file =~ /^\./;  # skip dot files

            my $path = File::Spec->catfile( $dir, $file );

            ### directory, rmtree it
            if( -d $path ) {

                ### John Malmberg reports yet another VMS issue:
                ### A directory name on VMS in VMS format ends with .dir
                ### when it is referenced as a file.
                ### In UNIX format traditionally PERL on VMS does not remove the
                ### '.dir', however the VMS C library conversion routines do
                ### remove the '.dir' and the VMS C library routines can not
                ### handle the '.dir' being present on UNIX format filenames.
                ### So code doing the fixup has on VMS has to be able to handle
                ### both UNIX format names and VMS format names.

                ### XXX See http://www.xray.mpe.mpg.de/
                ### mailing-lists/perl5-porters/2007-10/msg00064.html
                ### for details -- the below regex could use some touchups
                ### according to John. M.
                $file =~ s/\.dir$//i if $^O eq 'VMS';

                my $dirpath = File::Spec->catdir( $dir, $file );

                print "# Deleting directory '$dirpath'\n" if $verbose;
                eval { rmtree( $dirpath ) };
                warn "Could not delete '$dirpath' while cleaning up '$dir'"
                    if $@;

            ### regular file
            } else {
                print "# Deleting file '$path'\n" if $verbose;
                1 while unlink $path;
            }
        }

        close $dh;
    }

    return 1;
}
1;