File Coverage

lib/CPANPLUS/Config.pm
Criterion Covered Total %
statement 58 60 96.7
branch 1 4 25.0
condition n/a
subroutine 16 16 100.0
pod 1 1 100.0
total 76 81 93.8


line stmt bran cond sub pod time code
1             package CPANPLUS::Config;
2              
3 15     15   2711 use strict;
  15         220  
  15         242  
4 15     15   316 use warnings;
  15         203  
  15         463  
5              
6 15     15   330 use base 'Object::Accessor';
  15         134  
  15         1150  
7              
8 15     15   249 use base 'CPANPLUS::Internals::Utils';
  15         139  
  15         214  
9              
10 15     15   301 use Config;
  15         175  
  15         1018  
11 15     15   246 use File::Spec;
  15         143  
  15         454  
12 15     15   230 use Module::Load;
  15         139  
  15         296  
13 15     15   528 use CPANPLUS;
  15         248  
  15         497  
14 15     15   2524 use CPANPLUS::Error;
  15         163  
  15         267  
15 15     15   279 use CPANPLUS::Internals::Constants;
  15         1075  
  15         685  
16              
17 15     15   321 use File::Basename qw[dirname];
  15         171  
  15         375  
18 15     15   392 use IPC::Cmd qw[can_run];
  15         195  
  15         309  
19 15     15   284 use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
  15         261  
  15         280  
20 15     15   234 use Module::Load::Conditional qw[check_install];
  15         138  
  15         249  
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                     'signature' => ( (can_run( 'gpg' ) ||
82                                         check_install( module => 'Crypt::OpenPGP' ))?1:0 ),
83                     'skiptest' => 0,
84                     'storable' => (
85                                         check_install( module => 'Storable' ) ? 1 : 0 ),
86                     'timeout' => 300,
87                     'verbose' => $ENV{PERL5_CPANPLUS_VERBOSE} || 0,
88                     'write_install_logs' => 1,
89                 },
90             ### Paths get stripped of whitespace on win32 in the constructor
91             ### sudo gets emptied if there's no need for it in the constructor
92                 'program' => {
93                     'editor' => ( $ENV{'EDITOR'} || $ENV{'VISUAL'} ||
94                                      can_run('vi') || can_run('pico')
95                                    ),
96                     'make' => ( can_run($Config{'make'}) || can_run('make') ),
97                     'pager' => ( $ENV{'PAGER'} || can_run('less') || can_run('more') ),
98             ### no one uses this feature anyway, and it's only working for EU::MM
99             ### and not for module::build
100             #'perl' => '',
101                     'shell' => ( $^O eq 'MSWin32' ? $ENV{COMSPEC} : $ENV{SHELL} ),
102                     'sudo' => ( $> # check for all install dirs!
103                                         ? ( -w $Config{'installsitelib'} &&
104                                             -w $Config{'installsiteman3dir'} &&
105                                             -w $Config{'installsitebin'}
106                                                 ? undef
107                                                 : can_run('sudo')
108                                           )
109                                         : can_run('sudo')
110                                     ),
111             ### perlwrapper that allows us to turn on autoflushing
112                     'perlwrapper' => ( ### parallel to your cpanp/cpanp-boxed
113                                             do { my $f = File::Spec->rel2abs(
114                                                     File::Spec->catdir(
115                                                         dirname($0), 'cpanp-run-perl'
116                                                     )
117                                                  );
118                                                 -e $f ? $f : undef
119                                             } ||
120                                             
121             ### parallel to your CPANPLUS.pm:
122             ### $INC{cpanplus}/../bin/cpanp-run-perl
123                                             do { my $f = File::Spec->rel2abs(
124                                                     File::Spec->catdir(
125                                                         dirname( $INC{'CPANPLUS.pm'} ),
126                                                         '..', # lib dir
127                                                         'bin', # bin dir
128                                                         'cpanp-run-perl'
129                                                     )
130                                                  );
131                                                 -e $f ? $f : undef
132                                             } ||
133                                             
134             ### in your path -- take this one last, the
135             ### previous two assume extracted tarballs
136             ### or user installs
137                                             can_run('cpanp-run-perl'),
138                                     ),
139                 },
140              
141             ### _source, _build and _mirror are supposed to be static
142             ### no changes should be needed unless pause/cpan changes
143                 '_source' => {
144                     'hosts' => 'MIRRORED.BY',
145                     'auth' => '01mailrc.txt.gz',
146                     'stored' => 'sourcefiles',
147                     'dslip' => '03modlist.data.gz',
148                     'update' => '86400',
149                     'mod' => '02packages.details.txt.gz'
150                 },
151                 '_build' => {
152                     'plugins' => 'plugins',
153                     'moddir' => 'build',
154                     'startdir' => '',
155                     'distdir' => 'dist',
156                     'autobundle' => 'autobundle',
157                     'autobundle_prefix' => 'Snapshot',
158                     'autdir' => 'authors',
159                     'install_log_dir' => 'install-logs',
160                     'sanity_check' => 1,
161                 },
162                 '_mirror' => {
163                     'base' => 'authors/id/',
164                     'auth' => 'authors/01mailrc.txt.gz',
165                     'dslip' => 'modules/03modlist.data.gz',
166                     'mod' => 'modules/02packages.details.txt.gz'
167                 },
168             };
169                 
170             sub new {
171 14     14 1 155     my $class = shift;
172 14         828     my $obj = $class->SUPER::new;
173              
174 14         1420     $obj->mk_accessors( keys %$Conf );
175              
176 14         227     for my $acc ( keys %$Conf ) {
177 84         13384         my $subobj = Object::Accessor->new;
178 84         3546         $subobj->mk_accessors( keys %{$Conf->{$acc}} );
  84         2410  
179              
180             ### read in all the settings from the sub accessors;
181 84         1311         for my $subacc ( $subobj->ls_accessors ) {
182 770         136293             $subobj->$subacc( $Conf->{$acc}->{$subacc} );
183                     }
184              
185             ### now store it in the parent object
186 84         14713         $obj->$acc( $subobj );
187                 }
188                 
189 14         2371     $obj->_clean_up_paths;
190                 
191             ### shut up IPC::Cmd warning about not findin IPC::Run on win32
192 14         293     $IPC::Cmd::WARN = 0;
193                 
194 14         195     return $obj;
195             }
196              
197             sub _clean_up_paths {
198 29     29   352     my $self = shift;
199              
200             ### clean up paths if we are on win32
201 29 50       443     if( $^O eq 'MSWin32' ) {
202 0         0         for my $pgm ( $self->program->ls_accessors ) {
203 0 0       0             $self->program->$pgm(
204                             Win32::GetShortPathName( $self->program->$pgm )
205                         ) if $self->program->$pgm =~ /\s+/;
206                     }
207                 }
208              
209 29         687     return 1;
210             }
211              
212             1;
213