lib/CPAN/HandleConfig.pm

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