| 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 our own path to the front of $ENV{PATH}, so that cpanp-run-perl |
| 31 | ### and friends get picked up |
| 32 | $old_env_path = $ENV{PATH}; |
| 33 | $ENV{'PATH'} = join $Config{'path_sep'}, |
| 34 | grep { defined } "$FindBin::Bin/../bin", $ENV{'PATH'}; |
| 35 | |
| 36 | ### Fix up the path to perl, as we're about to chdir |
| 37 | ### but only under perlcore, or if the path contains delimiters, |
| 38 | ### meaning it's relative, but not looked up in your $PATH |
| 39 | $^X = File::Spec->rel2abs( $^X ) |
| 40 | if $ENV{PERL_CORE} or ( $^X =~ m|[/\\]| ); |
| 41 | |
| 42 | ### chdir to our own test dir, so we know all files are relative |
| 43 | ### to this point, no matter whether run from perlcore tests or |
| 44 | ### regular CPAN installs |
| 45 | chdir "$FindBin::Bin" if -d "$FindBin::Bin" |
| 46 | } |
| 47 | |
| 48 | BEGIN { |
| 49 | use IPC::Cmd; |
| 50 | |
| 51 | ### Win32 has issues with redirecting FD's properly in IPC::Run: |
| 52 | ### Can't redirect fd #4 on Win32 at IPC/Run.pm line 2801 |
| 53 | $IPC::Cmd::USE_IPC_RUN = 0 if $^O eq 'MSWin32'; |
| 54 | $IPC::Cmd::USE_IPC_RUN = 0 if $^O eq 'MSWin32'; |
| 55 | } |
| 56 | |
| 57 | ### Use a $^O comparison, as depending on module at this time |
| 58 | ### may cause weird errors/warnings |
| 59 | END { |
| 60 | if ($^O eq 'VMS') { |
| 61 | ### VMS environment variables modified by this test need to be put back |
| 62 | ### path is "magic" on VMS, we can not tell if it really existed before |
| 63 | ### this was run, because VMS will magically pretend that a PATH |
| 64 | ### environment variable exists set to the current working directory |
| 65 | $ENV{PATH} = $old_path; |
| 66 | |
| 67 | if (defined $old_perl5lib) { |
| 68 | $ENV{PERL5LIB} = $old_perl5lib; |
| 69 | } else { |
| 70 | delete $ENV{PERL5LIB}; |
| 71 | } |
| 72 | } |
| 73 | } |
| 74 | |
| 75 | use strict; |
| 76 | use CPANPLUS::Configure; |
| 77 | use CPANPLUS::Error (); |
| 78 | |
| 79 | use File::Path qw[rmtree]; |
| 80 | use FileHandle; |
| 81 | use File::Basename qw[basename]; |
| 82 | |
| 83 | { ### Force the ignoring of .po files for L::M::S |
| 84 | $INC{'Locale::Maketext::Lexicon.pm'} = __FILE__; |
| 85 | $Locale::Maketext::Lexicon::VERSION = 0; |
| 86 | } |
| 87 | |
| 88 | ### clean up files for PERLCORE mostly -- make clean isn't invoked |
| 89 | ### there... otoh, we should clean up after ourselves anyway. |
| 90 | END { |
| 91 | ### chdir to our own test dir, so we know all files are relative |
| 92 | ### to this point, no matter whether run from perlcore tests or |
| 93 | ### regular CPAN installs |
| 94 | chdir "$FindBin::Bin" if -d "$FindBin::Bin"; |
| 95 | |
| 96 | ### XXX hardcoded |
| 97 | _clean_test_dir( [qw|dummy-perl dummy-cpanplus| ] ); |
| 98 | } |
| 99 | |
| 100 | ### whenever we start a new script, we want to clean out our |
| 101 | ### old files from the test '.cpanplus' dir.. |
| 102 | sub _clean_test_dir { |
| 103 | my $dirs = shift || []; |
| 104 | my $verbose = shift || 0; |
| 105 | |
| 106 | for my $dir ( @$dirs ) { |
| 107 | |
| 108 | ### no point if it doesn't exist; |
| 109 | next unless -d $dir; |
| 110 | |
| 111 | my $dh; |
| 112 | opendir $dh, $dir or die "Could not open basedir '$dir': $!"; |
| 113 | while( my $file = readdir $dh ) { |
| 114 | next if $file =~ /^\./; # skip dot files |
| 115 | |
| 116 | my $path = File::Spec->catfile( $dir, $file ); |
| 117 | |
| 118 | ### John Malmberg reports yet another VMS issue: |
| 119 | ### A directory name on VMS in VMS format ends with .dir |
| 120 | ### when it is referenced as a file. |
| 121 | ### In UNIX format traditionally PERL on VMS does not remove the |
| 122 | ### '.dir', however the VMS C library conversion routines do remove |
| 123 | ### the '.dir' and the VMS C library routines can not handle the |
| 124 | ### '.dir' being present on UNIX format filenames. |
| 125 | ### So code doing the fixup has on VMS has to be able to handle both |
| 126 | ### UNIX format names and VMS format names. |
| 127 | ### XXX See http://www.xray.mpe.mpg.de/ |
| 128 | ### mailing-lists/perl5-porters/2007-10/msg00064.html |
| 129 | ### for details -- the below regex could use some touchups |
| 130 | ### according to John. M. |
| 131 | $file =~ s/\.dir//i if $^O eq 'VMS'; |
| 132 | |
| 133 | my $dirpath = File::Spec->catdir( $dir, $file ); |
| 134 | |
| 135 | ### directory, rmtree it |
| 136 | if( -d $path ) { |
| 137 | print "# Deleting directory '$path'\n" if $verbose; |
| 138 | eval { rmtree( $path ) }; |
| 139 | warn "Could not delete '$path' while cleaning up '$dir'" if $@; |
| 140 | |
| 141 | ### regular file |
| 142 | } else { |
| 143 | print "# Deleting file '$path'\n" if $verbose; |
| 144 | 1 while unlink $path; |
| 145 | } |
| 146 | } |
| 147 | |
| 148 | close $dh; |
| 149 | } |
| 150 | |
| 151 | return 1; |
| 152 | } |
| 153 | |
| 154 | 1; |