| [ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 package CPAN::HandleConfig; 2 use strict; 3 use vars qw(%can %keys $loading $VERSION); 4 5 $VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4; 6 7 %can = ( 8 commit => "Commit changes to disk", 9 defaults => "Reload defaults from disk", 10 help => "Short help about 'o conf' usage", 11 init => "Interactive setting of all options", 12 ); 13 14 # Q: where is the "How do I add a new config option" HOWTO? 15 # A1: svn diff -r 757:758 # where dagolden added test_report 16 # A2: svn diff -r 985:986 # where andk added yaml_module 17 %keys = map { $_ => undef } 18 ( 19 "applypatch", 20 "auto_commit", 21 "build_cache", 22 "build_dir", 23 "build_dir_reuse", 24 "build_requires_install_policy", 25 "bzip2", 26 "cache_metadata", 27 "check_sigs", 28 "colorize_debug", 29 "colorize_output", 30 "colorize_print", 31 "colorize_warn", 32 "commandnumber_in_prompt", 33 "commands_quote", 34 "cpan_home", 35 "curl", 36 "dontload_hash", # deprecated after 1.83_68 (rev. 581) 37 "dontload_list", 38 "ftp", 39 "ftp_passive", 40 "ftp_proxy", 41 "getcwd", 42 "gpg", 43 "gzip", 44 "histfile", 45 "histsize", 46 "http_proxy", 47 "inactivity_timeout", 48 "index_expire", 49 "inhibit_startup_message", 50 "keep_source_where", 51 "load_module_verbosity", 52 "lynx", 53 "make", 54 "make_arg", 55 "make_install_arg", 56 "make_install_make_command", 57 "makepl_arg", 58 "mbuild_arg", 59 "mbuild_install_arg", 60 "mbuild_install_build_command", 61 "mbuildpl_arg", 62 "ncftp", 63 "ncftpget", 64 "no_proxy", 65 "pager", 66 "password", 67 "patch", 68 "prefer_installer", 69 "prefs_dir", 70 "prerequisites_policy", 71 "proxy_pass", 72 "proxy_user", 73 "randomize_urllist", 74 "scan_cache", 75 "shell", 76 "show_unparsable_versions", 77 "show_upload_date", 78 "show_zero_versions", 79 "tar", 80 "tar_verbosity", 81 "term_is_latin", 82 "term_ornaments", 83 "test_report", 84 "unzip", 85 "urllist", 86 "use_sqlite", 87 "username", 88 "wait_list", 89 "wget", 90 "yaml_load_code", 91 "yaml_module", 92 ); 93 94 my %prefssupport = map { $_ => 1 } 95 ( 96 "build_requires_install_policy", 97 "check_sigs", 98 "make", 99 "make_install_make_command", 100 "prefer_installer", 101 "test_report", 102 ); 103 104 if ($^O eq "MSWin32") { 105 for my $k (qw( 106 mbuild_install_build_command 107 make_install_make_command 108 )) { 109 delete $keys{$k}; 110 if (exists $CPAN::Config->{$k}) { 111 for ("deleting previously set config variable '$k' => '$CPAN::Config->{$k}'") { 112 $CPAN::Frontend ? $CPAN::Frontend->mywarn($_) : warn $_; 113 } 114 delete $CPAN::Config->{$k}; 115 } 116 } 117 } 118 119 # returns true on successful action 120 sub edit { 121 my($self,@args) = @_; 122 return unless @args; 123 CPAN->debug("self[$self]args[".join(" | ",@args)."]"); 124 my($o,$str,$func,$args,$key_exists); 125 $o = shift @args; 126 $DB::single = 1; 127 if($can{$o}) { 128 $self->$o(args => \@args); # o conf init => sub init => sub load 129 return 1; 130 } else { 131 CPAN->debug("o[$o]") if $CPAN::DEBUG; 132 unless (exists $keys{$o}) { 133 $CPAN::Frontend->mywarn("Warning: unknown configuration variable '$o'\n"); 134 } 135 my $changed; 136 137 138 # one day I used randomize_urllist for a boolean, so we must 139 # list them explicitly --ak 140 if (0) { 141 } elsif ($o =~ /^(wait_list|urllist|dontload_list)$/) { 142 143 # 144 # ARRAYS 145 # 146 147 $func = shift @args; 148 $func ||= ""; 149 CPAN->debug("func[$func]args[@args]") if $CPAN::DEBUG; 150 # Let's avoid eval, it's easier to comprehend without. 151 if ($func eq "push") { 152 push @{$CPAN::Config->{$o}}, @args; 153 $changed = 1; 154 } elsif ($func eq "pop") { 155 pop @{$CPAN::Config->{$o}}; 156 $changed = 1; 157 } elsif ($func eq "shift") { 158 shift @{$CPAN::Config->{$o}}; 159 $changed = 1; 160 } elsif ($func eq "unshift") { 161 unshift @{$CPAN::Config->{$o}}, @args; 162 $changed = 1; 163 } elsif ($func eq "splice") { 164 my $offset = shift @args || 0; 165 my $length = shift @args || 0; 166 splice @{$CPAN::Config->{$o}}, $offset, $length, @args; # may warn 167 $changed = 1; 168 } elsif ($func) { 169 $CPAN::Config->{$o} = [$func, @args]; 170 $changed = 1; 171 } else { 172 $self->prettyprint($o); 173 } 174 if ($changed) { 175 if ($o eq "urllist") { 176 # reset the cached values 177 undef $CPAN::FTP::Thesite; 178 undef $CPAN::FTP::Themethod; 179 $CPAN::Index::LAST_TIME = 0; 180 } elsif ($o eq "dontload_list") { 181 # empty it, it will be built up again 182 $CPAN::META->{dontload_hash} = {}; 183 } 184 } 185 } elsif ($o =~ /_hash$/) { 186 187 # 188 # HASHES 189 # 190 191 if (@args==1 && $args[0] eq "") { 192 @args = (); 193 } elsif (@args % 2) { 194 push @args, ""; 195 } 196 $CPAN::Config->{$o} = { @args }; 197 $changed = 1; 198 } else { 199 200 # 201 # SCALARS 202 # 203 204 if (defined $args[0]) { 205 $CPAN::CONFIG_DIRTY = 1; 206 $CPAN::Config->{$o} = $args[0]; 207 $changed = 1; 208 } 209 $self->prettyprint($o) 210 if exists $keys{$o} or defined $CPAN::Config->{$o}; 211 } 212 if ($changed) { 213 if ($CPAN::Config->{auto_commit}) { 214 $self->commit; 215 } else { 216 $CPAN::CONFIG_DIRTY = 1; 217 $CPAN::Frontend->myprint("Please use 'o conf commit' to ". 218 "make the config permanent!\n\n"); 219 } 220 } 221 } 222 } 223 224 sub prettyprint { 225 my($self,$k) = @_; 226 my $v = $CPAN::Config->{$k}; 227 if (ref $v) { 228 my(@report); 229 if (ref $v eq "ARRAY") { 230 @report = map {"\t$_ \[$v->[$_]]\n"} 0..$#$v; 231 } else { 232 @report = map 233 { 234 sprintf "\t%-18s => %s\n", 235 "[$_]", 236 defined $v->{$_} ? "[$v->{$_}]" : "undef" 237 } keys %$v; 238 } 239 $CPAN::Frontend->myprint( 240 join( 241 "", 242 sprintf( 243 " %-18s\n", 244 $k 245 ), 246 @report 247 ) 248 ); 249 } elsif (defined $v) { 250 $CPAN::Frontend->myprint(sprintf " %-18s [%s]\n", $k, $v); 251 } else { 252 $CPAN::Frontend->myprint(sprintf " %-18s undef\n", $k); 253 } 254 } 255 256 sub commit { 257 my($self,@args) = @_; 258 CPAN->debug("args[@args]") if $CPAN::DEBUG; 259 if ($CPAN::RUN_DEGRADED) { 260 $CPAN::Frontend->mydie( 261 "'o conf commit' disabled in ". 262 "degraded mode. Maybe try\n". 263 " !undef \$CPAN::RUN_DEGRADED\n" 264 ); 265 } 266 my $configpm; 267 if (@args) { 268 if ($args[0] eq "args") { 269 # we have not signed that contract 270 } else { 271 $configpm = $args[0]; 272 } 273 } 274 unless (defined $configpm) { 275 $configpm ||= $INC{"CPAN/MyConfig.pm"}; 276 $configpm ||= $INC{"CPAN/Config.pm"}; 277 $configpm || Carp::confess(q{ 278 CPAN::Config::commit called without an argument. 279 Please specify a filename where to save the configuration or try 280 "o conf init" to have an interactive course through configing. 281 }); 282 } 283 my($mode); 284 if (-f $configpm) { 285 $mode = (stat $configpm)[2]; 286 if ($mode && ! -w _) { 287 Carp::confess("$configpm is not writable"); 288 } 289 } 290 291 my $msg; 292 $msg = <<EOF unless $configpm =~ /MyConfig/; 293 294 # This is CPAN.pm's systemwide configuration file. This file provides 295 # defaults for users, and the values can be changed in a per-user 296 # configuration file. The user-config file is being looked for as 297 # ~/.cpan/CPAN/MyConfig.pm. 298 299 EOF 300 $msg ||= "\n"; 301 my($fh) = FileHandle->new; 302 rename $configpm, "$configpm~" if -f $configpm; 303 open $fh, ">$configpm" or 304 $CPAN::Frontend->mydie("Couldn't open >$configpm: $!"); 305 $fh->print(qq[$msg\$CPAN::Config = \{\n]); 306 foreach (sort keys %$CPAN::Config) { 307 unless (exists $keys{$_}) { 308 # do not drop them: forward compatibility! 309 $CPAN::Frontend->mywarn("Unknown config variable '$_'\n"); 310 next; 311 } 312 $fh->print( 313 " '$_' => ", 314 $self->neatvalue($CPAN::Config->{$_}), 315 ",\n" 316 ); 317 } 318 319 $fh->print("};\n1;\n__END__\n"); 320 close $fh; 321 322 #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 ); 323 #chmod $mode, $configpm; 324 ###why was that so? $self->defaults; 325 $CPAN::Frontend->myprint("commit: wrote '$configpm'\n"); 326 $CPAN::CONFIG_DIRTY = 0; 327 1; 328 } 329 330 # stolen from MakeMaker; not taking the original because it is buggy; 331 # bugreport will have to say: keys of hashes remain unquoted and can 332 # produce syntax errors 333 sub neatvalue { 334 my($self, $v) = @_; 335 return "undef" unless defined $v; 336 my($t) = ref $v; 337 unless ($t) { 338 $v =~ s/\\/\\\\/g; 339 return "q[$v]"; 340 } 341 if ($t eq 'ARRAY') { 342 my(@m, @neat); 343 push @m, "["; 344 foreach my $elem (@$v) { 345 push @neat, "q[$elem]"; 346 } 347 push @m, join ", ", @neat; 348 push @m, "]"; 349 return join "", @m; 350 } 351 return "$v" unless $t eq 'HASH'; 352 my(@m, $key, $val); 353 while (($key,$val) = each %$v) { 354 last unless defined $key; # cautious programming in case (undef,undef) is true 355 push(@m,"q[$key]=>".$self->neatvalue($val)) ; 356 } 357 return "{ ".join(', ',@m)." }"; 358 } 359 360 sub defaults { 361 my($self) = @_; 362 if ($CPAN::RUN_DEGRADED) { 363 $CPAN::Frontend->mydie( 364 "'o conf defaults' disabled in ". 365 "degraded mode. Maybe try\n". 366 " !undef \$CPAN::RUN_DEGRADED\n" 367 ); 368 } 369 my $done; 370 for my $config (qw(CPAN/MyConfig.pm CPAN/Config.pm)) { 371 if ($INC{$config}) { 372 CPAN->debug("INC{'$config'}[$INC{$config}]") if $CPAN::DEBUG; 373 CPAN::Shell->_reload_this($config,{reloforce => 1}); 374 $CPAN::Frontend->myprint("'$INC{$config}' reread\n"); 375 last; 376 } 377 } 378 $CPAN::CONFIG_DIRTY = 0; 379 1; 380 } 381 382 =head2 C<< CLASS->safe_quote ITEM >> 383 384 Quotes an item to become safe against spaces 385 in shell interpolation. An item is enclosed 386 in double quotes if: 387 388 - the item contains spaces in the middle 389 - the item does not start with a quote 390 391 This happens to avoid shell interpolation 392 problems when whitespace is present in 393 directory names. 394 395 This method uses C<commands_quote> to determine 396 the correct quote. If C<commands_quote> is 397 a space, no quoting will take place. 398 399 400 if it starts and ends with the same quote character: leave it as it is 401 402 if it contains no whitespace: leave it as it is 403 404 if it contains whitespace, then 405 406 if it contains quotes: better leave it as it is 407 408 else: quote it with the correct quote type for the box we're on 409 410 =cut 411 412 { 413 # Instead of patching the guess, set commands_quote 414 # to the right value 415 my ($quotes,$use_quote) 416 = $^O eq 'MSWin32' 417 ? ('"', '"') 418 : (q{"'}, "'") 419 ; 420 421 sub safe_quote { 422 my ($self, $command) = @_; 423 # Set up quote/default quote 424 my $quote = $CPAN::Config->{commands_quote} || $quotes; 425 426 if ($quote ne ' ' 427 and defined($command ) 428 and $command =~ /\s/ 429 and $command !~ /[$quote]/) { 430 return qq<$use_quote$command$use_quote> 431 } 432 return $command; 433 } 434 } 435 436 sub init { 437 my($self,@args) = @_; 438 CPAN->debug("self[$self]args[".join(",",@args)."]"); 439 $self->load(doit => 1, @args); 440 1; 441 } 442 443 # This is a piece of repeated code that is abstracted here for 444 # maintainability. RMB 445 # 446 sub _configpmtest { 447 my($configpmdir, $configpmtest) = @_; 448 if (-w $configpmtest) { 449 return $configpmtest; 450 } elsif (-w $configpmdir) { 451 #_#_# following code dumped core on me with 5.003_11, a.k. 452 my $configpm_bak = "$configpmtest.bak"; 453 unlink $configpm_bak if -f $configpm_bak; 454 if( -f $configpmtest ) { 455 if( rename $configpmtest, $configpm_bak ) { 456 $CPAN::Frontend->mywarn(<<END); 457 Old configuration file $configpmtest 458 moved to $configpm_bak 459 END 460 } 461 } 462 my $fh = FileHandle->new; 463 if ($fh->open(">$configpmtest")) { 464 $fh->print("1;\n"); 465 return $configpmtest; 466 } else { 467 # Should never happen 468 Carp::confess("Cannot open >$configpmtest"); 469 } 470 } else { return } 471 } 472 473 sub require_myconfig_or_config () { 474 return if $INC{"CPAN/MyConfig.pm"}; 475 local @INC = @INC; 476 my $home = home(); 477 unshift @INC, File::Spec->catdir($home,'.cpan'); 478 eval { require CPAN::MyConfig }; 479 my $err_myconfig = $@; 480 if ($err_myconfig and $err_myconfig !~ m#locate CPAN/MyConfig\.pm#) { 481 die "Error while requiring CPAN::MyConfig:\n$err_myconfig"; 482 } 483 unless ($INC{"CPAN/MyConfig.pm"}) { # this guy has settled his needs already 484 eval {require CPAN::Config;}; # not everybody has one 485 my $err_config = $@; 486 if ($err_config and $err_config !~ m#locate CPAN/Config\.pm#) { 487 die "Error while requiring CPAN::Config:\n$err_config"; 488 } 489 } 490 } 491 492 sub home () { 493 my $home; 494 if ($CPAN::META->has_usable("File::HomeDir")) { 495 $home = File::HomeDir->my_data; 496 unless (defined $home) { 497 $home = File::HomeDir->my_home 498 } 499 } 500 unless (defined $home) { 501 $home = $ENV{HOME}; 502 } 503 $home; 504 } 505 506 sub load { 507 my($self, %args) = @_; 508 $CPAN::Be_Silent++ if $args{be_silent}; 509 my $doit; 510 $doit = delete $args{doit}; 511 512 use Carp; 513 require_myconfig_or_config; 514 my @miss = $self->missing_config_data; 515 return unless $doit || @miss; 516 return if $loading; 517 $loading++; 518 519 require CPAN::FirstTime; 520 my($configpm,$fh,$redo); 521 $redo ||= ""; 522 if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) { 523 $configpm = $INC{"CPAN/Config.pm"}; 524 $redo++; 525 } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) { 526 $configpm = $INC{"CPAN/MyConfig.pm"}; 527 $redo++; 528 } else { 529 my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"}); 530 my($configpmdir) = File::Spec->catdir($path_to_cpan,"CPAN"); 531 my($configpmtest) = File::Spec->catfile($configpmdir,"Config.pm"); 532 my $inc_key; 533 if (-d $configpmdir or File::Path::mkpath($configpmdir)) { 534 $configpm = _configpmtest($configpmdir,$configpmtest); 535 $inc_key = "CPAN/Config.pm"; 536 } 537 unless ($configpm) { 538 $configpmdir = File::Spec->catdir(home,".cpan","CPAN"); 539 File::Path::mkpath($configpmdir); 540 $configpmtest = File::Spec->catfile($configpmdir,"MyConfig.pm"); 541 $configpm = _configpmtest($configpmdir,$configpmtest); 542 $inc_key = "CPAN/MyConfig.pm"; 543 } 544 if ($configpm) { 545 $INC{$inc_key} = $configpm; 546 } else { 547 my $text = qq{WARNING: CPAN.pm is unable to } . 548 qq{create a configuration file.}; 549 output($text, 'confess'); 550 } 551 552 } 553 local($") = ", "; 554 if ($redo && !$doit) { 555 $CPAN::Frontend->myprint(<<END); 556 Sorry, we have to rerun the configuration dialog for CPAN.pm due to 557 some missing parameters... 558 559 END 560 $args{args} = \@miss; 561 } 562 CPAN::FirstTime::init($configpm, %args); 563 $loading--; 564 return; 565 } 566 567 568 # returns mandatory but missing entries in the Config 569 sub missing_config_data { 570 my(@miss); 571 for ( 572 "auto_commit", 573 "build_cache", 574 "build_dir", 575 "cache_metadata", 576 "cpan_home", 577 "ftp_proxy", 578 #"gzip", 579 "http_proxy", 580 "index_expire", 581 #"inhibit_startup_message", 582 "keep_source_where", 583 #"make", 584 "make_arg", 585 "make_install_arg", 586 "makepl_arg", 587 "mbuild_arg", 588 "mbuild_install_arg", 589 "mbuild_install_build_command", 590 "mbuildpl_arg", 591 "no_proxy", 592 #"pager", 593 "prerequisites_policy", 594 "scan_cache", 595 #"tar", 596 #"unzip", 597 "urllist", 598 ) { 599 next unless exists $keys{$_}; 600 push @miss, $_ unless defined $CPAN::Config->{$_}; 601 } 602 return @miss; 603 } 604 605 sub help { 606 $CPAN::Frontend->myprint(q[ 607 Known options: 608 commit commit session changes to disk 609 defaults reload default config values from disk 610 help this help 611 init enter a dialog to set all or a set of parameters 612 613 Edit key values as in the following (the "o" is a literal letter o): 614 o conf build_cache 15 615 o conf build_dir "/foo/bar" 616 o conf urllist shift 617 o conf urllist unshift ftp://ftp.foo.bar/ 618 o conf inhibit_startup_message 1 619 620 ]); 621 undef; #don't reprint CPAN::Config 622 } 623 624 sub cpl { 625 my($word,$line,$pos) = @_; 626 $word ||= ""; 627 CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG; 628 my(@words) = split " ", substr($line,0,$pos+1); 629 if ( 630 defined($words[2]) 631 and 632 $words[2] =~ /list$/ 633 and 634 ( 635 @words == 3 636 || 637 @words == 4 && length($word) 638 ) 639 ) { 640 return grep /^\Q$word\E/, qw(splice shift unshift pop push); 641 } elsif (defined($words[2]) 642 and 643 $words[2] eq "init" 644 and 645 ( 646 @words == 3 647 || 648 @words >= 4 && length($word) 649 )) { 650 return sort grep /^\Q$word\E/, keys %keys; 651 } elsif (@words >= 4) { 652 return (); 653 } 654 my %seen; 655 my(@o_conf) = sort grep { !$seen{$_}++ } 656 keys %can, 657 keys %$CPAN::Config, 658 keys %keys; 659 return grep /^\Q$word\E/, @o_conf; 660 } 661 662 sub prefs_lookup { 663 my($self,$distro,$what) = @_; 664 665 if ($prefssupport{$what}) { 666 return $CPAN::Config->{$what} unless 667 $distro 668 and $distro->prefs 669 and $distro->prefs->{cpanconfig} 670 and defined $distro->prefs->{cpanconfig}{$what}; 671 return $distro->prefs->{cpanconfig}{$what}; 672 } else { 673 $CPAN::Frontend->mywarn("Warning: $what not yet officially ". 674 "supported for distroprefs, doing a normal lookup"); 675 return $CPAN::Config->{$what}; 676 } 677 } 678 679 680 { 681 package 682 CPAN::Config; ####::###### #hide from indexer 683 # note: J. Nick Koston wrote me that they are using 684 # CPAN::Config->commit although undocumented. I suggested 685 # CPAN::Shell->o("conf","commit") even when ugly it is at least 686 # documented 687 688 # that's why I added the CPAN::Config class with autoload and 689 # deprecated warning 690 691 use strict; 692 use vars qw($AUTOLOAD $VERSION); 693 $VERSION = sprintf "%.2f", substr(q$Rev: 2212 $,4)/100; 694 695 # formerly CPAN::HandleConfig was known as CPAN::Config 696 sub AUTOLOAD { 697 my $class = shift; # e.g. in dh-make-perl: CPAN::Config 698 my($l) = $AUTOLOAD; 699 $CPAN::Frontend->mywarn("Dispatching deprecated method '$l' to CPAN::HandleConfig\n"); 700 $l =~ s/.*:://; 701 CPAN::HandleConfig->$l(@_); 702 } 703 } 704 705 1; 706 707 __END__ 708 709 =head1 LICENSE 710 711 This program is free software; you can redistribute it and/or 712 modify it under the same terms as Perl itself. 713 714 =cut 715 716 # Local Variables: 717 # mode: cperl 718 # cperl-indent-level: 4 719 # End:
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
| Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |