#!perl
# Upgrade an existing S1WS6.1 installation to this service pack
# Called by httpconf.cpp:installCleanup
#


BEGIN
{
    $| = 1;
    $isNT = -d '\\';

    # global variables
    $useHTML = 0;
    $rootDir = 0;


    sub printUsage
    {

        print "Usage:  perl $ARGV[0] -r <rootDir>\n\n";
        print "        -r = root directory\n";
        print "\n";
        exit(0);
    }


    # parse arguments
    if ($#ARGV < 0)
    {
        printUsage();
    }

    my $argc = 0;
    while ($argc <= $#ARGV)
    {
        if ($ARGV[$argc] eq "-r")
        {
            $argc++;
            if ($argc > $#ARGV)
            {
                printUsage();
            }
            $rootDir = $ARGV[$argc++];
            $rootDir =~ s/\\/\//g if $isNT;
            if (substr($rootDir, length($rootDir)-1, length($rootDir)) eq "/")
            {
                chop($rootDir);
            }
            die("No such directory: $rootDir\n") if (!(-d $rootDir));
        }
        elsif ($ARGV[$argc] eq "-w")
        {
            $useHTML = 1;
            $argc++;
        }
        else
        {
            printUsage();
        }
    }

    # set include line
    @INC = ( "$rootDir/bin/https/perl" );
}

use BinUtil;
use Magnus;


# defines
$JAVA_SEP = ":";
if ($isNT)
{
    $JAVA_SEP = ";";
}

# environment
$ENV{LD_LIBRARY_PATH} = "$rootDir/bin/https/lib";
$ENV{SHLIB_PATH} = "$rootDir/bin/https/lib";
$ENV{LIBPATH} = "$rootDir/bin/https/lib";

$LOG_FILENAME = "$rootDir/setup/upgrade.log";
open(LOG_FILE, ">>$LOG_FILENAME") ||
    die "Could not open $LOG_FILENAME in append mode\n";

my %pkgList = BinUtil::getPkgList($rootDir);
my $WS_Version = BinUtil::getVersion($rootDir);

logInfo("Sun One Web Server $WS_Version upgrade completed");

close(LOG_FILE);
exit(0);

#
# Strip whitespaces
#
sub strip
{
    my $str = shift;

    $str =~ s/\s+//g;

    return $str;
}

#
# Escape special characters such as $, { etc that are used in
# regular expressions.
#
sub escapeRegex
{
    my $expr = shift;

    $expr =~ s/\$/\\\$/g;
    $expr =~ s/\{/\\\{/g;
    $expr =~ s/\}/\\\}/g;
    $expr =~ s/\(/\\\(/g;
    $expr =~ s/\)/\\\)/g;

    return $expr;
}

sub logInfo
{
    my $msg = shift;
    my @now = localtime;
    my $month = $now[4] + 1;
    my $year = $now[5] + 1900;
    print LOG_FILE "[$year/$month/$now[3]:$now[2]:$now[1]:$now[0]] - ";
    print LOG_FILE "[upgrade60] $msg\n";
}

sub logError
{
    my $msg = shift;
    logInfo($msg);
    exit(1);
}

#
# Return the contents of the specified file as a single string
# (Used on NT)
#
sub readFile
{
    my $fname = shift;
    my $data = "";
    open(TMPFILE, "<$fname") || logError("Could not open $fname");
    while (<TMPFILE>)
    {
        $data .= $_;
    }
    close(TMPFILE);
    return strip($data);
}
