#!/usr/local/bin/perl -w

## This requires at least perl5
if ($] < 5) {
    die("This program requires perl 5.002 or greater.\n");
}

$base = actual_path($0);
@path = split(/(\/)/, $base);
$0 = pop(@path);
pop(@path);
$base = join("", @path);

## -------------------------------------------------------------------------
## Get the version
##

open(VER, "$base/files/version") || die("No version file??\n");
chomp($ver = <VER>);
close(VER);
$ver || die("No version??\n");

## -------------------------------------------------------------------------
## Defaults..
##

$| = 1;
$coldcc    = "coldcc";
$genesis   = "genesis";
$tdsort    = "$base/scripts/tdsort";
$tdjoin    = "$base/scripts/tdjoin";
$clean     = "$base/scripts/finalclean";
$patchfile = "$base/files/patch";
#$patchmods = "$base/files/mods";
$patchver  = "^patch [2-9].[2-9]\$";
$upgradedb = "";
$workdir   = "work";
$msg = "[**]";
$err = "[!!]";
$ind = "    ";

## -------------------------------------------------------------------------
## make sure everything is correct
##

## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## dig up genesis
print "\n$msg Checking for genesis..";
if (! -e $genesis) {
    while (! -e $genesis) {
        print <<END;

$ind >
$ind > Unable to find Genesis executable.
$ind >

END
        print "$ind Specify location: ";
        chomp($genesis = <STDIN>);
        if ($genesis !~ /genesis$/) {
            print "$err Invalid genesis reference.\n";
            $genesis = "";
        }
    }
    $genesis = actual_path($genesis);
    print "$msg .. Using $genesis\n";
} else {
    $genesis = actual_path($genesis);
    print ".$genesis\n";
}

## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## dig up coldcc
print "\n$msg Checking for coldcc..";
if (! -e $coldcc) {
    my @tmp = split(/(\/)/, $genesis);
    pop(@tmp);
    $coldcc = join("", @tmp) . 'coldcc';

    while (! -e $coldcc) {
        print <<END;

$ind >
$ind > Unable to find ColdCC executable.
$ind >

END
        print "$ind Specify location: ";
        chomp($coldcc = <STDIN>);
        if ($coldcc !~ /coldcc$/) {
            print "$err Invalid coldcc reference.\n";
            $coldcc = "";
        }
    }
    $coldcc = actual_path($coldcc);
    print "\n$msg .. Using $coldcc\n";
} else {
    $coldcc = actual_path($coldcc);
    print ".$coldcc\n";
}

## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!-e $tdsort &&
    die("\n$err tdsort is missing!  Did you move it??  Put it back!\n");
!-e $tdjoin &&
    die("\n$err tdjoin is missing!  Did you move it??  Put it back!\n");
!-f $patchfile &&
    die("\n$err $patchfile is missing!  Did you move it??  Put it back!\n");

if ($#ARGV > -1 && $ARGV[0] eq "-finish") {
    if (!-d "$base/$workdir") {
        print "$err Ignoring -finish argument, no working directory.\n";
    } else {
        chdir("$base/$workdir") || die("$err chdir(\"$base/$workdir\"): $!\n");
        goto FINISH;
    }
} else {
    -d "$base/$workdir" &&
        die("\n$err Working directory '$workdir' already exists, aborting..\n");
}

## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## dig up the binary db

for (;;) {
    print <<END;

$ind >
$ind > Specify binary directory to read from.
$ind >
$ind > !!!!    THIS SHOULD *NOT* BE AN ACTIVELY USED BINARY DB    !!!!
$ind > !!!! MAKE SURE TO SHUTDOWN YOUR DATABASE BEFORE DOING THIS !!!!
$ind > 
$ind > This database will be cleaned with the command-line option:
$ind >
$ind >     $genesis -f --clean --quit
$ind >
$ind > This should not effect the integrity of the database.
$ind >

END
    print "$ind Specify binary db: ";
    chomp($ans = <STDIN>);
    !$ans && next;
    $upgradedb = actual_path($ans) || next;
    if (! -d $upgradedb) {
        print "$err $upgradedb is not a directory.\n";
    } elsif (! -f "$upgradedb/.clean") {
        print "$err $upgradedb is not a clean database.\n";
    } else {
        last;
    }
}

print "$msg .. Using $upgradedb\n";

## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

## clean it up to make errors nicer

$patchprog = "";
print "\n$msg Checking for patch utility..";
my %epath;
my $pver;
$incompatable = 0;
for (split(/:/, $ENV{PATH})) {
    ## put checked($env{})
    (exists($epath{$_})) && next;
    $epath{$_} = 1;
    if ( -e "$_/patch" ) {
        if (open(VER, "$_/patch -v 2>&1 |")) {
            chomp($pver = <VER>);
            close(VER);
            if ($pver !~ /$patchver/) {
                print "\n";
                print "$err Patch utility $_/patch is too old for us to use!\n";
                print "$err Looking for another patch..\n";
                $incompatable++;
            } else {
                $patchprog = "$_/patch";
            }
        }
    }
}

