| 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 ". |
| 194 | "your '%1' config entry to its path.\n". |
| 195 | "Attempting to provide a reasonable ". |
| 196 | "fallback...", |
| 197 | $name, 'perlwrapper' |
| 198 | )); |
| 199 | return '-P' |
| 200 | }->(), |
| 6aaee015 |
201 | }, |
| 202 | |
| 203 | ### _source, _build and _mirror are supposed to be static |
| 204 | ### no changes should be needed unless pause/cpan changes |
| 205 | '_source' => { |
| 206 | 'hosts' => 'MIRRORED.BY', |
| 207 | 'auth' => '01mailrc.txt.gz', |
| 208 | 'stored' => 'sourcefiles', |
| 209 | 'dslip' => '03modlist.data.gz', |
| 210 | 'update' => '86400', |
| 211 | 'mod' => '02packages.details.txt.gz' |
| 212 | }, |
| 213 | '_build' => { |
| 214 | 'plugins' => 'plugins', |
| 215 | 'moddir' => 'build', |
| 216 | 'startdir' => '', |
| 217 | 'distdir' => 'dist', |
| 218 | 'autobundle' => 'autobundle', |
| 219 | 'autobundle_prefix' => 'Snapshot', |
| 220 | 'autdir' => 'authors', |
| 221 | 'install_log_dir' => 'install-logs', |
| 222 | 'sanity_check' => 1, |
| 223 | }, |
| 224 | '_mirror' => { |
| 225 | 'base' => 'authors/id/', |
| 226 | 'auth' => 'authors/01mailrc.txt.gz', |
| 227 | 'dslip' => 'modules/03modlist.data.gz', |
| 228 | 'mod' => 'modules/02packages.details.txt.gz' |
| 229 | }, |
| 230 | }; |
| 231 | |
| 232 | sub new { |
| 233 | my $class = shift; |
| 234 | my $obj = $class->SUPER::new; |
| 235 | |
| 236 | $obj->mk_accessors( keys %$Conf ); |
| 237 | |
| 238 | for my $acc ( keys %$Conf ) { |
| 239 | my $subobj = Object::Accessor->new; |
| 240 | $subobj->mk_accessors( keys %{$Conf->{$acc}} ); |
| 241 | |
| 242 | ### read in all the settings from the sub accessors; |
| 243 | for my $subacc ( $subobj->ls_accessors ) { |
| 244 | $subobj->$subacc( $Conf->{$acc}->{$subacc} ); |
| 245 | } |
| 246 | |
| 247 | ### now store it in the parent object |
| 248 | $obj->$acc( $subobj ); |
| 249 | } |
| 250 | |
| 251 | $obj->_clean_up_paths; |
| 252 | |
| 253 | ### shut up IPC::Cmd warning about not findin IPC::Run on win32 |
| 254 | $IPC::Cmd::WARN = 0; |
| 255 | |
| 256 | return $obj; |
| 257 | } |
| 258 | |
| 259 | sub _clean_up_paths { |
| 260 | my $self = shift; |
| 261 | |
| 262 | ### clean up paths if we are on win32 |
| 263 | if( $^O eq 'MSWin32' ) { |
| 264 | for my $pgm ( $self->program->ls_accessors ) { |
| 265 | $self->program->$pgm( |
| 266 | Win32::GetShortPathName( $self->program->$pgm ) |
| 267 | ) if $self->program->$pgm =~ /\s+/; |
| 268 | } |
| 269 | } |
| 270 | |
| 271 | return 1; |
| 272 | } |
| 273 | |
| 274 | 1; |
projects / p5sagit/p5-mst-13.2.git / blame