Commit | Line | Data |
6aaee015 |
1 | package CPANPLUS::Config; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use base 'Object::Accessor'; |
7 | |
8 | use base 'CPANPLUS::Internals::Utils'; |
9 | |
10 | use Config; |
11 | use File::Spec; |
12 | use Module::Load; |
13 | use CPANPLUS; |
14 | use CPANPLUS::Error; |
15 | use CPANPLUS::Internals::Constants; |
16 | |
17 | use File::Basename qw[dirname]; |
18 | use IPC::Cmd qw[can_run]; |
19 | use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; |
20 | use Module::Load::Conditional qw[check_install]; |
21 | |
22 | my $Conf = { |
23 | '_fetch' => { |
24 | 'blacklist' => [ 'ftp' ], |
25 | }, |
26 | 'conf' => { |
27 | ### default host list |
28 | 'hosts' => [ |
29 | { |
30 | 'scheme' => 'ftp', |
31 | 'path' => '/pub/CPAN/', |
32 | 'host' => 'ftp.cpan.org' |
33 | }, |
34 | { |
35 | 'scheme' => 'http', |
36 | 'path' => '/', |
37 | 'host' => 'www.cpan.org' |
38 | }, |
39 | { |
40 | 'scheme' => 'ftp', |
41 | 'path' => '/pub/CPAN/', |
42 | 'host' => 'ftp.nl.uu.net' |
43 | }, |
44 | { |
45 | 'scheme' => 'ftp', |
46 | 'path' => '/pub/CPAN/', |
47 | 'host' => 'cpan.valueclick.com' |
48 | }, |
49 | { |
50 | 'scheme' => 'ftp', |
51 | 'path' => '/pub/languages/perl/CPAN/', |
52 | 'host' => 'ftp.funet.fi' |
53 | } |
54 | ], |
55 | 'allow_build_interactivity' => 1, |
56 | 'base' => File::Spec->catdir( |
57 | __PACKAGE__->_home_dir, DOT_CPANPLUS ), |
58 | 'buildflags' => '', |
59 | 'cpantest' => 0, |
60 | 'cpantest_mx' => '', |
61 | 'debug' => 0, |
62 | 'dist_type' => '', |
63 | 'email' => DEFAULT_EMAIL, |
64 | 'extractdir' => '', |
65 | 'fetchdir' => '', |
66 | 'flush' => 1, |
67 | 'force' => 0, |
68 | 'lib' => [], |
69 | 'makeflags' => '', |
70 | 'makemakerflags' => '', |
71 | 'md5' => ( |
72 | check_install( module => 'Digest::MD5' ) ? 1 : 0 ), |
73 | 'no_update' => 0, |
74 | 'passive' => 1, |
75 | ### if we dont have c::zlib, we'll need to use /bin/tar or we |
76 | ### can not extract any files. Good time to change the default |
77 | 'prefer_bin' => (eval {require Compress::Zlib; 1}?0:1), |
78 | 'prefer_makefile' => 1, |
79 | 'prereqs' => PREREQ_ASK, |
80 | 'shell' => 'CPANPLUS::Shell::Default', |
81 | 'show_startup_tip' => 1, |
82 | 'signature' => ( (can_run( 'gpg' ) || |
83 | check_install( module => 'Crypt::OpenPGP' ))?1:0 ), |
84 | 'skiptest' => 0, |
85 | 'storable' => ( |
86 | check_install( module => 'Storable' ) ? 1 : 0 ), |
87 | 'timeout' => 300, |
88 | 'verbose' => $ENV{PERL5_CPANPLUS_VERBOSE} || 0, |
89 | 'write_install_logs' => 1, |
90 | }, |
91 | ### Paths get stripped of whitespace on win32 in the constructor |
92 | ### sudo gets emptied if there's no need for it in the constructor |
93 | 'program' => { |
94 | 'editor' => ( $ENV{'EDITOR'} || $ENV{'VISUAL'} || |
95 | can_run('vi') || can_run('pico') |
96 | ), |
97 | 'make' => ( can_run($Config{'make'}) || can_run('make') ), |
98 | 'pager' => ( $ENV{'PAGER'} || can_run('less') || can_run('more') ), |
99 | ### no one uses this feature anyway, and it's only working for EU::MM |
100 | ### and not for module::build |
101 | #'perl' => '', |
102 | 'shell' => ( $^O eq 'MSWin32' ? $ENV{COMSPEC} : $ENV{SHELL} ), |
103 | 'sudo' => ( $> # check for all install dirs! |
104 | # installsiteman3dir is a 5.8'ism.. don't check |
105 | # it on 5.6.x... |
106 | ? ( -w $Config{'installsitelib'} && |
107 | ( defined $Config{'installsiteman3dir'} && |
108 | -w $Config{'installsiteman3dir'} |
109 | ) && |
110 | -w $Config{'installsitebin'} |
111 | ? undef |
112 | : can_run('sudo') |
113 | ) |
114 | : can_run('sudo') |
115 | ), |
116 | ### perlwrapper that allows us to turn on autoflushing |
494f1016 |
117 | 'perlwrapper' => sub{ |
118 | my $name = 'cpanp-run-perl'; |
6aaee015 |
119 | |
494f1016 |
120 | my @bins = do{ |
121 | require Config; |
122 | my $ver = $Config::Config{version}; |
123 | |
124 | ### if we are running with 'versiononly' enabled, |
125 | ### all binaries will have the perlversion appended |
126 | ### ie, cpanp will become cpanp5.9.5 |
127 | ### so prefer the versioned binary in that case |
128 | $Config::Config{versiononly} |
129 | ? ($name.$ver, $name) |
130 | : ($name, $name.$ver); |
131 | }; |
132 | |
133 | my $path; |
134 | BIN: for my $bin (@bins) { |
135 | |
136 | ### parallel to your cpanp/cpanp-boxed |
137 | my $maybe = File::Spec->rel2abs( |
138 | File::Spec->catdir( dirname($0), $bin ) |
139 | ); |
140 | $path = $maybe and last BIN if -f $maybe; |
141 | |
142 | ### parallel to your CPANPLUS.pm: |
143 | ### $INC{cpanplus}/../bin/cpanp-run-perl |
144 | $maybe = File::Spec->rel2abs( |
145 | File::Spec->catdir( |
146 | dirname($INC{'CPANPLUS.pm'}), |
147 | '..', # lib dir |
148 | 'bin', # bin dir |
149 | $bin, # script |
150 | ) |
151 | ); |
152 | $path = $maybe and last BIN if -f $maybe; |
153 | |
154 | ### you installed CPANPLUS in a custom prefix, |
155 | ### so go paralel to /that/. PREFIX=/tmp/cp |
156 | ### would put cpanp-run-perl in /tmp/cp/bin and |
157 | ### CPANPLUS.pm in |
158 | ### /tmp/cp/lib/perl5/site_perl/5.8.8 |
159 | $maybe = File::Spec->rel2abs( |
160 | File::Spec->catdir( |
161 | dirname( $INC{'CPANPLUS.pm'} ), |
162 | '..', '..', '..', '..', # 4x updir |
163 | 'bin', # bin dir |
164 | $bin, # script |
165 | ) |
166 | ); |
167 | $path = $maybe and last BIN if -f $maybe; |
6aaee015 |
168 | |
494f1016 |
169 | ### in your path -- take this one last, the |
170 | ### previous two assume extracted tarballs |
171 | ### or user installs |
172 | ### note that we don't use 'can_run' as it's |
173 | ### not an executable, just a wrapper... |
174 | for my $dir (split(/\Q$Config::Config{path_sep}\E/, $ENV{PATH}), |
175 | File::Spec->curdir |
176 | ) { |
177 | $maybe = File::Spec->catfile( $dir, $bin ); |
178 | $path = $maybe and last BIN if -f $maybe; |
179 | } |
180 | } |
181 | |
182 | ### we should have a $path by now ideally, if so return it |
183 | return $path if defined $path; |
184 | |
185 | ### if not, warn about it and give sensible default. |
186 | ### XXX try to be a no-op instead then.. |
187 | ### cross your fingers... |
188 | ### pass '-P' to perl: "run program through C |
189 | ### preprocessor before compilation" |
190 | error(loc( |
191 | "Could not find the '%1' in your path". |
192 | "--this may be a problem.\n". |
193 | "Please locate this program and set ". |
e3b7d412 |
194 | "your '%2' config entry to its path.\n", |
494f1016 |
195 | $name, 'perlwrapper' |
196 | )); |
e3b7d412 |
197 | return ''; |
494f1016 |
198 | }->(), |
6aaee015 |
199 | }, |
200 | |
201 | ### _source, _build and _mirror are supposed to be static |
202 | ### no changes should be needed unless pause/cpan changes |
203 | '_source' => { |
204 | 'hosts' => 'MIRRORED.BY', |
205 | 'auth' => '01mailrc.txt.gz', |
206 | 'stored' => 'sourcefiles', |
207 | 'dslip' => '03modlist.data.gz', |
208 | 'update' => '86400', |
209 | 'mod' => '02packages.details.txt.gz' |
210 | }, |
211 | '_build' => { |
212 | 'plugins' => 'plugins', |
213 | 'moddir' => 'build', |
214 | 'startdir' => '', |
215 | 'distdir' => 'dist', |
216 | 'autobundle' => 'autobundle', |
217 | 'autobundle_prefix' => 'Snapshot', |
218 | 'autdir' => 'authors', |
219 | 'install_log_dir' => 'install-logs', |
220 | 'sanity_check' => 1, |
221 | }, |
222 | '_mirror' => { |
223 | 'base' => 'authors/id/', |
224 | 'auth' => 'authors/01mailrc.txt.gz', |
225 | 'dslip' => 'modules/03modlist.data.gz', |
226 | 'mod' => 'modules/02packages.details.txt.gz' |
227 | }, |
228 | }; |
229 | |
230 | sub new { |
231 | my $class = shift; |
232 | my $obj = $class->SUPER::new; |
233 | |
234 | $obj->mk_accessors( keys %$Conf ); |
235 | |
236 | for my $acc ( keys %$Conf ) { |
237 | my $subobj = Object::Accessor->new; |
238 | $subobj->mk_accessors( keys %{$Conf->{$acc}} ); |
239 | |
240 | ### read in all the settings from the sub accessors; |
241 | for my $subacc ( $subobj->ls_accessors ) { |
242 | $subobj->$subacc( $Conf->{$acc}->{$subacc} ); |
243 | } |
244 | |
245 | ### now store it in the parent object |
246 | $obj->$acc( $subobj ); |
247 | } |
248 | |
249 | $obj->_clean_up_paths; |
250 | |
251 | ### shut up IPC::Cmd warning about not findin IPC::Run on win32 |
252 | $IPC::Cmd::WARN = 0; |
253 | |
254 | return $obj; |
255 | } |
256 | |
257 | sub _clean_up_paths { |
258 | my $self = shift; |
259 | |
260 | ### clean up paths if we are on win32 |
261 | if( $^O eq 'MSWin32' ) { |
262 | for my $pgm ( $self->program->ls_accessors ) { |
263 | $self->program->$pgm( |
264 | Win32::GetShortPathName( $self->program->$pgm ) |
265 | ) if $self->program->$pgm =~ /\s+/; |
266 | } |
267 | } |
268 | |
269 | return 1; |
270 | } |
271 | |
272 | 1; |