--Config{startperl}--
    eval 'exec --Config{perlpath}-- -S $0 ${1+"$@"}'
        if $running_under_some_shell;

# The contents of this file are subject to the Netscape Public License
# Version 1.1 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
# the License for the specific language governing rights and limitations
# under the License.
#
# The Original Code was released August, 1999.  The Initial Developer
# of the Original Code is Netscape Communications Corporation.  Portions
# created by Netscape are Copyright (C) 1999 Netscape Communications
# Corporation.  All Rights Reserved.
#
# Contributor(s): John M. Kristian <kristian@netscape.com>

die "usage: $0 key=value ...\n" .
    "for example: $0 myhostname=`hostname` cf_by=`whoami`\n"
    unless @ARGV;

use strict;
use Config;
use File::Find;
use File::Spec;

use vars qw(%configsuffix @scriptsuffix $errors);

my $prefix   = $Config{prefixexp};
my $perlpath = $Config{perlpath};

--util.pm--
--change_files.pm--

sub _all_files_in # directory, ...
{
    my @files;
    foreach my $dir (@_) {
	unless (opendir DIR, $dir) { warn "$dir: $!"; next; }
	push @files, (map {File::Spec->catfile ($dir, $_)} (readdir DIR));
	closedir DIR;
    }
    return @files;
}

sub _first_line # file
{
    my ($file) = @_;
    return unless -f $file;
    if (open FILE, "<$file") {
	my $line = <FILE>;
	close FILE;
	return $line;
    }
    warn "Can't read $file: $!\n";
    ++$errors;
    return undef;
}

sub _change_scripts # oldPattern suffix newPath
{
    my ($old, $suffix, $new) = @_;
#   printf ("_change_scripts(%s,%s,%s)\n", $old, $suffix, $new);
    _change_files ($old, $suffix, $new,
		   grep {/.(bat|pl)$/i or (_first_line ($_) =~ /$old$suffix/)}
		   (_all_files_in
		    (grep defined,
		      map {File::Spec->catfile ($prefix, $_)}
		       @scriptsuffix)));
}

{
    my $archsuffix = _subpath ($prefix, $Config{installarchlib});
    my $libsuffix  = _subpath ($prefix, $Config{installprivlib});
    my $binsuffix  = _subpath ($prefix, $Config{installbin});
    my $scriptsuf  = _subpath ($prefix, $Config{installscript});
    %configsuffix = (pm => File::Spec->catfile ($archsuffix, "Config.pm"),
		     h  => File::Spec->catfile ($archsuffix, "CORE", "config.h"));
    @scriptsuffix = (      File::Spec->catdir  ($archsuffix, "--Pkg--"), # including this script (tricky)
			   $libsuffix,
			   $scriptsuf);
    push @scriptsuffix,    $binsuffix
	unless _same_path ($scriptsuf, $binsuffix);
}

sub _configfile
{
    return File::Spec->catfile ($prefix, $configsuffix{pm});
}

sub _change_configfile # key value
{
    my ($key, $new) = @_;
    $key = quotemeta $key; # ordinarily unnecessary
    $new = "undef" unless defined $new;
    _change_files ("^$key='.*", "'\\s*\n", "$key='$new", _configfile());
}

sub _date {
    return scalar localtime; # The time zone would be a nice addition.
}

{
    my $changes = 0;
    foreach my $arg (@ARGV) {
	next if $arg eq ""; # as it usually does, on Windows.
	my ($key, $new) = split /\=/, $arg, 2;
	my $old = $Config{$key};
	if ((exists $Config{$key}) ? ($old eq $new)
	                           : (not defined $new)) {
	    printf ("%s=%s (unchanged)\n", $key, $new);
	    next; # in @ARGV
	}
	++$changes;
	if ($key =~ /^prefix(exp)?$/) {
	    $old = quotemeta $old;
	    $old =~ s"\\\\|\\/|/"[\\\\\\/]"g if ($MSWin32);
	    my $suffix = "[/\\\\\"\'\\s]";
	    my @packlists;
	    unless (chdir $new) { ++$errors; warn "$key=$new: $!"; next; }
	    find (sub {if ('.packlist' eq lc $_) {
			push @packlists, File::Spec->catfile ($File::Find::dir, $_);
		      }},
		  File::Spec->curdir());
	    $prefix = $new;
	    _change_files   ($old, $suffix, $new, @packlists);
	    _change_files   ($old, $suffix, $new, _configfile());
	    _change_scripts ($old, $suffix, $new);
	    if ($MSWin32) {
		my $str = $old; $str =~ s"\[\\\\\\/\]"(\\\\\\\\|\\/)"g;
		_change_files ("()\\\"$str", '', "\"$new",
			       File::Spec->catfile ($prefix, $configsuffix{h}));
	    } else {
		_change_files ($old, $suffix, $new,
			       File::Spec->catfile ($prefix, $configsuffix{h}));
	    }
	    $perlpath =~ s/$old($suffix)/$new$1/;

	} elsif ($key eq 'perlpath') {
	    $old = quotemeta $perlpath;
	    $old =~ s"\\\\|\\/|/"[\\\\\\/]"g if ($MSWin32);
	    my $suffix = "[\"\'\\s]";
	    _change_configfile ($key, $new);
	    _change_scripts ($old, $suffix, $new);
	    $perlpath = $new;

	    my $startperl = $Config{startperl};
	    if ($startperl =~ s/$old($suffix)/$new$1/g) {
		_change_configfile ('startperl', $startperl);
	    }

	} else {
	    _change_configfile ($key, $new);
	}
    }
    _change_configfile ('cf_time', _date) if $changes;
}
exit $errors;

__END__

=head1 NAME

reconfigure - change Perl configuration information

=head1 SYNOPSIS

    reconfigure.pl myhostname=`hostname` cf_by=`whoami`

Modify %Config::Config, according to the given parameters.
Also, when changing $Config{prefix} or $Config{prefixexp}.
edit affected configuration files and standard scripts
located under the new prefix.
Also, when changing $Config{perlpath}, edit standard scripts and
replace any occurrences of $Config{perlpath} within $Config{startperl}.

=cut
