| Commit | Line | Data |
|---|
| e82b9348 |
1 | package CPAN::HandleConfig; |
| 2 | use strict; |
| 3 | use vars qw(%can %keys $dot_cpan); |
| 4 | |
| 5 | %can = ( |
| 6 | 'commit' => "Commit changes to disk", |
| 7 | 'defaults' => "Reload defaults from disk", |
| 8 | 'init' => "Interactive setting of all options", |
| 9 | ); |
| 10 | |
| 11 | %keys = map { $_ => undef } qw( |
| 12 | build_cache build_dir bzip2 |
| 13 | cache_metadata cpan_home curl |
| 14 | dontload_hash |
| 15 | ftp ftp_proxy |
| 16 | getcwd gpg gzip |
| 17 | histfile histsize http_proxy |
| 18 | inactivity_timeout index_expire inhibit_startup_message |
| 19 | keep_source_where |
| 20 | lynx |
| 21 | make make_arg make_install_arg make_install_make_command makepl_arg |
| 22 | mbuild_arg mbuild_install_arg mbuild_install_build_command mbuildpl_arg |
| 23 | ncftp ncftpget no_proxy pager |
| 24 | prefer_installer prerequisites_policy |
| 25 | scan_cache shell show_upload_date |
| 26 | tar term_is_latin |
| 27 | unzip urllist |
| 28 | wait_list wget |
| 29 | ); |
| 30 | |
| 31 | # returns true on successful action |
| 32 | sub edit { |
| 33 | my($self,@args) = @_; |
| 34 | return unless @args; |
| 35 | CPAN->debug("self[$self]args[".join(" | ",@args)."]"); |
| 36 | my($o,$str,$func,$args,$key_exists); |
| 37 | $o = shift @args; |
| 38 | if($can{$o}) { |
| 39 | $self->$o(@args); |
| 40 | return 1; |
| 41 | } else { |
| 42 | CPAN->debug("o[$o]") if $CPAN::DEBUG; |
| 43 | unless (exists $keys{$o}) { |
| 44 | $CPAN::Frontend->mywarn("Warning: unknown configuration variable '$o'\n"); |
| 45 | } |
| 46 | if ($o =~ /list$/) { |
| 47 | $func = shift @args; |
| 48 | $func ||= ""; |
| 49 | CPAN->debug("func[$func]") if $CPAN::DEBUG; |
| 50 | my $changed; |
| 51 | # Let's avoid eval, it's easier to comprehend without. |
| 52 | if ($func eq "push") { |
| 53 | push @{$CPAN::Config->{$o}}, @args; |
| 54 | $changed = 1; |
| 55 | } elsif ($func eq "pop") { |
| 56 | pop @{$CPAN::Config->{$o}}; |
| 57 | $changed = 1; |
| 58 | } elsif ($func eq "shift") { |
| 59 | shift @{$CPAN::Config->{$o}}; |
| 60 | $changed = 1; |
| 61 | } elsif ($func eq "unshift") { |
| 62 | unshift @{$CPAN::Config->{$o}}, @args; |
| 63 | $changed = 1; |
| 64 | } elsif ($func eq "splice") { |
| 65 | splice @{$CPAN::Config->{$o}}, @args; |
| 66 | $changed = 1; |
| 67 | } elsif (@args) { |
| 68 | $CPAN::Config->{$o} = [@args]; |
| 69 | $changed = 1; |
| 70 | } else { |
| 71 | $self->prettyprint($o); |
| 72 | } |
| 73 | if ($o eq "urllist" && $changed) { |
| 74 | # reset the cached values |
| 75 | undef $CPAN::FTP::Thesite; |
| 76 | undef $CPAN::FTP::Themethod; |
| 77 | } |
| 78 | return $changed; |
| 79 | } else { |
| 80 | $CPAN::Config->{$o} = $args[0] if defined $args[0]; |
| 81 | $self->prettyprint($o); |
| 82 | } |
| 83 | } |
| 84 | } |
| 85 | |
| 86 | sub prettyprint { |
| 87 | my($self,$k) = @_; |
| 88 | my $v = $CPAN::Config->{$k}; |
| 89 | if (ref $v) { |
| 90 | my(@report) = ref $v eq "ARRAY" ? |
| 91 | @$v : |
| 92 | map { sprintf(" %-18s => [%s]\n", |
| 93 | map { "[$_]" } $_, |
| 94 | defined $v->{$_} ? $v->{$_} : "UNDEFINED" |
| 95 | )} keys %$v; |
| 96 | $CPAN::Frontend->myprint( |
| 97 | join( |
| 98 | "", |
| 99 | sprintf( |
| 100 | " %-18s\n", |
| 101 | $k |
| 102 | ), |
| 103 | map {"\t[$_]\n"} @report |
| 104 | ) |
| 105 | ); |
| 106 | } elsif (defined $v) { |
| 107 | $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v); |
| 108 | } else { |
| 109 | $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, "UNDEFINED"); |
| 110 | } |
| 111 | } |
| 112 | |
| 113 | sub commit { |
| 114 | my($self,$configpm) = @_; |
| 115 | unless (defined $configpm){ |
| 116 | $configpm ||= $INC{"CPAN/MyConfig.pm"}; |
| 117 | $configpm ||= $INC{"CPAN/Config.pm"}; |
| 118 | $configpm || Carp::confess(q{ |
| 119 | CPAN::Config::commit called without an argument. |
| 120 | Please specify a filename where to save the configuration or try |
| 121 | "o conf init" to have an interactive course through configing. |
| 122 | }); |
| 123 | } |
| 124 | my($mode); |
| 125 | if (-f $configpm) { |
| 126 | $mode = (stat $configpm)[2]; |
| 127 | if ($mode && ! -w _) { |
| 128 | Carp::confess("$configpm is not writable"); |
| 129 | } |
| 130 | } |
| 131 | |
| 132 | my $msg; |
| 133 | $msg = <<EOF unless $configpm =~ /MyConfig/; |
| 134 | |
| 135 | # This is CPAN.pm's systemwide configuration file. This file provides |
| 136 | # defaults for users, and the values can be changed in a per-user |
| 137 | # configuration file. The user-config file is being looked for as |
| 138 | # ~/.cpan/CPAN/MyConfig.pm. |
| 139 | |
| 140 | EOF |
| 141 | $msg ||= "\n"; |
| 142 | my($fh) = FileHandle->new; |
| 143 | rename $configpm, "$configpm~" if -f $configpm; |
| 144 | open $fh, ">$configpm" or |
| 145 | $CPAN::Frontend->mydie("Couldn't open >$configpm: $!"); |
| 146 | $fh->print(qq[$msg\$CPAN::Config = \{\n]); |
| 147 | foreach (sort keys %$CPAN::Config) { |
| 148 | $fh->print( |
| 149 | " '$_' => ", |
| 150 | ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}), |
| 151 | ",\n" |
| 152 | ); |
| 153 | } |
| 154 | |
| 155 | $fh->print("};\n1;\n__END__\n"); |
| 156 | close $fh; |
| 157 | |
| 158 | #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 ); |
| 159 | #chmod $mode, $configpm; |
| 160 | ###why was that so? $self->defaults; |
| 161 | $CPAN::Frontend->myprint("commit: wrote $configpm\n"); |
| 162 | 1; |
| 163 | } |
| 164 | |
| 165 | *default = \&defaults; |
| 166 | sub defaults { |
| 167 | my($self) = @_; |
| 168 | $self->unload; |
| 169 | $self->load; |
| 170 | 1; |
| 171 | } |
| 172 | |
| 173 | sub init { |
| 174 | my($self) = @_; |
| 175 | undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to |
| 176 | # have the least |
| 177 | # important |
| 178 | # variable |
| 179 | # undefined |
| 180 | $self->load; |
| 181 | 1; |
| 182 | } |
| 183 | |
| 184 | # This is a piece of repeated code that is abstracted here for |
| 185 | # maintainability. RMB |
| 186 | # |
| 187 | sub _configpmtest { |
| 188 | my($configpmdir, $configpmtest) = @_; |
| 189 | if (-w $configpmtest) { |
| 190 | return $configpmtest; |
| 191 | } elsif (-w $configpmdir) { |
| 192 | #_#_# following code dumped core on me with 5.003_11, a.k. |
| 193 | my $configpm_bak = "$configpmtest.bak"; |
| 194 | unlink $configpm_bak if -f $configpm_bak; |
| 195 | if( -f $configpmtest ) { |
| 196 | if( rename $configpmtest, $configpm_bak ) { |
| 197 | $CPAN::Frontend->mywarn(<<END); |
| 198 | Old configuration file $configpmtest |
| 199 | moved to $configpm_bak |
| 200 | END |
| 201 | } |
| 202 | } |
| 203 | my $fh = FileHandle->new; |
| 204 | if ($fh->open(">$configpmtest")) { |
| 205 | $fh->print("1;\n"); |
| 206 | return $configpmtest; |
| 207 | } else { |
| 208 | # Should never happen |
| 209 | Carp::confess("Cannot open >$configpmtest"); |
| 210 | } |
| 211 | } else { return } |
| 212 | } |
| 213 | |
| 214 | sub load { |
| 215 | my($self, %args) = @_; |
| 216 | $CPAN::Be_Silent++ if $args{be_silent}; |
| 217 | |
| 218 | my(@miss); |
| 219 | use Carp; |
| 220 | eval {require CPAN::Config;}; # We eval because of some |
| 221 | # MakeMaker problems |
| 222 | unless ($dot_cpan++){ |
| 223 | unshift @INC, File::Spec->catdir($ENV{HOME},".cpan"); |
| 224 | eval {require CPAN::MyConfig;}; # where you can override |
| 225 | # system wide settings |
| 226 | shift @INC; |
| 227 | } |
| 228 | return unless @miss = $self->missing_config_data; |
| 229 | |
| 230 | require CPAN::FirstTime; |
| 231 | my($configpm,$fh,$redo,$theycalled); |
| 232 | $redo ||= ""; |
| 233 | $theycalled++ if @miss==1 && $miss[0] eq 'inhibit_startup_message'; |
| 234 | if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) { |
| 235 | $configpm = $INC{"CPAN/Config.pm"}; |
| 236 | $redo++; |
| 237 | } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) { |
| 238 | $configpm = $INC{"CPAN/MyConfig.pm"}; |
| 239 | $redo++; |
| 240 | } else { |
| 241 | my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"}); |
| 242 | my($configpmdir) = File::Spec->catdir($path_to_cpan,"CPAN"); |
| 243 | my($configpmtest) = File::Spec->catfile($configpmdir,"Config.pm"); |
| 244 | if (-d $configpmdir or File::Path::mkpath($configpmdir)) { |
| 245 | $configpm = _configpmtest($configpmdir,$configpmtest); |
| 246 | } |
| 247 | unless ($configpm) { |
| 248 | $configpmdir = File::Spec->catdir($ENV{HOME},".cpan","CPAN"); |
| 249 | File::Path::mkpath($configpmdir); |
| 250 | $configpmtest = File::Spec->catfile($configpmdir,"MyConfig.pm"); |
| 251 | $configpm = _configpmtest($configpmdir,$configpmtest); |
| 252 | unless ($configpm) { |
| 253 | my $text = qq{WARNING: CPAN.pm is unable to } . |
| 254 | qq{create a configuration file.}; |
| 255 | output($text, 'confess'); |
| 256 | } |
| 257 | } |
| 258 | } |
| 259 | local($") = ", "; |
| 260 | $CPAN::Frontend->myprint(<<END) if $redo && ! $theycalled; |
| 261 | We have to reconfigure CPAN.pm due to following uninitialized parameters: |
| 262 | |
| 263 | @miss |
| 264 | END |
| 265 | $CPAN::Frontend->myprint(qq{ |
| 266 | $configpm initialized. |
| 267 | }); |
| 268 | |
| 269 | sleep 2; |
| 270 | CPAN::FirstTime::init($configpm, %args); |
| 271 | } |
| 272 | |
| 273 | sub missing_config_data { |
| 274 | my(@miss); |
| 275 | for ( |
| 276 | "cpan_home", "keep_source_where", "build_dir", "build_cache", |
| 277 | "scan_cache", "index_expire", "gzip", "tar", "unzip", "make", |
| 278 | "pager", |
| 279 | "makepl_arg", "make_arg", "make_install_arg", "urllist", |
| 280 | "inhibit_startup_message", "ftp_proxy", "http_proxy", "no_proxy", |
| 281 | "prerequisites_policy", |
| 282 | "cache_metadata", |
| 283 | ) { |
| 284 | push @miss, $_ unless defined $CPAN::Config->{$_}; |
| 285 | } |
| 286 | return @miss; |
| 287 | } |
| 288 | |
| 289 | sub unload { |
| 290 | delete $INC{'CPAN/MyConfig.pm'}; |
| 291 | delete $INC{'CPAN/Config.pm'}; |
| 292 | } |
| 293 | |
| 294 | sub help { |
| 295 | $CPAN::Frontend->myprint(q[ |
| 296 | Known options: |
| 297 | defaults reload default config values from disk |
| 298 | commit commit session changes to disk |
| 299 | init go through a dialog to set all parameters |
| 300 | |
| 301 | You may edit key values in the follow fashion (the "o" is a literal |
| 302 | letter o): |
| 303 | |
| 304 | o conf build_cache 15 |
| 305 | |
| 306 | o conf build_dir "/foo/bar" |
| 307 | |
| 308 | o conf urllist shift |
| 309 | |
| 310 | o conf urllist unshift ftp://ftp.foo.bar/ |
| 311 | |
| 312 | ]); |
| 313 | undef; #don't reprint CPAN::Config |
| 314 | } |
| 315 | |
| 316 | sub cpl { |
| 317 | my($word,$line,$pos) = @_; |
| 318 | $word ||= ""; |
| 319 | CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG; |
| 320 | my(@words) = split " ", substr($line,0,$pos+1); |
| 321 | if ( |
| 322 | defined($words[2]) |
| 323 | and |
| 324 | ( |
| 325 | $words[2] =~ /list$/ && @words == 3 |
| 326 | || |
| 327 | $words[2] =~ /list$/ && @words == 4 && length($word) |
| 328 | ) |
| 329 | ) { |
| 330 | return grep /^\Q$word\E/, qw(splice shift unshift pop push); |
| 331 | } elsif (@words >= 4) { |
| 332 | return (); |
| 333 | } |
| 334 | my %seen; |
| 335 | my(@o_conf) = sort grep { !$seen{$_}++ } |
| 336 | keys %can, |
| 337 | keys %$CPAN::Config, |
| 338 | keys %keys; |
| 339 | return grep /^\Q$word\E/, @o_conf; |
| 340 | } |
| 341 | |
| 342 | 1; |
projects / p5sagit/p5-mst-13.2.git / blame