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 |
117 | 'perlwrapper' => ( ### parallel to your cpanp/cpanp-boxed |
118 | do { my $f = File::Spec->rel2abs( |
119 | File::Spec->catdir( |
120 | dirname($0), 'cpanp-run-perl' |
121 | ) |
122 | ); |
123 | -e $f ? $f : undef |
124 | } || |
125 | |
126 | ### parallel to your CPANPLUS.pm: |
127 | ### $INC{cpanplus}/../bin/cpanp-run-perl |
128 | do { my $f = File::Spec->rel2abs( |
129 | File::Spec->catdir( |
130 | dirname( $INC{'CPANPLUS.pm'} ), |
131 | '..', # lib dir |
132 | 'bin', # bin dir |
133 | 'cpanp-run-perl' |
134 | ) |
135 | ); |
136 | -e $f ? $f : undef |
137 | } || |
138 | ### you installed CPANPLUS in a custom prefix, |
139 | ### so go paralel to /that/. PREFIX=/tmp/cp |
140 | ### would put cpanp-run-perl in /tmp/cp/bin and |
141 | ### CPANPLUS.pm in |
142 | ### /tmp/cp/lib/perl5/site_perl/5.8.8 |
143 | do { my $f = File::Spec->rel2abs( |
144 | File::Spec->catdir( |
145 | dirname( $INC{'CPANPLUS.pm'} ), |
146 | '..', '..', '..', '..', # 4x updir |
147 | 'bin', # bin dir |
148 | 'cpanp-run-perl' |
149 | ) |
150 | ); |
151 | -e $f ? $f : undef |
152 | } || |
153 | |
154 | ### in your path -- take this one last, the |
155 | ### previous two assume extracted tarballs |
156 | ### or user installs |
157 | ### note that we don't use 'can_run' as it's |
158 | ### not an executable, just a wrapper... |
159 | do { my $rv; |
160 | for (split(/\Q$Config::Config{path_sep}\E/, |
161 | $ENV{PATH}), File::Spec->curdir |
162 | ) { |
163 | my $path = File::Spec->catfile( |
164 | $_, 'cpanp-run-perl' ); |
165 | if( -e $path ) { |
166 | $rv = $path; |
167 | last; |
168 | } |
169 | } |
170 | |
171 | $rv || undef; |
172 | } || |
173 | |
174 | ### XXX try to be a no-op instead then.. |
175 | ### cross your fingers... |
176 | ### pass '-P' to perl: "run program through C |
177 | ### preprocessor before compilation" |
178 | do { |
179 | error(loc( |
180 | "Could not find the '%1' in your path". |
181 | "--this may be a problem.\n". |
182 | "Please locate this program and set ". |
183 | "your '%1' config entry to its path.\n". |
184 | "Attempting to provide a reasonable ". |
185 | "fallback...", |
186 | 'cpanp-run-perl', 'perlwrapper' |
187 | )); |
188 | '-P' |
189 | }, |
190 | ), |
191 | }, |
192 | |
193 | ### _source, _build and _mirror are supposed to be static |
194 | ### no changes should be needed unless pause/cpan changes |
195 | '_source' => { |
196 | 'hosts' => 'MIRRORED.BY', |
197 | 'auth' => '01mailrc.txt.gz', |
198 | 'stored' => 'sourcefiles', |
199 | 'dslip' => '03modlist.data.gz', |
200 | 'update' => '86400', |
201 | 'mod' => '02packages.details.txt.gz' |
202 | }, |
203 | '_build' => { |
204 | 'plugins' => 'plugins', |
205 | 'moddir' => 'build', |
206 | 'startdir' => '', |
207 | 'distdir' => 'dist', |
208 | 'autobundle' => 'autobundle', |
209 | 'autobundle_prefix' => 'Snapshot', |
210 | 'autdir' => 'authors', |
211 | 'install_log_dir' => 'install-logs', |
212 | 'sanity_check' => 1, |
213 | }, |
214 | '_mirror' => { |
215 | 'base' => 'authors/id/', |
216 | 'auth' => 'authors/01mailrc.txt.gz', |
217 | 'dslip' => 'modules/03modlist.data.gz', |
218 | 'mod' => 'modules/02packages.details.txt.gz' |
219 | }, |
220 | }; |
221 | |
222 | sub new { |
223 | my $class = shift; |
224 | my $obj = $class->SUPER::new; |
225 | |
226 | $obj->mk_accessors( keys %$Conf ); |
227 | |
228 | for my $acc ( keys %$Conf ) { |
229 | my $subobj = Object::Accessor->new; |
230 | $subobj->mk_accessors( keys %{$Conf->{$acc}} ); |
231 | |
232 | ### read in all the settings from the sub accessors; |
233 | for my $subacc ( $subobj->ls_accessors ) { |
234 | $subobj->$subacc( $Conf->{$acc}->{$subacc} ); |
235 | } |
236 | |
237 | ### now store it in the parent object |
238 | $obj->$acc( $subobj ); |
239 | } |
240 | |
241 | $obj->_clean_up_paths; |
242 | |
243 | ### shut up IPC::Cmd warning about not findin IPC::Run on win32 |
244 | $IPC::Cmd::WARN = 0; |
245 | |
246 | return $obj; |
247 | } |
248 | |
249 | sub _clean_up_paths { |
250 | my $self = shift; |
251 | |
252 | ### clean up paths if we are on win32 |
253 | if( $^O eq 'MSWin32' ) { |
254 | for my $pgm ( $self->program->ls_accessors ) { |
255 | $self->program->$pgm( |
256 | Win32::GetShortPathName( $self->program->$pgm ) |
257 | ) if $self->program->$pgm =~ /\s+/; |
258 | } |
259 | } |
260 | |
261 | return 1; |
262 | } |
263 | |
264 | 1; |