view release on metacpan or  search on metacpan

lib/CPAN/HandleConfig.pm  view on Meta::CPAN

                                     )
                                );
    } elsif (defined $v) {
        $CPAN::Frontend->myprint(sprintf "    %-18s [%s]\n", $k, $v);
    } else {
        $CPAN::Frontend->myprint(sprintf "    %-18s undef\n", $k);
    }
}

# generally, this should be called without arguments so that the currently
# loaded config file is where changes are committed.
sub commit {
    my($self,@args) = @_;
    CPAN->debug("args[@args]") if $CPAN::DEBUG;
    if ($CPAN::RUN_DEGRADED) {
        $CPAN::Frontend->mydie(
            "'o conf commit' disabled in ".
            "degraded mode. Maybe try\n".
            " !undef \$CPAN::RUN_DEGRADED\n"
        );
    }
    my ($configpm, $must_reload);

    # XXX does anything do this? can it be simplified? -- dagolden, 2011-01-19
    if (@args) {
      if ($args[0] eq "args") {
        # we have not signed that contract
      } else {
        $configpm = $args[0];
      }
    }

    # use provided name or the current config or create a new MyConfig
    $configpm ||= require_myconfig_or_config() || make_new_config();

    # commit to MyConfig if we can't write to Config
    if ( ! -w $configpm && $configpm =~ m{CPAN/Config\.pm} ) {
        my $myconfig = _new_config_name();
        $CPAN::Frontend->mywarn(
            "Your $configpm file\n".
            "is not writable. I will attempt to write your configuration to\n" .
            "$myconfig instead.\n\n"
        );
        $configpm = make_new_config();
        $must_reload++; # so it gets loaded as $INC{'CPAN/MyConfig.pm'}
    }

    # XXX why not just "-w $configpm"? -- dagolden, 2011-01-19
    my($mode);
    if (-f $configpm) {
        $mode = (stat $configpm)[2];
        if ($mode && ! -w _) {
            _die_cant_write_config($configpm);
        }
    }

    $self->_write_config_file($configpm);
    require_myconfig_or_config() if $must_reload;

    #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
    #chmod $mode, $configpm;
###why was that so?    $self->defaults;
    $CPAN::Frontend->myprint("commit: wrote '$configpm'\n");
    $CPAN::CONFIG_DIRTY = 0;
    1;
}

sub _write_config_file {
    my ($self, $configpm) = @_;
    my $msg;
    $msg = <<EOF if $configpm =~ m{CPAN/Config\.pm};

# This is CPAN.pm's systemwide configuration file. This file provides
# defaults for users, and the values can be changed in a per-user
# configuration file.

EOF
    $msg ||= "\n";
    my($fh) = FileHandle->new;
    rename $configpm, "$configpm~" if -f $configpm;
    open $fh, ">$configpm" or
        $CPAN::Frontend->mydie("Couldn't open >$configpm: $!");
    $fh->print(qq[$msg\$CPAN::Config = \{\n]);
    foreach (sort keys %$CPAN::Config) {
        unless (exists $keys{$_}) {
            # do not drop them: forward compatibility!
            $CPAN::Frontend->mywarn("Unknown config variable '$_'\n");
            next;
        }
        $fh->print(
            "  '$_' => ",
            $self->neatvalue($CPAN::Config->{$_}),
            ",\n"
        );
    }
    $fh->print("};\n1;\n__END__\n");
    close $fh;

    return;
}


# stolen from MakeMaker; not taking the original because it is buggy;
# bugreport will have to say: keys of hashes remain unquoted and can
# produce syntax errors
sub neatvalue {
    my($self, $v) = @_;
    return "undef" unless defined $v;
    my($t) = ref $v;
    unless ($t) {
        $v =~ s/\\/\\\\/g;
        return "q[$v]";
    }
    if ($t eq 'ARRAY') {
        my(@m, @neat);
        push @m, "[";
        foreach my $elem (@$v) {
            push @neat, "q[$elem]";
        }
        push @m, join ", ", @neat;
        push @m, "]";