lib/CPANPLUS/Config.pm

   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'   => sub{
 118             my $name = 'cpanp-run-perl';
 119
 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;
 168
 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 '%2' config entry to its path.\n",
 195                 $name, 'perlwrapper'
 196              ));
 197              return '';
 198         }->(),
 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;