Commit | Line | Data |
---|---|---|
8431a0ba JB |
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); | |
9b4bd854 JB |
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 | |
8431a0ba JB |
26 | $old_env_perl5lib = $ENV{'PERL5LIB'}; |
27 | $ENV{'PERL5LIB'} = join $Config{'path_sep'}, | |
9b4bd854 JB |
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 | |
8431a0ba JB |
32 | $old_env_path = $ENV{PATH}; |
33 | $ENV{'PATH'} = join $Config{'path_sep'}, | |
34 | grep { defined } "$FindBin::Bin/../bin", $ENV{'PATH'}; | |
9b4bd854 JB |
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 | ||
8431a0ba JB |
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 | ||
9b4bd854 JB |
75 | use strict; |
76 | use CPANPLUS::Configure; | |
8431a0ba | 77 | use CPANPLUS::Error (); |
9b4bd854 JB |
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 | ||
078adea4 JB |
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 | ||
8431a0ba | 108 | ### no point if it doesn't exist; |
078adea4 JB |
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 | ||
8431a0ba JB |
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'; | |
9b4bd854 | 132 | |
8431a0ba | 133 | my $dirpath = File::Spec->catdir( $dir, $file ); |
9b4bd854 JB |
134 | |
135 | ### directory, rmtree it | |
136 | if( -d $path ) { | |
8431a0ba | 137 | print "# Deleting directory '$path'\n" if $verbose; |
9b4bd854 JB |
138 | eval { rmtree( $path ) }; |
139 | warn "Could not delete '$path' while cleaning up '$dir'" if $@; | |
140 | ||
141 | ### regular file | |
142 | } else { | |
8431a0ba | 143 | print "# Deleting file '$path'\n" if $verbose; |
9b4bd854 JB |
144 | 1 while unlink $path; |
145 | } | |
146 | } | |
147 | ||
148 | close $dh; | |
149 | } | |
150 | ||
151 | return 1; | |
152 | } | |
8431a0ba | 153 | |
9b4bd854 | 154 | 1; |