| [ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 package CPANPLUS::Configure::Setup; 2 3 use strict; 4 use vars qw(@ISA); 5 6 use base qw[CPANPLUS::Internals::Utils]; 7 use base qw[Object::Accessor]; 8 9 use Config; 10 use Term::UI; 11 use Module::Load; 12 use Term::ReadLine; 13 14 15 use CPANPLUS::Internals::Utils; 16 use CPANPLUS::Internals::Constants; 17 use CPANPLUS::Error; 18 19 use IPC::Cmd qw[can_run]; 20 use Params::Check qw[check]; 21 use Module::Load::Conditional qw[check_install]; 22 use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; 23 24 ### silence Term::UI 25 $Term::UI::VERBOSE = 0; 26 27 #Can't ioctl TIOCGETP: Unknown error 28 #Consider installing Term::ReadKey from CPAN site nearby 29 # at http://www.perl.com/CPAN 30 #Or use 31 # perl -MCPAN -e shell 32 #to reach CPAN. Falling back to 'stty'. 33 # If you do not want to see this warning, set PERL_READLINE_NOWARN 34 #in your environment. 35 #'stty' is not recognized as an internal or external command, 36 #operable program or batch file. 37 #Cannot call `stty': No such file or directory at C:/Perl/site/lib/Term/ReadLine/ 38 39 ### setting this var in the meantime to avoid this warning ### 40 $ENV{PERL_READLINE_NOWARN} = 1; 41 42 43 sub new { 44 my $class = shift; 45 my %hash = @_; 46 47 my $tmpl = { 48 configure_object => { }, 49 term => { }, 50 backend => { }, 51 autoreply => { default => 0, }, 52 skip_mirrors => { default => 0, }, 53 use_previous => { default => 1, }, 54 config_type => { default => CONFIG_USER }, 55 }; 56 57 my $args = check( $tmpl, \%hash ) or return; 58 59 ### initialize object 60 my $obj = $class->SUPER::new( keys %$tmpl ); 61 for my $acc ( $obj->ls_accessors ) { 62 $obj->$acc( $args->{$acc} ); 63 } 64 65 ### otherwise there's a circular use ### 66 load CPANPLUS::Configure; 67 load CPANPLUS::Backend; 68 69 $obj->configure_object( CPANPLUS::Configure->new() ) 70 unless $obj->configure_object; 71 72 $obj->backend( CPANPLUS::Backend->new( $obj->configure_object ) ) 73 unless $obj->backend; 74 75 ### use empty string in case user only has T::R::Stub -- it complains 76 $obj->term( Term::ReadLine->new('') ) 77 unless $obj->term; 78 79 ### enable autoreply if that was passed ### 80 $Term::UI::AUTOREPLY = $obj->autoreply; 81 82 return $obj; 83 } 84 85 sub init { 86 my $self = shift; 87 my $term = $self->term; 88 89 ### default setting, unless changed 90 $self->config_type( CONFIG_USER ) unless $self->config_type; 91 92 my $save = loc('Save & exit'); 93 my $exit = loc('Quit without saving'); 94 my @map = ( 95 # key on the display # method to dispatch to 96 [ loc('Select Configuration file') => '_save_where' ], 97 [ loc('Setup CLI Programs') => '_setup_program' ], 98 [ loc('Setup CPANPLUS Home directory') => '_setup_base' ], 99 [ loc('Setup FTP/Email settings') => '_setup_ftp' ], 100 [ loc('Setup basic preferences') => '_setup_conf' ], 101 [ loc('Setup installer settings') => '_setup_installer' ], 102 [ loc('Select mirrors'), => '_setup_hosts' ], 103 [ loc('Edit configuration file') => '_edit' ], 104 [ $save => '_save' ], 105 [ $exit => 1 ], 106 ); 107 108 my @keys = map { $_->[0] } @map; # sorted keys 109 my %map = map { @$_ } @map; # lookup hash 110 111 PICK_SECTION: { 112 print loc(" 113 =================> MAIN MENU <================= 114 115 Welcome to the CPANPLUS configuration. Please select which 116 parts you wish to configure 117 118 Defaults are taken from your current configuration. 119 If you would save now, your settings would be written to: 120 121 %1 122 123 ", $self->config_type ); 124 125 my $choice = $term->get_reply( 126 prompt => "Section to configure:", 127 choices => \@keys, 128 default => $keys[0] 129 ); 130 131 ### exit configuration? 132 if( $choice eq $exit ) { 133 print loc(" 134 Quitting setup, changes will not be saved. 135 "); 136 return 1; 137 } 138 139 my $method = $map{$choice}; 140 141 my $rv = $self->$method or print loc(" 142 There was an error setting up this section. You might want to try again 143 "); 144 145 ### was it save & exit? 146 if( $choice eq $save and $rv ) { 147 print loc(" 148 Quitting setup, changes are saved to '%1' 149 ", $self->config_type 150 ); 151 return 1; 152 } 153 154 ### otherwise, present choice again 155 redo PICK_SECTION; 156 } 157 158 return 1; 159 } 160 161 162 163 ### sub that figures out what kind of config type the user wants 164 sub _save_where { 165 my $self = shift; 166 my $term = $self->term; 167 my $conf = $self->configure_object; 168 169 170 ASK_CONFIG_TYPE: { 171 172 print loc( q[ 173 Where would you like to save your CPANPLUS Configuration file? 174 175 If you want to configure CPANPLUS for this user only, 176 select the '%1' option. 177 The file will then be saved in your homedirectory. 178 179 If you are the system administrator of this machine, 180 and would like to make this config available globally, 181 select the '%2' option. 182 The file will be then be saved in your CPANPLUS 183 installation directory. 184 185 ], CONFIG_USER, CONFIG_SYSTEM ); 186 187 188 ### ask what config type we should save to 189 my $type = $term->get_reply( 190 prompt => loc("Type of configuration file"), 191 default => $self->config_type || CONFIG_USER, 192 choices => [CONFIG_USER, CONFIG_SYSTEM], 193 ); 194 195 my $file = $conf->_config_pm_to_file( $type ); 196 197 ### can we save to this file? 198 unless( $conf->can_save( $file ) ) { 199 error(loc( 200 "Can not save to file '%1'-- please check permissions " . 201 "and try again", $file 202 )); 203 204 redo ASK_CONFIG_FILE; 205 } 206 207 ### you already have the file -- are we allowed to overwrite 208 ### or should we try again? 209 if ( -e $file and -w _ ) { 210 print loc(q[ 211 I see you already have this file: 212 %1 213 214 If you continue & save this file, the previous version will be overwritten. 215 216 ], $file ); 217 218 redo ASK_CONFIG_TYPE 219 unless $term->ask_yn( 220 prompt => loc( "Shall I overwrite it?"), 221 default => 'n', 222 ); 223 } 224 225 print $/, loc("Using '%1' as your configuration type", $type); 226 227 return $self->config_type($type); 228 } 229 } 230 231 232 ### setup the build & cache dirs 233 sub _setup_base { 234 my $self = shift; 235 my $term = $self->term; 236 my $conf = $self->configure_object; 237 238 my $base = $conf->get_conf('base'); 239 my $home = File::Spec->catdir( $self->_home_dir, DOT_CPANPLUS ); 240 241 print loc(" 242 CPANPLUS needs a directory of its own to cache important index 243 files and maybe keep a temporary mirror of CPAN files. 244 This may be a site-wide directory or a personal directory. 245 246 For a single-user installation, we suggest using your home directory. 247 248 "); 249 250 my $where; 251 ASK_HOME_DIR: { 252 my $other = loc('Somewhere else'); 253 if( $base and ($base ne $home) ) { 254 print loc("You have several choices:"); 255 256 $where = $term->get_reply( 257 prompt => loc('Please pick one'), 258 choices => [$home, $base, $other], 259 default => $home, 260 ); 261 } else { 262 $where = $base; 263 } 264 265 if( $where and -d $where ) { 266 print loc(" 267 I see you already have a directory: 268 %1 269 270 "), $where; 271 272 my $yn = $term->ask_yn( 273 prompt => loc('Should I use it?'), 274 default => 'y', 275 ); 276 $where = '' unless $yn; 277 } 278 279 if( $where and ($where ne $other) and not -d $where ) { 280 if (!$self->_mkdir( dir => $where ) ) { 281 print "\n", loc("Unable to create directory '%1'", $where); 282 redo ASK_HOME_DIR; 283 } 284 285 } elsif( not $where or ($where eq $other) ) { 286 print loc(" 287 First of all, I'd like to create this directory. 288 289 "); 290 291 NEW_HOME: { 292 $where = $term->get_reply( 293 prompt => loc('Where shall I create it?'), 294 default => $home, 295 ); 296 297 my $again; 298 if( -d $where and not -w _ ) { 299 print "\n", loc("I can't seem to write in this directory"); 300 $again++; 301 } elsif (!$self->_mkdir( dir => $where ) ) { 302 print "\n", loc("Unable to create directory '%1'", $where); 303 $again++; 304 } 305 306 if( $again ) { 307 print "\n", loc('Please select another directory'), "\n\n"; 308 redo NEW_HOME; 309 } 310 } 311 } 312 } 313 314 ### tidy up the path and store it 315 $where = File::Spec->rel2abs($where); 316 $conf->set_conf( base => $where ); 317 318 ### create subdirectories ### 319 my @dirs = 320 File::Spec->catdir( $where, $self->_perl_version(perl => $^X), 321 $conf->_get_build('moddir') ), 322 map { 323 File::Spec->catdir( $where, $conf->_get_build($_) ) 324 } qw[autdir distdir]; 325 326 for my $dir ( @dirs ) { 327 unless( $self->_mkdir( dir => $dir ) ) { 328 warn loc("I wasn't able to create '%1'", $dir), "\n"; 329 } 330 } 331 332 ### clear away old storable images before 0.031 333 for my $src (qw[dslip mailrc packages]) { 334 1 while unlink File::Spec->catfile( $where, $src ); 335 336 } 337 338 print loc(q[ 339 Your CPANPLUS build and cache directory has been set to: 340 %1 341 342 ], $where); 343 344 return 1; 345 } 346 347 sub _setup_ftp { 348 my $self = shift; 349 my $term = $self->term; 350 my $conf = $self->configure_object; 351 352 ######################### 353 ## are you a pacifist? ## 354 ######################### 355 356 print loc(" 357 If you are connecting through a firewall or proxy that doesn't handle 358 FTP all that well you can use passive FTP. 359 360 "); 361 362 my $yn = $term->ask_yn( 363 prompt => loc("Use passive FTP?"), 364 default => $conf->get_conf('passive'), 365 ); 366 367 $conf->set_conf(passive => $yn); 368 369 ### set the ENV var as well, else it won't get set till AFTER 370 ### the configuration is saved. but we fetch files BEFORE that. 371 $ENV{FTP_PASSIVE} = $yn; 372 373 print "\n"; 374 print $yn 375 ? loc("I will use passive FTP.") 376 : loc("I won't use passive FTP."); 377 print "\n"; 378 379 ############################# 380 ## should fetches timeout? ## 381 ############################# 382 383 print loc(" 384 CPANPLUS can specify a network timeout for downloads (in whole seconds). 385 If none is desired (or to skip this question), enter '0'. 386 387 "); 388 389 my $timeout = 0 + $term->get_reply( 390 prompt => loc("Network timeout for downloads"), 391 default => $conf->get_conf('timeout') || 0, 392 allow => qr/(?!\D)/, ### whole numbers only 393 ); 394 395 $conf->set_conf(timeout => $timeout); 396 397 print "\n"; 398 print $timeout 399 ? loc("The network timeout for downloads is %1 seconds.", $timeout) 400 : loc("The network timeout for downloads is not set."); 401 print "\n"; 402 403 ############################ 404 ## where can I reach you? ## 405 ############################ 406 407 print loc(" 408 What email address should we send as our anonymous password when 409 fetching modules from CPAN servers? Some servers will NOT allow you to 410 connect without a valid email address, or at least something that looks 411 like one. 412 Also, if you choose to report test results at some point, a valid email 413 is required for the 'from' field, so choose wisely. 414 415 "); 416 417 my $other = 'Something else'; 418 my @choices = (DEFAULT_EMAIL, $Config{cf_email}, $other); 419 my $current = $conf->get_conf('email'); 420 421 ### if your current address is not in the list, add it to the choices 422 unless (grep { $_ eq $current } @choices) { 423 unshift @choices, $current; 424 } 425 426 my $email = $term->get_reply( 427 prompt => loc('Which email address shall I use?'), 428 default => $current || $choices[0], 429 choices => \@choices, 430 ); 431 432 if( $email eq $other ) { 433 EMAIL: { 434 $email = $term->get_reply( 435 prompt => loc('Email address: '), 436 ); 437 438 unless( $self->_valid_email($email) ) { 439 print loc(" 440 You did not enter a valid email address, please try again! 441 ") if length $email; 442 443 redo EMAIL; 444 } 445 } 446 } 447 448 print loc(" 449 Your 'email' is now: 450 %1 451 452 ", $email); 453 454 $conf->set_conf( email => $email ); 455 456 return 1; 457 } 458 459 460 ### commandline programs 461 sub _setup_program { 462 my $self = shift; 463 my $term = $self->term; 464 my $conf = $self->configure_object; 465 466 print loc(" 467 CPANPLUS can use command line utilities to do certain 468 tasks, rather than use perl modules. 469 470 If you wish to use a certain command utility, just enter 471 the full path (or accept the default). If you do not wish 472 to use it, enter a single space. 473 474 Note that the paths you provide should not contain spaces, which is 475 needed to make a distinction between program name and options to that 476 program. For Win32 machines, you can use the short name for a path, 477 like '%1'. 478 ", 'c:\Progra~1\prog.exe' ); 479 480 for my $prog ( sort $conf->options( type => 'program') ) { 481 PROGRAM: { 482 print "\n", loc("Where can I find your '%1' utility? ". 483 "(Enter a single space to disable)", $prog ), "\n"; 484 485 my $loc = $term->get_reply( 486 prompt => "Path to your '$prog'", 487 default => $conf->get_program( $prog ), 488 ); 489 490 ### empty line clears it 491 my $cmd = $loc =~ /^\s*$/ ? undef : $loc; 492 my ($bin) = $cmd =~ /^(\S+)/; 493 494 ### did you provide a valid program ? 495 if( $bin and not can_run( $bin ) ) { 496 print "\n"; 497 print loc("Can not find the binary '%1' in your path!", $bin); 498 redo PROGRAM; 499 } 500 501 ### make is special -- we /need/ it! 502 if( $prog eq 'make' and not $bin ) { 503 print loc( 504 "==> Without your '%1' utility, I can not function! <==", 505 'make' 506 ); 507 print loc("Please provide one!"); 508 509 ### show win32 where to download 510 if ( $^O eq 'MSWin32' ) { 511 print loc("You can get '%1' from:", NMAKE); 512 print "\t". NMAKE_URL ."\n"; 513 } 514 print "\n"; 515 redo PROGRAM; 516 } 517 518 $conf->set_program( $prog => $cmd ); 519 print $cmd 520 ? loc( "Your '%1' utility has been set to '%2'.", 521 $prog, $cmd ) 522 : loc( "Your '%1' has been disabled.", $prog ); 523 print "\n"; 524 } 525 } 526 527 return 1; 528 } 529 530 sub _setup_installer { 531 my $self = shift; 532 my $term = $self->term; 533 my $conf = $self->configure_object; 534 535 my $none = 'None'; 536 { 537 print loc(" 538 CPANPLUS uses binary programs as well as Perl modules to accomplish 539 various tasks. Normally, CPANPLUS will prefer the use of Perl modules 540 over binary programs. 541 542 You can change this setting by making CPANPLUS prefer the use of 543 certain binary programs if they are available. 544 545 "); 546 547 ### default to using binaries if we don't have compress::zlib only 548 ### -- it'll get very noisy otherwise 549 my $type = 'prefer_bin'; 550 my $yn = $term->ask_yn( 551 prompt => loc("Should I prefer the use of binary programs?"), 552 default => $conf->get_conf( $type ), 553 ); 554 555 print $yn 556 ? loc("Ok, I will prefer to use binary programs if possible.") 557 : loc("Ok, I will prefer to use Perl modules if possible."); 558 print "\n\n"; 559 560 561 $conf->set_conf( $type => $yn ); 562 } 563 564 { 565 print loc(" 566 Makefile.PL is run by perl in a separate process, and accepts various 567 flags that controls the module's installation. For instance, if you 568 would like to install modules to your private user directory, set 569 'makemakerflags' to: 570 571 LIB=~/perl/lib INSTALLMAN1DIR=~/perl/man/man1 INSTALLMAN3DIR=~/perl/man/man3 572 573 and be sure that you do NOT set UNINST=1 in 'makeflags' below. 574 575 Enter a name=value list separated by whitespace, but quote any embedded 576 spaces that you want to preserve. (Enter a space to clear any existing 577 settings.) 578 579 If you don't understand this question, just press ENTER. 580 581 "); 582 583 my $type = 'makemakerflags'; 584 my $flags = $term->get_reply( 585 prompt => 'Makefile.PL flags?', 586 default => $conf->get_conf($type), 587 ); 588 589 $flags = '' if $flags eq $none || $flags !~ /\S/; 590 591 print "\n", loc("Your '%1' have been set to:", 'Makefile.PL flags'), 592 "\n ", ( $flags ? $flags : loc('*nothing entered*')), 593 "\n\n"; 594 595 $conf->set_conf( $type => $flags ); 596 } 597 598 { 599 print loc(" 600 Like Makefile.PL, we run 'make' and 'make install' as separate processes. 601 If you have any parameters (e.g. '-j3' in dual processor systems) you want 602 to pass to the calls, please specify them here. 603 604 In particular, 'UNINST=1' is recommended for root users, unless you have 605 fine-tuned ideas of where modules should be installed in the \@INC path. 606 607 Enter a name=value list separated by whitespace, but quote any embedded 608 spaces that you want to preserve. (Enter a space to clear any existing 609 settings.) 610 611 Again, if you don't understand this question, just press ENTER. 612 613 "); 614 my $type = 'makeflags'; 615 my $flags = $term->get_reply( 616 prompt => 'make flags?', 617 default => $conf->get_conf($type), 618 ); 619 620 $flags = '' if $flags eq $none || $flags !~ /\S/; 621 622 print "\n", loc("Your '%1' have been set to:", $type), 623 "\n ", ( $flags ? $flags : loc('*nothing entered*')), 624 "\n\n"; 625 626 $conf->set_conf( $type => $flags ); 627 } 628 629 { 630 print loc(" 631 An alternative to ExtUtils::MakeMaker and Makefile.PL there's a module 632 called Module::Build which uses a Build.PL. 633 634 If you would like to specify any flags to pass when executing the 635 Build.PL (and Build) script, please enter them below. 636 637 For instance, if you would like to install modules to your private 638 user directory, you could enter: 639 640 install_base=/my/private/path 641 642 Or to uninstall old copies of modules before updating, you might 643 want to enter: 644 645 uninst=1 646 647 Again, if you don't understand this question, just press ENTER. 648 649 "); 650 651 my $type = 'buildflags'; 652 my $flags = $term->get_reply( 653 prompt => 'Build.PL and Build flags?', 654 default => $conf->get_conf($type), 655 ); 656 657 $flags = '' if $flags eq $none || $flags !~ /\S/; 658 659 print "\n", loc("Your '%1' have been set to:", 660 'Build.PL and Build flags'), 661 "\n ", ( $flags ? $flags : loc('*nothing entered*')), 662 "\n\n"; 663 664 $conf->set_conf( $type => $flags ); 665 } 666 667 ### use EU::MM or module::build? ### 668 { 669 print loc(" 670 Some modules provide both a Build.PL (Module::Build) and a Makefile.PL 671 (ExtUtils::MakeMaker). By default, CPANPLUS prefers Makefile.PL. 672 673 Module::Build support is not bundled standard with CPANPLUS, but 674 requires you to install 'CPANPLUS::Dist::Build' from CPAN. 675 676 Although Module::Build is a pure perl solution, which means you will 677 not need a 'make' binary, it does have some limitations. The most 678 important is that CPANPLUS is unable to uninstall any modules installed 679 by Module::Build. 680 681 Again, if you don't understand this question, just press ENTER. 682 683 "); 684 my $type = 'prefer_makefile'; 685 my $yn = $term->ask_yn( 686 prompt => loc("Prefer Makefile.PL over Build.PL?"), 687 default => $conf->get_conf($type), 688 ); 689 690 $conf->set_conf( $type => $yn ); 691 } 692 693 { 694 print loc(' 695 If you like, CPANPLUS can add extra directories to your @INC list during 696 startup. These will just be used by CPANPLUS and will not change your 697 external environment or perl interpreter. Enter a space separated list of 698 pathnames to be added to your @INC, quoting any with embedded whitespace. 699 (To clear the current value enter a single space.) 700 701 '); 702 703 my $type = 'lib'; 704 my $flags = $term->get_reply( 705 prompt => loc('Additional @INC directories to add?'), 706 default => (join " ", @{$conf->get_conf($type) || []} ), 707 ); 708 709 my $lib; 710 unless( $flags =~ /\S/ ) { 711 $lib = []; 712 } else { 713 (@$lib) = $flags =~ m/\s*("[^"]+"|'[^']+'|[^\s]+)/g; 714 } 715 716 print "\n", loc("Your additional libs are now:"), "\n"; 717 718 print scalar @$lib 719 ? map { " $_\n" } @$lib 720 : " ", loc("*nothing entered*"), "\n"; 721 print "\n\n"; 722 723 $conf->set_conf( $type => $lib ); 724 } 725 726 return 1; 727 } 728 729 730 sub _setup_conf { 731 my $self = shift; 732 my $term = $self->term; 733 my $conf = $self->configure_object; 734 735 my $none = 'None'; 736 { 737 ############ 738 ## noisy? ## 739 ############ 740 741 print loc(" 742 In normal operation I can just give you basic information about what I 743 am doing, or I can be more verbose and give you every little detail. 744 745 "); 746 747 my $type = 'verbose'; 748 my $yn = $term->ask_yn( 749 prompt => loc("Should I be verbose?"), 750 default => $conf->get_conf( $type ), ); 751 752 print "\n"; 753 print $yn 754 ? loc("You asked for it!") 755 : loc("I'll try to be quiet"); 756 757 $conf->set_conf( $type => $yn ); 758 } 759 760 { 761 ####################### 762 ## flush you animal! ## 763 ####################### 764 765 print loc(" 766 In the interest of speed, we keep track of what modules were installed 767 successfully and which failed in the current session. We can flush this 768 data automatically, or you can explicitly issue a 'flush' when you want 769 to purge it. 770 771 "); 772 773 my $type = 'flush'; 774 my $yn = $term->ask_yn( 775 prompt => loc("Flush automatically?"), 776 default => $conf->get_conf( $type ), 777 ); 778 779 print "\n"; 780 print $yn 781 ? loc("I'll flush after every full module install.") 782 : loc("I won't flush until you tell me to."); 783 784 $conf->set_conf( $type => $yn ); 785 } 786 787 { 788 ##################### 789 ## force installs? ## 790 ##################### 791 792 print loc(" 793 Usually, when a test fails, I won't install the module, but if you 794 prefer, I can force the install anyway. 795 796 "); 797 798 my $type = 'force'; 799 my $yn = $term->ask_yn( 800 prompt => loc("Force installs?"), 801 default => $conf->get_conf( $type ), 802 ); 803 804 print "\n"; 805 print $yn 806 ? loc("I will force installs.") 807 : loc("I won't force installs."); 808 809 $conf->set_conf( $type => $yn ); 810 } 811 812 { 813 ################### 814 ## about prereqs ## 815 ################### 816 817 print loc(" 818 Sometimes a module will require other modules to be installed before it 819 will work. CPANPLUS can attempt to install these for you automatically 820 if you like, or you can do the deed yourself. 821 822 If you would prefer that we NEVER try to install extra modules 823 automatically, select NO. (Usually you will want this set to YES.) 824 825 If you would like to build modules to satisfy testing or prerequisites, 826 but not actually install them, select BUILD. 827 828 NOTE: This feature requires you to flush the 'lib' cache for longer 829 running programs (refer to the CPANPLUS::Backend documentations for 830 more details). 831 832 Otherwise, select ASK to have us ask your permission to install them. 833 834 "); 835 836 my $type = 'prereqs'; 837 838 my @map = ( 839 [ PREREQ_IGNORE, # conf value 840 loc('No, do not install prerequisites'), # UI Value 841 loc("I won't install prerequisites") # diag message 842 ], 843 [ PREREQ_INSTALL, 844 loc('Yes, please install prerequisites'), 845 loc("I will install prerequisites") 846 ], 847 [ PREREQ_ASK, 848 loc('Ask me before installing a prerequisite'), 849 loc("I will ask permission to install") 850 ], 851 [ PREREQ_BUILD, 852 loc('Build prerequisites, but do not install them'), 853 loc( "I will only build, but not install prerequisites" ) 854 ], 855 ); 856 857 my %reply = map { $_->[1] => $_->[0] } @map; # choice => value 858 my %diag = map { $_->[1] => $_->[2] } @map; # choice => diag message 859 my %conf = map { $_->[0] => $_->[1] } @map; # value => ui choice 860 861 my $reply = $term->get_reply( 862 prompt => loc('Follow prerequisites?'), 863 default => $conf{ $conf->get_conf( $type ) }, 864 choices => [ @conf{ sort keys %conf } ], 865 ); 866 print "\n"; 867 868 my $value = $reply{ $reply }; 869 my $diag = $diag{ $reply }; 870 871 $conf->set_conf( $type => $value ); 872 print $diag, "\n"; 873 } 874 875 { print loc(" 876 Modules in the CPAN archives are protected with md5 checksums. 877 878 This requires the Perl module Digest::MD5 to be installed (which 879 CPANPLUS can do for you later); 880 881 "); 882 my $type = 'md5'; 883 884 my $yn = $term->ask_yn( 885 prompt => loc("Shall I use the MD5 checksums?"), 886 default => $conf->get_conf( $type ), 887 ); 888 889 print $yn 890 ? loc("I will use the MD5 checksums if you have it") 891 : loc("I won't use the MD5 checksums"); 892 893 $conf->set_conf( $type => $yn ); 894 895 } 896 897 898 { ########################################### 899 ## sally sells seashells by the seashore ## 900 ########################################### 901 902 print loc(" 903 By default CPANPLUS uses its own shell when invoked. If you would prefer 904 a different shell, such as one you have written or otherwise acquired, 905 please enter the full name for your shell module. 906 907 "); 908 909 my $type = 'shell'; 910 my $other = 'Other'; 911 my @choices = (qw| CPANPLUS::Shell::Default 912 CPANPLUS::Shell::Classic |, 913 $other ); 914 my $default = $conf->get_conf($type); 915 916 unshift @choices, $default unless grep { $_ eq $default } @choices; 917 918 my $reply = $term->get_reply( 919 prompt => loc('Which CPANPLUS shell do you want to use?'), 920 default => $default, 921 choices => \@choices, 922 ); 923 924 if( $reply eq $other ) { 925 SHELL: { 926 $reply = $term->get_reply( 927 prompt => loc( 'Please enter the name of the shell '. 928 'you wish to use: '), 929 ); 930 931 unless( check_install( module => $reply ) ) { 932 print "\n", 933 loc("Could not find '$reply' in your path " . 934 "-- please try again"), 935 "\n"; 936 redo SHELL; 937 } 938 } 939 } 940 941 print "\n", loc("Your shell is now: %1", $reply), "\n\n"; 942 943 $conf->set_conf( $type => $reply ); 944 } 945 946 { 947 ################### 948 ## use storable? ## 949 ################### 950 951 print loc(" 952 To speed up the start time of CPANPLUS, and maintain a cache over 953 multiple runs, we can use Storable to freeze some information. 954 Would you like to do this? 955 956 "); 957 my $type = 'storable'; 958 my $yn = $term->ask_yn( 959 prompt => loc("Use Storable?"), 960 default => $conf->get_conf( $type ) ? 1 : 0, 961 ); 962 print "\n"; 963 print $yn 964 ? loc("I will use Storable if you have it") 965 : loc("I will not use Storable"); 966 967 $conf->set_conf( $type => $yn ); 968 } 969 970 { 971 ################### 972 ## use cpantest? ## 973 ################### 974 975 print loc(" 976 CPANPLUS has support for the Test::Reporter module, which can be utilized 977 to report success and failures of modules installed by CPANPLUS. Would 978 you like to do this? Note that you will still be prompted before 979 sending each report. 980 981 If you don't have all the required modules installed yet, you should 982 consider installing '%1' 983 984 This package bundles all the required modules to enable test reporting 985 and querying from CPANPLUS. 986 You can do so straight after this installation. 987 988 ", 'Bundle::CPANPLUS::Test::Reporter'); 989 990 my $type = 'cpantest'; 991 my $yn = $term->ask_yn( 992 prompt => loc('Report test results?'), 993 default => $conf->get_conf( $type ) ? 1 : 0, 994 ); 995 996 print "\n"; 997 print $yn 998 ? loc("I will prompt you to report test results") 999 : loc("I won't prompt you to report test results"); 1000 1001 $conf->set_conf( $type => $yn ); 1002 } 1003 1004 { 1005 ################################### 1006 ## use cryptographic signatures? ## 1007 ################################### 1008 1009 print loc(" 1010 The Module::Signature extension allows CPAN authors to sign their 1011 distributions using PGP signatures. Would you like to check for 1012 module's cryptographic integrity before attempting to install them? 1013 Note that this requires either the 'gpg' utility or Crypt::OpenPGP 1014 to be installed. 1015 1016 "); 1017 my $type = 'signature'; 1018 1019 my $yn = $term->ask_yn( 1020 prompt => loc('Shall I check module signatures?'), 1021 default => $conf->get_conf($type) ? 1 : 0, 1022 ); 1023 1024 print "\n"; 1025 print $yn 1026 ? loc("Ok, I will attempt to check module signatures.") 1027 : loc("Ok, I won't attempt to check module signatures."); 1028 1029 $conf->set_conf( $type => $yn ); 1030 } 1031 1032 return 1; 1033 } 1034 1035 sub _setup_hosts { 1036 my $self = shift; 1037 my $term = $self->term; 1038 my $conf = $self->configure_object; 1039 1040 1041 if( scalar @{ $conf->get_conf('hosts') } ) { 1042 1043 my $hosts; 1044 for my $href ( @{$conf->get_conf('hosts')} ) { 1045 $hosts .= "\t$href->{scheme}://$href->{host}$href->{path}\n"; 1046 } 1047 1048 print loc(" 1049 I see you already have some hosts selected: 1050 1051 $hosts 1052 1053 If you'd like to stick with your current settings, just select 'Yes'. 1054 Otherwise, select 'No' and you can reconfigure your hosts 1055 1056 "); 1057 my $yn = $term->ask_yn( 1058 prompt => loc("Would you like to keep your current hosts?"), 1059 default => 'y', 1060 ); 1061 return 1 if $yn; 1062 } 1063 1064 my @hosts; 1065 MAIN: { 1066 1067 print loc(" 1068 Now we need to know where your favorite CPAN sites are located. Make a 1069 list of a few sites (just in case the first on the array won't work). 1070 1071 If you are mirroring CPAN to your local workstation, specify a file: 1072 URI by picking the CUSTOM option. 1073 1074 Otherwise, let us fetch the official CPAN mirror list and you can pick 1075 the mirror that suits you best from a list by using the MIRROR option; 1076 First, pick a nearby continent and country. Then, you will be presented 1077 with a list of URLs of CPAN mirrors in the country you selected. Select 1078 one or more of those URLs. 1079 1080 Note, the latter option requires a working net connection. 1081 1082 You can select VIEW to see your current selection and QUIT when you 1083 are done. 1084 1085 "); 1086 1087 my $reply = $term->get_reply( 1088 prompt => loc('Please choose an option'), 1089 choices => [qw|Mirror Custom View Quit|], 1090 default => 'Mirror', 1091 ); 1092 1093 goto MIRROR if $reply eq 'Mirror'; 1094 goto CUSTOM if $reply eq 'Custom'; 1095 goto QUIT if $reply eq 'Quit'; 1096 1097 $self->_view_hosts(@hosts) if $reply eq 'View'; 1098 redo MAIN; 1099 } 1100 1101 my $mirror_file; 1102 my $hosts; 1103 MIRROR: { 1104 $mirror_file ||= $self->_get_mirrored_by or return; 1105 $hosts ||= $self->_parse_mirrored_by($mirror_file) or return; 1106 1107 my ($continent, $country, $host) = $self->_guess_from_timezone( $hosts ); 1108 1109 CONTINENT: { 1110 my %seen; 1111 my @choices = sort map { 1112 $_->{'continent'} 1113 } grep { 1114 not $seen{$_->{'continent'}}++ 1115 } values %$hosts; 1116 push @choices, qw[Custom Up Quit]; 1117 1118 my $reply = $term->get_reply( 1119 prompt => loc('Pick a continent'), 1120 default => $continent, 1121 choices => \@choices, 1122 ); 1123 1124 goto MAIN if $reply eq 'Up'; 1125 goto CUSTOM if $reply eq 'Custom'; 1126 goto QUIT if $reply eq 'Quit'; 1127 1128 $continent = $reply; 1129 } 1130 1131 COUNTRY: { 1132 my %seen; 1133 my @choices = sort map { 1134 $_->{'country'} 1135 } grep { 1136 not $seen{$_->{'country'}}++ 1137 } grep { 1138 ($_->{'continent'} eq $continent) 1139 } values %$hosts; 1140 push @choices, qw[Custom Up Quit]; 1141 1142 my $reply = $term->get_reply( 1143 prompt => loc('Pick a country'), 1144 default => $country, 1145 choices => \@choices, 1146 ); 1147 1148 goto CONTINENT if $reply eq 'Up'; 1149 goto CUSTOM if $reply eq 'Custom'; 1150 goto QUIT if $reply eq 'Quit'; 1151 1152 $country = $reply; 1153 } 1154 1155 HOST: { 1156 my @list = grep { 1157 $_->{'continent'} eq $continent and 1158 $_->{'country'} eq $country 1159 } values %$hosts; 1160 1161 my %map; my $default; 1162 for my $href (@list) { 1163 for my $con ( @{$href->{'connections'}} ) { 1164 next unless length $con->{'host'}; 1165 1166 my $entry = $con->{'scheme'} . '://' . $con->{'host'}; 1167 $default = $entry if $con->{'host'} eq $host; 1168 1169 $map{$entry} = $con; 1170 } 1171 } 1172 1173 CHOICE: { 1174 1175 ### doesn't play nice with Term::UI :( 1176 ### should make t::ui figure out pager opens 1177 #$self->_pager_open; # host lists might be long 1178 1179 print loc(" 1180 You can enter multiple sites by seperating them by a space. 1181 For example: 1182 1 4 2 5 1183 "); 1184 1185 my @reply = $term->get_reply( 1186 prompt => loc('Please pick a site: '), 1187 choices => [sort(keys %map), 1188 qw|Custom View Up Quit|], 1189 default => $default, 1190 multi => 1, 1191 ); 1192 #$self->_pager_close; 1193 1194 1195 goto COUNTRY if grep { $_ eq 'Up' } @reply; 1196 goto CUSTOM if grep { $_ eq 'Custom' } @reply; 1197 goto QUIT if grep { $_ eq 'Quit' } @reply; 1198 1199 ### add the host, but only if it's not on the stack already ### 1200 unless( grep { $_ eq 'View' } @reply ) { 1201 for my $reply (@reply) { 1202 if( grep { $_ eq $map{$reply} } @hosts ) { 1203 print loc("Host '%1' already selected", $reply); 1204 print "\n\n"; 1205 } else { 1206 push @hosts, $map{$reply} 1207 } 1208 } 1209 } 1210 1211 $self->_view_hosts(@hosts); 1212 1213 goto QUIT if $self->autoreply; 1214 redo CHOICE; 1215 } 1216 } 1217 } 1218 1219 CUSTOM: { 1220 print loc(" 1221 If there are any additional URLs you would like to use, please add them 1222 now. You may enter them separately or as a space delimited list. 1223 1224 We provide a default fall-back URL, but you are welcome to override it 1225 with e.g. 'http://www.cpan.org/' if LWP, wget or curl is installed. 1226 1227 (Enter a single space when you are done, or to simply skip this step.) 1228 1229 Note that if you want to use a local depository, you will have to enter 1230 as follows: 1231 1232 file://server/path/to/cpan 1233 1234 if the file is on a server on your local network or as: 1235 1236 file:///path/to/cpan 1237 1238 if the file is on your local disk. Note the three /// after the file: bit 1239 1240 "); 1241 1242 CHOICE: { 1243 my $reply = $term->get_reply( 1244 prompt => loc("Additionals host(s) to add: "), 1245 default => '', 1246 ); 1247 1248 last CHOICE unless $reply =~ /\S/; 1249 1250 my $href = $self->_parse_host($reply); 1251 1252 if( $href ) { 1253 push @hosts, $href 1254 unless grep { 1255 $href->{'scheme'} eq $_->{'scheme'} and 1256 $href->{'host'} eq $_->{'host'} and 1257 $href->{'path'} eq $_->{'path'} 1258 } @hosts; 1259 1260 last CHOICE if $self->autoreply; 1261 } else { 1262 print loc("Invalid uri! Please try again!"); 1263 } 1264 1265 $self->_view_hosts(@hosts); 1266 1267 redo CHOICE; 1268 } 1269 1270 DONE: { 1271 1272 print loc(" 1273 Where would you like to go now? 1274 1275 Please pick one of the following options or Quit when you are done 1276 1277 "); 1278 my $answer = $term->get_reply( 1279 prompt => loc("Where to now?"), 1280 default => 'Quit', 1281 choices => [qw|Mirror Custom View Quit|], 1282 ); 1283 1284 if( $answer eq 'View' ) { 1285 $self->_view_hosts(@hosts); 1286 redo DONE; 1287 } 1288 1289 goto MIRROR if $answer eq 'Mirror'; 1290 goto CUSTOM if $answer eq 'Custom'; 1291 goto QUIT if $answer eq 'Quit'; 1292 } 1293 } 1294 1295 QUIT: { 1296 $conf->set_conf( hosts => \@hosts ); 1297 1298 print loc(" 1299 Your host configuration has been saved 1300 1301 "); 1302 } 1303 1304 return 1; 1305 } 1306 1307 sub _view_hosts { 1308 my $self = shift; 1309 my @hosts = @_; 1310 1311 print "\n\n"; 1312 1313 if( scalar @hosts ) { 1314 my $i = 1; 1315 for my $host (@hosts) { 1316 1317 ### show full path on file uris, otherwise, just show host 1318 my $path = join '', ( 1319 $host->{'scheme'} eq 'file' 1320 ? ( ($host->{'host'} || '[localhost]'), 1321 $host->{path} ) 1322 : $host->{'host'} 1323 ); 1324 1325 printf "%-40s %30s\n", 1326 loc("Selected %1",$host->{'scheme'} . '://' . $path ), 1327 loc("%quant(%2,host) selected thus far.", $i); 1328 $i++; 1329 } 1330 } else { 1331 print loc("No hosts selected so far."); 1332 } 1333 1334 print "\n\n"; 1335 1336 return 1; 1337 } 1338 1339 sub _get_mirrored_by { 1340 my $self = shift; 1341 my $cpan = $self->backend; 1342 my $conf = $self->configure_object; 1343 1344 print loc(" 1345 Now, we are going to fetch the mirror list for first-time configurations. 1346 This may take a while... 1347 1348 "); 1349 1350 ### use the enew configuratoin ### 1351 $cpan->configure_object( $conf ); 1352 1353 load CPANPLUS::Module::Fake; 1354 load CPANPLUS::Module::Author::Fake; 1355 1356 my $mb = CPANPLUS::Module::Fake->new( 1357 module => $conf->_get_source('hosts'), 1358 path => '', 1359 package => $conf->_get_source('hosts'), 1360 author => CPANPLUS::Module::Author::Fake->new( 1361 _id => $cpan->_id ), 1362 _id => $cpan->_id, 1363 ); 1364 1365 my $file = $cpan->_fetch( fetchdir => $conf->get_conf('base'), 1366 module => $mb ); 1367 1368 return $file if $file; 1369 return; 1370 } 1371 1372 sub _parse_mirrored_by { 1373 my $self = shift; 1374 my $file = shift; 1375 1376 -s $file or return; 1377 1378 my $fh = new FileHandle; 1379 $fh->open("$file") 1380 or ( 1381 warn(loc('Could not open file "%1": %2', $file, $!)), 1382 return 1383 ); 1384 1385 ### slurp the file in ### 1386 { local $/; $file = <$fh> } 1387 1388 ### remove comments ### 1389 $file =~ s/#.*$//gm; 1390 1391 $fh->close; 1392 1393 ### sample host entry ### 1394 # ftp.sun.ac.za: 1395 # frequency = "daily" 1396 # dst_ftp = "ftp://ftp.sun.ac.za/CPAN/CPAN/" 1397 # dst_location = "Stellenbosch, South Africa, Africa (-26.1992 28.0564)" 1398 # dst_organisation = "University of Stellenbosch" 1399 # dst_timezone = "+2" 1400 # dst_contact = "ftpadm@ftp.sun.ac.za" 1401 # dst_src = "ftp.funet.fi" 1402 # 1403 # # dst_dst = "ftp://ftp.sun.ac.za/CPAN/CPAN/" 1404 # # dst_contact = "mailto:ftpadm@ftp.sun.ac.za 1405 # # dst_src = "ftp.funet.fi" 1406 1407 ### host name as key, rest of the entry as value ### 1408 my %hosts = $file =~ m/([a-zA-Z0-9\-\.]+):\s+((?:\w+\s+=\s+".*?"\s+)+)/gs; 1409 1410 while (my($host,$data) = each %hosts) { 1411 1412 my $href; 1413 map { 1414 s/^\s*//; 1415 my @a = split /\s*=\s*/; 1416 $a[1] =~ s/^"(.+?)"$/$1/g; 1417 $href->{ pop @a } = pop @a; 1418 } grep /\S/, split /\n/, $data; 1419 1420 ($href->{city_area}, $href->{country}, $href->{continent}, 1421 $href->{latitude}, $href->{longitude} ) = 1422 $href->{dst_location} =~ 1423 m/ 1424 #Aizu-Wakamatsu, Tohoku-chiho, Fukushima 1425 ^"?( 1426 (?:[^,]+?)\s* # city 1427 (?: 1428 (?:,\s*[^,]+?)\s* # optional area 1429 )*? # some have multiple areas listed 1430 ) 1431 1432 #Japan 1433 ,\s*([^,]+?)\s* # country 1434 1435 #Asia 1436 ,\s*([^,]+?)\s* # continent 1437 1438 # (37.4333 139.9821) 1439 \((\S+)\s+(\S+?)\)"?$ # (latitude longitude) 1440 /sx; 1441 1442 ### parse the different hosts, store them in config format ### 1443 my @list; 1444 1445 for my $type (qw[dst_ftp dst_rsync dst_http]) { 1446 my $path = $href->{$type}; 1447 next unless $path =~ /\w/; 1448 if ($type eq 'dst_rsync' && $path !~ /^rsync:/) { 1449 $path =~ s{::}{/}; 1450 $path = "rsync://$path/"; 1451 } 1452 my $parts = $self->_parse_host($path); 1453 push @list, $parts; 1454 } 1455 1456 $href->{connections} = \@list; 1457 $hosts{$host} = $href; 1458 } 1459 1460 return \%hosts; 1461 } 1462 1463 sub _parse_host { 1464 my $self = shift; 1465 my $host = shift; 1466 1467 my @parts = $host =~ m|^(\w*)://([^/]*)(/.*)$|s; 1468 1469 my $href; 1470 for my $key (qw[scheme host path]) { 1471 $href->{$key} = shift @parts; 1472 } 1473 1474 return if lc($href->{'scheme'}) ne 'file' and !$href->{'host'}; 1475 return if !$href->{'path'}; 1476 1477 return $href; 1478 } 1479 1480 ## tries to figure out close hosts based on your timezone 1481 ## 1482 ## Currently can only report on unique items for each of zones, countries, and 1483 ## sites. In the future this will be combined with something else (perhaps a 1484 ## ping?) to narrow down multiple choices. 1485 ## 1486 ## Tries to return the best zone, country, and site for your location. Any non- 1487 ## unique items will be set to undef instead. 1488 ## 1489 ## (takes hashref, returns array) 1490 ## 1491 sub _guess_from_timezone { 1492 my $self = shift; 1493 my $hosts = shift; 1494 my (%zones, %countries, %sites); 1495 1496 ### autrijus - build time zone table 1497 my %freq_weight = ( 1498 'hourly' => 2400, 1499 '4 times a day' => 400, 1500 '4x daily' => 400, 1501 'daily' => 100, 1502 'twice daily' => 50, 1503 'weekly' => 15, 1504 ); 1505 1506 while (my ($site, $host) = each %{$hosts}) { 1507 my ($zone, $continent, $country, $frequency) = 1508 @{$host}{qw/dst_timezone continent country frequency/}; 1509 1510 1511 # skip non-well-formed ones 1512 next unless $continent and $country and $zone =~ /^[-+]?\d+(?::30)?/; 1513 ### fix style 1514 chomp $zone; 1515 $zone =~ s/:30/.5/; 1516 $zone =~ s/^\+//; 1517 $zone =~ s/"//g; 1518 1519 $zones{$zone}{$continent}++; 1520 $countries{$zone}{$continent}{$country}++; 1521 $sites{$zone}{$continent}{$country}{$site} = $freq_weight{$frequency}; 1522 } 1523 1524 use Time::Local; 1525 my $offset = ((timegm(localtime) - timegm(gmtime)) / 3600); 1526 1527 local $_; 1528 1529 ## pick the entry with most country/site/frequency, one level each; 1530 ## note it has to be sorted -- otherwise we're depending on the hash order. 1531 ## also, the list context assignment (pick first one) is deliberate. 1532 1533 my ($continent) = map { 1534 (sort { ($_->{$b} <=> $_->{$a}) or $b cmp $a } keys(%{$_})) 1535 } $zones{$offset}; 1536 1537 my ($country) = map { 1538 (sort { ($_->{$b} <=> $_->{$a}) or $b cmp $a } keys(%{$_})) 1539 } $countries{$offset}{$continent}; 1540 1541 my ($site) = map { 1542 (sort { ($_->{$b} <=> $_->{$a}) or $b cmp $a } keys(%{$_})) 1543 } $sites{$offset}{$continent}{$country}; 1544 1545 return ($continent, $country, $site); 1546 } # _guess_from_timezone 1547 1548 1549 ### big big regex, stolen to check if you enter a valid address 1550 { 1551 my $RFC822PAT; # RFC pattern to match for valid email address 1552 1553 sub _valid_email { 1554 my $self = shift; 1555 if (!$RFC822PAT) { 1556 my $esc = '\\\\'; my $Period = '\.'; my $space = '\040'; 1557 my $tab = '\t'; my $OpenBR = '\['; my $CloseBR = '\]'; 1558 my $OpenParen = '\('; my $CloseParen = '\)'; my $NonASCII = '\x80-\xff'; 1559 my $ctrl = '\000-\037'; my $CRlist = '\012\015'; 1560 1561 my $qtext = qq/[^$esc$NonASCII$CRlist\"]/; 1562 my $dtext = qq/[^$esc$NonASCII$CRlist$OpenBR$CloseBR]/; 1563 my $quoted_pair = qq< $esc [^$NonASCII] >; # an escaped character 1564 my $ctext = qq< [^$esc$NonASCII$CRlist()] >; 1565 my $Cnested = qq< $OpenParen $ctext* (?: $quoted_pair $ctext* )* $CloseParen >; 1566 my $comment = qq< $OpenParen $ctext* (?: (?: $quoted_pair | $Cnested ) $ctext* )* $CloseParen >; 1567 my $X = qq< [$space$tab]* (?: $comment [$space$tab]* )* >; 1568 my $atom_char = qq/[^($space)<>\@,;:\".$esc$OpenBR$CloseBR$ctrl$NonASCII]/; 1569 my $atom = qq< $atom_char+ (?!$atom_char) >; 1570 my $quoted_str = qq< \" $qtext * (?: $quoted_pair $qtext * )* \" >; 1571 my $word = qq< (?: $atom | $quoted_str ) >; 1572 my $domain_ref = $atom; 1573 my $domain_lit = qq< $OpenBR (?: $dtext | $quoted_pair )* $CloseBR >; 1574 my $sub_domain = qq< (?: $domain_ref | $domain_lit) $X >; 1575 my $domain = qq< $sub_domain (?: $Period $X $sub_domain)* >; 1576 my $route = qq< \@ $X $domain (?: , $X \@ $X $domain )* : $X >; 1577 my $local_part = qq< $word $X (?: $Period $X $word $X )* >; 1578 my $addr_spec = qq< $local_part \@ $X $domain >; 1579 my $route_addr = qq[ < $X (?: $route )? $addr_spec > ]; 1580 my $phrase_ctrl = '\000-\010\012-\037'; # like ctrl, but without tab 1581 my $phrase_char = qq/[^()<>\@,;:\".$esc$OpenBR$CloseBR$NonASCII$phrase_ctrl]/; 1582 my $phrase = qq< $word $phrase_char * (?: (?: $comment | $quoted_str ) $phrase_char * )* >; 1583 $RFC822PAT = qq< $X (?: $addr_spec | $phrase $route_addr) >; 1584 } 1585 1586 return scalar ($_[0] =~ /$RFC822PAT/ox); 1587 } 1588 } 1589 1590 1591 1592 1593 1594 1595 1; 1596 1597 1598 sub _edit { 1599 my $self = shift; 1600 my $conf = $self->configure_object; 1601 my $file = shift || $conf->_config_pm_to_file( $self->config_type ); 1602 my $editor = shift || $conf->get_program('editor'); 1603 my $term = $self->term; 1604 1605 unless( $editor ) { 1606 print loc(" 1607 I'm sorry, I can't find a suitable editor, so I can't offer you 1608 post-configuration editing of the config file 1609 1610 "); 1611 return 1; 1612 } 1613 1614 ### save the thing first, so there's something to edit 1615 $self->_save; 1616 1617 return !system("$editor $file"); 1618 } 1619 1620 sub _save { 1621 my $self = shift; 1622 my $conf = $self->configure_object; 1623 1624 return $conf->save( $self->config_type ); 1625 } 1626 1627 1;
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 |