#!/usr/bin/perl -w

sub sniff_set($)
{
    my $build_dir = shift;
    my ($dirhandle, $fname);

    opendir ($dirhandle, $build_dir) || die "Can't open $build_dir";
    while ($fname = readdir ($dirhandle)) {
	$fname =~ /[Ss]et.sh$/ && last;
    }
    closedir ($dirhandle);

    return $fname;
}

sub rewrite_value($$$)
{
    my ($value, $old_root, $new_root) = @_;

# unix style
    $value =~ s/$old_root/$new_root/g;

# win32 style
    $old_root =~ s/\//\\\\\\\\\\\\\\\\/g;
    $new_root =~ s/\//\\\\\\\\/g;
    $value =~ s/$old_root/$new_root/g;

    return $value;
}

sub rewrite_set($$)
{
    my $new_root = shift;
    my $set = shift;
    my $old_root;
    my $tmp_fname = "$new_root/$set.new";
    my $old_fname = "$new_root/$set";
    my $old_file;
    my $new_file;

    open ($old_file, $old_fname) || die "Can't open $old_fname: $!";
    open ($new_file, ">$tmp_fname") || die "Can't open $tmp_fname: $!";
    
    while (<$old_file>) {
	if (/\s*([^=]+)\s*=\s*\"([^\"]+)\"/) {
	    my ($name, $value) = ($1, $2);
	    if ($name eq 'SRC_ROOT') {
		$old_root = $value;
	    }

	    $value = rewrite_value ($value, $old_root, $new_root);

	    print $new_file "$name=\"$value\"\n";
	} else {
	    print $new_file $_;
	}
    }
    
    close ($new_file) || die "Failed to close $tmp_fname: $!";
    close ($old_file) || die "Failed to close $old_fname: $!";

    rename $tmp_fname, $old_fname || die "Failed to replace $old_fname: $!";

    return $old_root;
}

sub rewrite_product_dpcc($$$)
{
    my $new_root = shift;
    my $product_path = shift;
    my $old_root = shift;

    my $path = "$new_root/$product_path/misc";
    my $misc_dir;
    opendir ($misc_dir, $path) || return;
    my $name;
    while ($name = readdir ($misc_dir)) {
	$name =~ /\.dpcc$/ || next;
# Should re-write the dpcc files - but perhaps this'd screw with timestamps ?
	unlink ("$path/$name");
    }
    closedir ($misc_dir);
}

sub rewrite_dpcc($$)
{
    my $new_root = shift;
    my $old_root = shift;

    print "re-writing dependencies:";
    my $top_dir;
    my $idx = 0;
    opendir ($top_dir, $new_root) || die "Can't open $new_root: $!";
    my $name;
    while ($name = readdir ($top_dir)) {
	my $sub_dir;
	opendir ($sub_dir, "$new_root/$name") || next;
	my $sub_name;
	while ($sub_name = readdir ($sub_dir)) {
	    if ($sub_name =~ /\.pro$/) {
		$idx || print "\n    ";
		if ($idx++ == 6) {
		    $idx = 0;
		}
		print "$name ";
		rewrite_product_dpcc ($new_root, "$name/$sub_name", $old_root);
	    }
	}
	closedir ($sub_dir);
    }
    closedir ($top_dir);
}

for $a (@ARGV) {
    if ($a eq '--help' || $a eq '-h') {
	print "relocate: syntax\n";
	print "  relocate /path/to/new/ooo/source_root\n";
    }
}

$OOO_BUILD = shift (@ARGV) || die "Pass path to relocated source tree";
substr ($OOO_BUILD, 0, 1) eq '/' || die "relocate requires absolute paths";

$set = sniff_set($OOO_BUILD) || die "Can't find env. set";

$OLD_ROOT = rewrite_set($OOO_BUILD, $set);

print "Relocate: $OLD_ROOT -> $OOO_BUILD\n";

rewrite_dpcc($OOO_BUILD, $OLD_ROOT);

print "done.\n";