if ($patchprog) {
    if ($incompatable) {
        print "$ind Ohh, looks like $patchprog is what we want.\n";
    } else {
        print ".$patchprog\n";
    }
} else {
    die(<<END);

$err Unable to find an acceptable 'patch' utility, make sure it is in your
$err path and run $0 again--or, you can get the latest version from:
$err
$err     ftp://prep.ai.mit.edu/pub/gnu/patch-2.4.tar.gz
$err
$err If you currently have patch, but it is too old to use, you must upgrade
$err because your patch does not handle lines longer than 4096 characters
END
}


## -------------------------------------------------------------------------
## go for it..


$tmpdb = "tmpdb.$$";
mkdir("$base/$workdir", 0755) || die("$err mkdir(\"$base/$workdir\"): $!\n");
chdir("$base/$workdir") || die("$err chdir(\"$base/$workdir\"): $!\n");

print "$msg Cleaning Database..\n";
my $exec = "$genesis -db $upgradedb -f --clean --quit -ld $$.dlog -lg $$.glog";
if (system($exec) / 256) {
    print "$err: Genesis errored out:\n";
    system("cat $$.[dg]log");
    unlink("$$.dlog");
    unlink("$$.glog");
    exit;
}
unlink("$$.dlog");
unlink("$$.glog");
    
print "$msg Decompiling Database..\n";
$exec = "$coldcc -d -o -# -b $upgradedb -t $tmpdb";
if (system($exec) / 256) {
    exit;
}

print "$msg Splitting database..\n";
system("$tdsort", "-t", $tmpdb);

print "$msg Integrating database changes with patchfile..\n";

open(PATCH, "$patchfile") || die("open('$patchfile'): $!\n");
open(POUT,  ">${patchfile}-integrated") ||
                      die("open('${patchfile}-integrated'): $!\n");
while (<PATCH>) {
    if (/^\*var \$([^ ]+) ([^ ]+) = '([- +])' ([a-z0-9_]+.cdc)/) {
        $obj=$1;
        $var=$2;
        $c=$3;
        $file=$4;
        open(TMP, "src/$file") || die("Unable to find src/$file\n");
        print POUT "${c}var \$$obj $var = ";
        $data = "";
        while (<TMP>) {
            if (/^var \$$obj $var = /) {
                $len = length($obj) + length($var) + 9;
                $data = substr($_, $len);
                print POUT $data;
                last;
            }
        }
        close(TMP);

        if (!$data) {
            print "$err Unable to find value in src/$file.., using '0'\n";
            print POUT "0;\n";
        }
    } else {
        print POUT;
    }
}
close(PATCH);
close(POUT);

print "$msg Patching..\n";

open(PATCH, "$patchprog -p1 -t -s -i ${patchfile}-integrated 2>&1 |") ||
   die("Unable to exec: $patchprog -p0 -t -s -i ${patchfile}-integrated");
$rejects = 0;
@failed = ();
while (<PATCH>) {
    if (/^(\d+) out of (\d+) (hunks?) FAILED -- saving rejects to src\/(.*)\.cdc\.rej\n$/) {
        push(@failed, $4);
        printf("$ind %32s: $1 out of $2 $3 FAILED\n", "\$$4");
        $rejects++;
    } else {
        print;
    }
}
close(PATCH);
if ($? / 255) {
    exit;
}

if ($#failed > -1) {
    print <<END;
$err $rejects rejects, you will need to manually review the following files,
$err and apply the patches as you can:
END
    for (@failed) {
        print "$err     $workdir/src/$_.cdc.rej\n";
    }
    print "$err When you are finished, run: patchdb -finish\n";
    exit;
}

FINISH:

#if ( -f "$patchmods") {
#    print "$msg Final Modifications (require user interaction)...\n";
#}

print "$msg Joining Patched Database..\n";
(system("$tdjoin") / 256) && exit;

print "$msg Final Cleaning Pass..\n";
system("$clean < textdump > textdump-cleaned");

print "$msg Compiling Patched Database..\n";
system("$coldcc", "-o", "-t", "textdump-cleaned");

print "$msg Decompiling Patched Database\n";
system("$coldcc", "-o", "-d", "-t", "../textdump-upgrade-$ver");

print <<END;
$msg
$msg UPGRADE COMPLETED!
$msg
$msg Assuming everything worked ok, you should be able to compile the
$msg text database 'textdump-upg-$ver' and run as normal.  Any other
$msg files in this directory may be removed, as you desire.
$msg
END

## =========================================================================
## Figure the full 'real' path, clearing out any '..' and '.' references
##
sub actual_path {
    my $file = $_[0];
    my ($fullname, $wd, $last, $dir, $parts, $top);

    $file =~ s/^\.\///;
    $file =~ s/\/\.$//;

    if ($file =~ /^\//) {
        $fullname = $file;
    } else {
        chomp($wd = `pwd`);
        $fullname = "$wd/$file";
    }

    if ($fullname =~ /\/\.\.\//) {
        my $origwd = `pwd`;
        chomp($origwd);
        @parts = split(/(\/?\.\.\/?)/, $fullname);
        $top = pop(@parts);
        $dir = join("", @parts);
        chdir($dir) || return 0;
        chomp($wd = `pwd`);
        $fullname = "$wd/$top";
        chdir($origwd) || die("chdir($origwd): $!\n");
    }

    $fullname =~ s/\/\.\///g;
    return $fullname;
}