Commit | Line | Data |
---|---|---|
6aaee015 RGS |
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 | ||
55 | use File::Path qw[rmtree]; | |
56 | use FileHandle; | |
57 | use File::Basename qw[basename]; | |
58 | ||
59 | { ### Force the ignoring of .po files for L::M::S | |
60 | $INC{'Locale::Maketext::Lexicon.pm'} = __FILE__; | |
61 | $Locale::Maketext::Lexicon::VERSION = 0; | |
62 | } | |
63 | ||
64 | # prereq has to be in our package file && core! | |
65 | use constant TEST_CONF_PREREQ => 'Cwd'; | |
66 | use constant TEST_CONF_MODULE => 'Foo::Bar::EU::NOXS'; | |
67 | use constant TEST_CONF_INST_MODULE => 'Foo::Bar'; | |
68 | use constant TEST_CONF_INVALID_MODULE => 'fnurk'; | |
69 | ||
70 | ### we might need this Some Day when we're installing into | |
71 | ### our own sandbox. see t/20.t for details | |
72 | # use constant TEST_INSTALL_DIR => do { | |
73 | # my $dir = File::Spec->rel2abs( 'dummy-perl' ); | |
74 | # | |
75 | # ### clean up paths if we are on win32 | |
76 | # ### dirs with spaces will be.. bad :( | |
77 | # $^O eq 'MSWin32' | |
78 | # ? Win32::GetShortPathName( $dir ) | |
79 | # : $dir; | |
80 | # }; | |
81 | ||
82 | # use constant TEST_INSTALL_DIR_LIB | |
83 | # => File::Spec->catdir( TEST_INSTALL_DIR, 'lib' ); | |
84 | # use constant TEST_INSTALL_DIR_BIN | |
85 | # => File::Spec->catdir( TEST_INSTALL_DIR, 'bin' ); | |
86 | # use constant TEST_INSTALL_DIR_MAN1 | |
87 | # => File::Spec->catdir( TEST_INSTALL_DIR, 'man', 'man1' ); | |
88 | # use constant TEST_INSTALL_DIR_MAN3 | |
89 | # => File::Spec->catdir( TEST_INSTALL_DIR, 'man', 'man3' ); | |
90 | # use constant TEST_INSTALL_DIR_ARCH | |
91 | # => File::Spec->catdir( TEST_INSTALL_DIR, 'arch' ); | |
92 | # | |
93 | # use constant TEST_INSTALL_EU_MM_FLAGS => | |
94 | # ' INSTALLDIRS=site' . | |
95 | # ' INSTALLSITELIB=' . TEST_INSTALL_DIR_LIB . | |
96 | # ' INSTALLSITEARCH=' . TEST_INSTALL_DIR_ARCH . # .packlist | |
97 | # ' INSTALLARCHLIB=' . TEST_INSTALL_DIR_ARCH . # perllocal.pod | |
98 | # ' INSTALLSITEBIN=' . TEST_INSTALL_DIR_BIN . | |
99 | # ' INSTALLSCRIPT=' . TEST_INSTALL_DIR_BIN . | |
100 | # ' INSTALLSITEMAN1DIR=' . TEST_INSTALL_DIR_MAN1 . | |
101 | # ' INSTALLSITEMAN3DIR=' . TEST_INSTALL_DIR_MAN3; | |
102 | ||
103 | ||
104 | sub gimme_conf { | |
105 | my $conf = CPANPLUS::Configure->new(); | |
106 | $conf->set_conf( hosts => [ { | |
107 | path => 'dummy-CPAN', | |
108 | scheme => 'file', | |
109 | } ], | |
110 | ); | |
111 | $conf->set_conf( base => 'dummy-cpanplus' ); | |
112 | $conf->set_conf( dist_type => '' ); | |
113 | $conf->set_conf( signature => 0 ); | |
114 | ||
115 | _clean_test_dir( [ | |
116 | $conf->get_conf('base'), | |
117 | # TEST_INSTALL_DIR_LIB, | |
118 | # TEST_INSTALL_DIR_BIN, | |
119 | # TEST_INSTALL_DIR_MAN1, | |
120 | # TEST_INSTALL_DIR_MAN3, | |
121 | ], 1 ); | |
122 | ||
123 | return $conf; | |
124 | }; | |
125 | ||
126 | my $fh; | |
127 | my $file = ".".basename($0).".output"; | |
128 | sub output_handle { | |
129 | return $fh if $fh; | |
130 | ||
131 | $fh = FileHandle->new(">$file") | |
132 | or warn "Could not open output file '$file': $!"; | |
133 | ||
134 | $fh->autoflush(1); | |
135 | return $fh; | |
136 | } | |
137 | ||
138 | sub output_file { return $file } | |
139 | ||
140 | ### whenever we start a new script, we want to clean out our | |
141 | ### old files from the test '.cpanplus' dir.. | |
142 | sub _clean_test_dir { | |
143 | my $dirs = shift || []; | |
144 | my $verbose = shift || 0; | |
145 | ||
146 | for my $dir ( @$dirs ) { | |
147 | ||
148 | my $dh; | |
149 | opendir $dh, $dir or die "Could not open basedir '$dir': $!"; | |
150 | while( my $file = readdir $dh ) { | |
151 | next if $file =~ /^\./; # skip dot files | |
152 | ||
153 | my $path = File::Spec->catfile( $dir, $file ); | |
154 | ||
155 | ### directory, rmtree it | |
156 | if( -d $path ) { | |
157 | print "Deleting directory '$path'\n" if $verbose; | |
158 | eval { rmtree( $path ) }; | |
159 | warn "Could not delete '$path' while cleaning up '$dir'" if $@; | |
160 | ||
161 | ### regular file | |
162 | } else { | |
163 | print "Deleting file '$path'\n" if $verbose; | |
164 | 1 while unlink $path; | |
165 | } | |
166 | } | |
167 | ||
168 | close $dh; | |
169 | } | |
170 | ||
171 | return 1; | |
172 | } | |
173 | 1; |