#!/usr/local/bin/perl
#

#
#  $Id: //guest/robert_cowham/perforce/utils/backup.pl#2 $
#
# Modified by Robert Cowham for Magic4
#   - make tar step configurable
#
#
# Copyright (c) 2000, Sandy Currier (sandy@releng.com)
# Distributed under the GNU GENERAL PUBLIC LICENSE:
#
#      This program is free software; you can redistribute it and/or modify
#      it under the terms of the GNU General Public License as published by
#      the Free Software Foundation; either version 1, or (at your option)
#      any later version.
#
#      This program is distributed in the hope that it will be useful,
#      but WITHOUT ANY WARRANTY; without even the implied warranty of
#      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#      GNU General Public License for more details.
#
#      You should have received a copy of the GNU General Public License
#      along with this program; if not, write to the Free Software Foundation,
#      Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
#
#
# This script will backup a perforce database
#
# This is done by:
#  - creating a new checkpoint
#  - keeping only a certain number of checkpoint files
#

#
# NOTE: to schedule this on NT (via the at command and the scheduler service)
#       'at 22:00 /every:M,T,W,Th,F,S,Su d:\perforce\backup.plx`
#
# NOTE: to schedule this on unix, use crontab (see manpages)
#
# BUT, the plx suffix must be a recognized file type (for the above to work)
#  1) goto MyComputer -> View <tab> -> Options... -> File Types <tab>
#  2) add a plx suffix (new type); fill in 'Description of Type' and
#     'associated extension'
#  3) click New <action>
#     a) the action is: 'open'
#     b) the application is something like 'c:\perl\bin\perl.exe "%1" %*'
#  That last bit is the Bill magic to pass args to perl scripts
#
# NOTE: to cron this on unix, add a cron entry
#

#
# first, see if unix or NT or what...
# need a recent version of perl on NT to have win32 module/config stuff
package main;

BEGIN: {
    require 5.004;
    unless ($Platform{'os'}) {
        unless ($Platform{'os'} = $^O) {
            use Config ();      # import nothing
            $Platform{'os'} = $Config::Config{'osname'};
        }
    }
    # bottom layer OS specific variables/constants
    if ($Platform{'os'} =~ /Win/i) {
        #########################
        # win32
        #########################
        $Platform{'os'} = "win32";
        $Platform{'pd'} = '\\';
        $Platform{'cp'} = "xcopy /s /e /k /i";
        $Platform{'gzip'} = "gzip.exe";
        # Note on exit codes:
        # 0     Files were copied without error.
        # 1     No files were found to copy.
        # 2     The user pressed CTRL+C to terminate xcopy.
        # 4     Initialization error occurred. There is not enough
        #       memory or disk space, or you entered an invalid
        #       drive name or invalid syntax on the command line.
        # 5     Disk write error occurred.
    } elsif ($Platform{'os'}=~/vms/i) {
        #########################
        # vms
        #########################
        die "vms is currently not a supported platform";
    } elsif ($Platform{'os'}=~/os2/i) {
        #########################
        # os2
        #########################
        die "os2 is currently not a supported platform";
    } elsif ($Platform{'os'}=~/Mac/i or (defined($MacPerl::Version) and $MacPerl::Version)) {
        #########################
        # mac
        #########################
        $Platform{'pd'} = ':';  # use this in pathname pattern matching (mac)
        die "macintosh is currently not a supported platform";
    } else {
        #########################
        # unix
        #########################
        $Platform{'os'} = "unix";
        $Platform{'pd'} = '/';
        $Platform{'cp'} = "cp -rp";
        $Platform{'gzip'} = "gzip";
        # note on unix error codes
    }

    #
    # Unbuffer STDERR and STDOUT
    select(STDERR);
    $| = 1;                     # Make STDERR be unbuffered.
    select(STDOUT);
    $| = 1;                     # STDOUT too so, they can mix.

}

#
# set up some globale
# Note: assume that the PATH EV is going to be used to find p4
$err = "***";
$ThisCmd = "backup.pl";           # this command name
$NetApp = "";                   # the name of the NetApp
$logfile_opened_p = 0;          # set when the logfile has been opened
$maxbackups = 3;                # the maximum number of backup copies
                                # to keep
$portnumber = "1666";           # the port number for p4port
$host = "perforce";     # the hostname to go with the above port number checkpoint
$stop_p = 0;                      # whether or not to stop/start the servers
$gzip_p = 0;                    # whether or not to gzip
$snap_p = 0;                    # whether or not to snapshot a Network Appliance
$tar_p = 0;             # whether to create tars of depot (archive) files
@depots = ();                   # the depots to tar up
$CkptName = "checkpoint";       # the filename (absolute or relative) of the checkpoint
$CkptSuffix = "ckp";
$JnlSuffix = "jnl";
$printonly = 0;
$fakeckp = 123;

# user overrides
$P4Port = "1666";
$P4InstallDir = "c:/p4client";
$DepotRoot    = "d:/p4server/root";
$BackupDir    = "d:/p4server/backups";
$SnapshotDir  = "";


# set up the other global variable
sub SetGlobals {
    # Note: better to set the EV's so that it doesn't get printed all over the place
    $ENV{'P4CONFIG'} = "";
    $ENV{'P4PASSWD'} = "";
    $ENV{'P4USER'} = "";
    if ($Platform{'os'} eq "win32") {
        $P4Port       = "perforce:1666" unless ($P4Port);
        $P4InstallDir = "e:/perforce" unless ($P4InstallDir);
        $DepotRoot    = "e:/perforce" unless ($DepotRoot);
        $BackupDir    = "e:/perforce/backups" unless ($BackupDir);
        $SnapshotDir  = "d:/perforce/~snapshot/checkpoint/perforce" unless ($SnapshotDir);
        # the below are derived from above
        $P4           = "p4.exe";
        $P4D          = "p4d.exe";
        $CkptPname    = "$BackupDir/$CkptName";
        $CkptCmd      = &unix2dos("$P4D -r \"$DepotRoot\" -jc \"$CkptPname\"");
        $CkptJnlCmd   = &unix2dos("$P4D -r \"$DepotRoot\" -jj \"$CkptPname\"");
        # this one is odd - only used when snapshoting...
        $CkptFileCmd  = &unix2dos("$P4D -r \"$SnapshotDir\" -jd"); # the filename is generated on the fly
        $TarCmd       = &unix2dos("c:/toolkit/mksnt/tar");
        $StopCmd      = "net stop Perforce";
        $StartCmd     = "net start Perforce";
    }
    else {                      # unix
        $P4Port       = "$host:$portnumber" unless ($P4Port);
        $P4InstallDir = "/usr/local/bin" unless ($P4InstallDir);
        $DepotRoot    = "/perforce/perforce/p4files.$portnumber" unless ($DepotRoot);
        $BackupDir    = "/perforce/perforce/backups.$portnumber" unless ($BackupDir);
        $SnapshotDir  = "/perforce/.snapshot/checkpoint/perforce/p4files.$portnumber" unless ($SnapshotDir);
        # the below are derived from above
        $P4           = "$P4InstallDir/p4";
        $P4D          = "$P4InstallDir/p4d";
        $CkptPname    = "$BackupDir/$CkptName";
        $CkptCmd      = "$P4D -r $DepotRoot -jc $CkptPname";
        $CkptJnlCmd   = "$P4D -r $DepotRoot -jj $CkptPname";
        # this one is odd - only used when snapshoting...
        $CkptFileCmd  = "$P4D -r $SnapshotDir -jd"; # the filename is generated on the fly
        $TarCmd       = "/usr/local/bin/tar";
        $StopCmd      = "$P4 -p $P4Port admin stop";
        $StartCmd     = "$P4D -p $P4Port -d -r $DepotRoot -L $DepotRoot/p4d.log -J journal";
    }
    $LogFile = "$BackupDir/backup.log";
    $SnapDeleteCmd = "sudo /bin/rsh $NetApp snap delete vol0 checkpoint";
    $SnapCreateCmd = "sudo /bin/rsh $NetApp snap create vol0 checkpoint";
}


#
# now parse any args
# the usage message (for -h or on error)
$help = "$ThisCmd portnumber [options...]
Function:
    This command will checkpoint a perforce repository.
    The checkpoint command is: '$CkptCmd'

Args:
    portnumber       The port number for the P4PORT to backup.
                     Several variables are derived from this value.

Switches/Options:
    -h               Prints this help message
    -n               Will not run write to disk - mostly print
    -maxbackups N    Specify the number of backup files
                     to retain (def = $maxbackups)
    -depotroot <str> Specify another depot root
";

# parse command line
{
    my($i);
    my($param) = 0;
    while($i <= $#ARGV) {
        # scan for a help switch
        if ($ARGV[$i] =~ /^-h/i) {
            &DieHelp("", $help);
        }
        elsif ($ARGV[$i] =~ /^-n/) {
            $printonly = 1;
            $i++;
        }
        # scan for variable definitions (-variable value)
        elsif ($ARGV[$i] =~ /^-\w+/ and defined($ARGV[$i+1]) and $ARGV[$i+1] !~ /^-[^-]/) {
            # NOTE: nt has a difficult time with '=' on a command line...
            # process any variable value switches
            my($var) = $ARGV[$i];
            $var =~ s/^-//;
            my($value) = $ARGV[$i+1];
            if (defined $$var) {
                $$var = $value;
            }
            else {
                &DieHelp("Unknown parameter '$var'\n", $help);
            }
            $i=$i+2;
        }
        # catch unsupported switches
        elsif ($ARGV[$i] =~ /^-/) {
            &DieHelp("Unsupported switch \"$ARGV[$i]\"\n", $help);
        }
        elsif ($param == 0) {
            $portnumber = $ARGV[$i];
            $i++;
            $param++;
        }
        else {
            &DieHelp("Extra args: @ARGV\n", $help);
        }
    }
}

#
# Note: if the user overwrote the $DepotRoot value...
$DepotRoot = &other2unix($DepotRoot) if ($DepotRoot);
&SetGlobals();

#
# algorithm:
#  stop the perforce service
#  create a new checkpoint
#  create a new tar file
#  if this is the 7th day of the month, restart the databases
#  start the perforce service
#  limit number of each thing
# algorithm ($snapshot_p == 1)
#  get a list of depots
#  stop the server
#  truncate the journal (will bump the journal counter)
#  create the snapshot
#  restart the server
#  moving to the snapshot directorty:
#    create a checkpoint (do not truncate the journal nor bump the counter)
#    tar up the depots??? - maybe not
#
# the magic command (must by verbatum)
# sudo /bin/rsh $NetApp snap delete vol0 checkpoint
# sudo /bin/rsh $NetApp snap create vol0 checkpoint
# sudo /bin/rsh $NetApp snap list vol0
#
# so, delete snapshot, stop server, journal checkpoint, snapshot, start server,
#     cd to snapshot,
#       create checkpoint file only (into backupdir), tar into backupdir, punt
#       gzip (no need), exit
#

#
# In the beginning, log the time
$tmp = &TimeString(time);
&PrintAndLog(">>> $ThisCmd: beginning backup at: $tmp\n");

#
# But first, cd there...
{
    if (!-d $P4InstallDir) {
        &AbortOnError("$ThisCmd: error - the p4installdir directory $P4InstallDir is not a directory\n");
    }
    &PrintAndLog(">>> chdir to $P4InstallDir\n");
    $tmp = chdir $P4InstallDir;
    unless ($tmp) {
        &AbortOnError("$ThisCmd: error - could not cd to $P4InstallDir\n$!");
    }
}

#
# get the active depots first
{
    local($printonly) = 0;      # do it even if $printonly
    @depots = &GetDepots();
}

#
# if snapshot'ing, do one thing; else, the other
if ($snap_p) {                  # snapshots...
    my($output);
    #
    # delete old checkpoint
    $output = &ExecuteCommand($SnapDeleteCmd);
    if ($output !~ /^(deleting snapshot\.+|No such snapshot.)$/ and !$printonly) {
        &AbortOnError("$ThisCmd: could not delete snapshot checkpoint\n$output");
    }
    else {
        &PrintAndLog($output);
    }

    #
    # stop server
    if ($stop_p) {
        $tmp = &TimeString(time);
        &PrintAndLog(">>> $ThisCmd: stopping perforce server at: $tmp\n");
        &StopServer();
    }

    #
    # truncate the journal
    ($ckptnumber, $journalfile) = &Truncate();

    #
    # snapshot
    $output = &ExecuteCommand($SnapCreateCmd);
    if ($output !~ /^creating snapshot\.+$/ and !$printonly) {
        &AbortOnError("$ThisCmd: could not create snapshot checkpoint\n$output");
    }
    else {
        &PrintAndLog($output);
    }

    #
    # start server
    if ($stop_p) {
        $tmp = &TimeString(time);
        &PrintAndLog(">>> $ThisCmd: starting perforce server at: $tmp\n");
        &StartServer();
    }

    #
    # checkpoint snapshot dir (writing to backup dir)
    &CheckPointOnly($ckptnumber);

    #
    # third, tar up all depots - after finding all depots
    if ($tar_p) {
        foreach my $depot (@depots) {
            # however, if the depot directory does not exist, just print and punt
            if (! -d "$SnapshotDir/$depot") {
                &PrintAndLog("Warning: $depot directory (in $SnapshotDir) does not exist - punting...\n");
            }
            else {
                &ExecuteCommand("$TarCmd -C \"$SnapshotDir\" -cf \"$BackupDir/$depot.$ckptnumber.tar\" $depot");
            }
        }
    }
}
else {                          # no snapshots...
    #
    # first, stop perforce
    if ($stop_p) {
        $tmp = &TimeString(time);
        &PrintAndLog(">>> $ThisCmd: stopping perforce server at: $tmp\n");
        &StopServer();
    }

    #
    # second, checkpoint the meta-data
    # note: need to save the checkpoint number and the journal file name for later...
    ($ckptnumber, $journalfile) = &CheckPoint();

    #
    # third, tar up all depots - after finding all depots
    if ($tar_p) {
        foreach my $depot (@depots) {
            # however, if the depot directory doesnot exist, just print and punt
            if (! -d "$DepotRoot/$depot") {
                &PrintAndLog("Warning: $depot directory (in $DepotRoot) does not exist - punting...\n");
            }
            else {
                &ExecuteCommand("$TarCmd -C \"$DepotRoot\" -cf \"$BackupDir/$depot.$ckptnumber.tar\" $depot");
            }
        }
    }

    #
    # fourth, restart perforce
    if ($stop_p) {
        $tmp = &TimeString(time);
        &PrintAndLog(">>> $ThisCmd: starting perforce server at: $tmp\n");
        &StartServer();
    }
}

#
# at this point, do the same thing whether or not snapshoting

#
# fifth, limit the number of checkpoints
{
    my(@checkpoints) = &GetCkpts($BackupDir, $CkptName, $CkptSuffix);
    &DeleteExtras($BackupDir, @checkpoints);
}

#
# sixth, limit the number of tar files (a no-op in the snapshot case)
if ($tar_p) {
    foreach my $depot (@depots) {
        my(@tarfiles) = &GetTars($BackupDir, $depot, "tar");
        &DeleteExtras($BackupDir, @tarfiles);
    }
}

#
# seventh, limit the number of journal files
{
    my(@checkpoints) = &GetJournals($BackupDir, $CkptName, $JnlSuffix);
    &DeleteExtras($BackupDir, @checkpoints);
}

#
# eighth, compress the tar files and journal files
# note: gzip compresses in place...
if ($gzip_p) {
    if ($tar_p) {
        foreach my $depot (@depots) {
            if (-r "$BackupDir/$depot.$ckptnumber.tar") {
                &ExecuteCommand("$Platform{'gzip'} \"$BackupDir/$depot.$ckptnumber.tar\"");
            }
        }
    }
    &ExecuteCommand("$Platform{'gzip'} $CkptPname.ckp.$ckptnumber")
        if (-r "$CkptPname.ckp.$ckptnumber");
    &ExecuteCommand("$Platform{'gzip'} $journalfile")
        if (-r $journalfile);
}

#
# and in the end, the love we take, is equal to the love we make...
$tmp = &TimeString(time);
&PrintAndLog(">>> $ThisCmd: ending backup at: $tmp\n");
if ($logfile_opened_p) {
    close(LOG);
}
exit(0);

#
# will cleanly abort when in the middle of stuff, trying to restart the server if stopped
sub AbortOnError {
    my($string) = @_;
    &PrintErrorAndLog("$err $string\n") if ($string);
    if ($stopped_p) {
        $stopped_p = 0;         # so to avoid an infinite loop...
        &ExecuteCommandSystem($StartCmd);
    }
    if ($logfile_opened_p) {
        close(LOG);
    }
    exit(1);
}

#
# will execute a random OS command
sub ExecuteCommand {
    my($cmd, $ignore_error) = @_;
    my($tmp);
    unless ($printonly) {
        &PrintAndLog("running: $cmd\n");
        # special cased commands
        $tmp = `$cmd 2>&1`;
        if ($? and !$ignore_error) {
            &AbortOnError("$ThisCmd: error - could not execute $cmd\n$?");
        }
    }
    else {
        &PrintAndLog("not running: $cmd\n");
    }
    return($tmp);
}

#
# a system version of the above (sometimes needed in strange situations where the
# fork (note the -d switch to p4d) will get hung up, like during perldb...)
sub ExecuteCommandSystem {
    my($cmd, $ignore_error) = @_;
    my($tmp);
    unless ($printonly) {
        &PrintAndLog("running: $cmd\n");
        # special cased commands
        system($cmd);
        if ($? and !$ignore_error) {
            &AbortOnError("$ThisCmd: error - could not execute $cmd\n$?");
        }
    }
    else {
        &PrintAndLog("not running: $cmd\n");
    }
    return($tmp);
}

#
# will delete extra backups of stuff
# NOTE: @_ must be an time ordered array of old to youngest copies
sub DeleteExtras {
    my($directory, @array) = @_;
    my($i, $tmp);
    if ($#array >= $maxbackups) {
        # delete some
        for ($i=0; $i<=$#array - $maxbackups; $i++) {
            # delete it
            &PrintAndLog("running: unlink \"$directory/$array[$i]\"\n");
            unless ($printonly) {
                $tmp = unlink "$directory/$array[$i]";
                unless ($tmp) {
                    &AbortOnError("$ThisCmd: error - could not delete old checkpoint file \"$directory/$array[$i]\"\n$?");
                }
            }
        }
    }
}

#
# will convert a random OS delimited pathname to a perl pathname
sub other2unix {
    my($filename) = @_;
    my($pattern) = $Platform{'pd'};
    $pattern =~ s/(\W)/\\$1/g;  # escape wildchars
    $filename =~ s|$pattern|/|g;
    # if just "^/..." but not "^//..." (which could either by a UNC name
    # or perforce depot name)
    if ($Platform{'os'} eq 'win32' and $filename =~ /^\/[^\/]/) {
        # try to convert to a drive letter - ignore errors at this low a level
        my($tmp) = `cd`;
        if ($tmp =~ /^([a-zA-Z]:)/) {
            return($1);
        }
    }
    return("/") if ($filename =~ /^\/+$/); # if just /+, return just /
    if ($filename =~ /^\/\//) {
        # add them back in later
        $filename =~ s|/+|/|g;  # remove doubles
        $filename = "/$filename";
    }
    else {
        $filename =~ s|/+|/|g;  # remove doubles
    }
    # remove trailing
    $filename =~ s|/+$||;
    return($filename);
}

#
# blindly converts "/" to "\"
sub unix2dos {
    my($filename) = @_;
    $filename =~ s|/|\\|g;
    return($filename);
}


#
# will print a help message and then exit
sub DieHelp {
    my($str, $help) = @_;
    print STDERR "$err $str\nUsage: $help";
    exit(2);
}

#
# get the depots
sub GetDepots {
    my($command) = "$P4 -p $P4Port depots";
    my(@depots, $tmp);
    $tmp = &ExecuteCommand($command);
    @depots = split('\n', $tmp);
    chomp(@depots);
    if ($#depots < 0) {
        @depots = ("depot");
    }
    else {
        # only do local depots
        @depots = grep(/\d{4}\/\d{2}\/\d{2} local subdir/, @depots);
        foreach (@depots) {
            s|^.*\d{4}/\d{2}/\d{2} local subdir ([^\/]+).*$|$1|;
        }
    }
    return(@depots);
}

#
# will return an ordered list of backups (whether or not gzip'ed)
sub GetCkpts {
    my($directory, $CkptName, $suffix) = @_;
    my(@filenames, @tmp);
    # read the directory
    if (! -d $directory) {
        &PrintErrorAndLog("$err GetCkpts - '$directory' is not a dir\n");
        return;
    }
    if (!opendir(THEDIR,$directory)) {
        &PrintErrorAndLog("$err GetCkpts - cannot open $directory for reading\n");
        return;
    }
    @tmp = grep(/^$CkptName\.$suffix\.[0-9]+/,readdir(THEDIR));
    closedir(THEDIR);
    @filenames = sort sortbyckptname (@tmp);
    return(@filenames);
}

#
# will return an ordered list of backups (whether or not gzip'ed)
sub GetJournals {
    my($directory, $CkptName, $suffix) = @_;
    my(@filenames, @tmp);
    # read the directory
    if (! -d $directory) {
        &PrintErrorAndLog("$err GetJournals - '$directory' is not a dir\n");
        return;
    }
    if (!opendir(THEDIR,$directory)) {
        &PrintErrorAndLog("$err GetJournals - cannot open $directory for reading\n");
        return;
    }
    @tmp = grep(/^$CkptName\.$suffix\.[0-9]+/,readdir(THEDIR));
    closedir(THEDIR);
    @filenames = sort sortbyckptname (@tmp);
    return(@filenames);
}

#
# will return an ordered list of backups (whether or not gzip'ed)
sub GetTars {
    my($directory, $name, $suffix) = @_;
    my(@filenames, @tmp);
    # read the directory
    if (! -d $directory) {
        &PrintErrorAndLog("$err GetCkpts - '$directory' is not a dir\n");
        return;
    }
    if (!opendir(THEDIR,$directory)) {
        &PrintErrorAndLog("$err GetCkpts - cannot open $directory for reading\n");
        return;
    }
    @tmp = grep(/^$name\.[0-9]+\.$suffix/,readdir(THEDIR));
    closedir(THEDIR);
    @filenames = sort sortbytarname (@tmp);
    return(@filenames);
}

#
# will return an ordered list of backups
sub GetNextTarfileName {
    my($directory) = @_;
    my(@tmp, $newname);
    # read the directory
    if (! -d $directory) {
        &PrintErrorAndLog("$err GetNextTarfileName - '$directory' is not a dir\n");
        return;
    }
    if (!opendir(THEDIR,$directory)) {
        &PrintErrorAndLog("$err GetNextTarfileName - cannot open $directory for reading\n");
        return;
    }
    @tmp = grep(/^depot\.[0-9]+\.tar$/,readdir(THEDIR));
    closedir(THEDIR);
    @filenames = reverse sort sortbytarname (@tmp);
    $newname = $filenames[0];
    # now increment the middle field
    @tmp = split(/\./, $newname);
    $tmp[1]++;
    $newname = join("", @tmp);
    return($newname);
}

#
# sort numerically
sub sortbyckptname {
    my($tmpa, $tmpb, $junk);
    ($junk, $junk, $tmpa) = split(/\./, $a);
    ($junk, $junk, $tmpb) = split(/\./, $b);
    $tmpa <=> $tmpb;
}

#
# sort numerically
sub sortbytarname {
    my($tmpa, $tmpb, $junk);
    ($junk, $tmpa, $junk) = split(/\./, $a, 3);
    ($junk, $tmpb, $junk) = split(/\./, $b, 3);
    $tmpa <=> $tmpb;
}

sub PrintAndLog {
    my($string) = @_;
    if ($LogFile and !$printonly) {
        unless ($logfile_opened_p) {
            if (!open(LOG, ">>$LogFile")) {
                print STDERR "$err $ThisCmd: could not open logfile $LogFile\n$!\n";
                $LogFile = "";  # do not do it again
            }
            else {
                $logfile_opened_p = 1;
            }
        }
        if ($LogFile) {
            print LOG $string;
        }
    }
    print STDOUT $string;
}

sub PrintErrorAndLog {
    my($string) = @_;
    if ($LogFile) {
        unless ($logfile_opened_p) {
            if (!open(LOG, ">>$LogFile")) {
                print STDERR "$err $ThisCmd: could not open logfile $LogFile\n$!\n";
                $LogFile = "";  # do not do it again
            }
            else {
                $logfile_opened_p = 1;
            }
        }
        if ($LogFile) {
            print LOG $string;
        }
    }
    print STDERR $string;
}

# will print time in a yyyymmdd.hhmmss format
sub TimeString {
    my($time) = @_;
    my(@ltime);
    # Normally: ($sec,$min,$hour,$mday,$mon,$year) = localtime($time);
    @ltime = localtime($time);
    # do not forget to add 1900 to the century, and 1 to the month
    return(sprintf("%04d%02d%02d.%02d%02d%02d",
                   ($ltime[5]+1900), $ltime[4]+1, $ltime[3],
                   $ltime[2], $ltime[1], $ltime[0]));
}

# returns true if true
sub VerifyServerState {
    my($string) = @_;
    # see if server is running or stopped
    my(@output);
    @output = &ExecuteCommand("$P4 -p $P4Port info", 1);
    if ($string eq "stop") {
        if (grep(/^Perforce client error:/, @output) and grep(/Connect to server failed/, @output)) {
            return(1);
        }
        else {
            return(0);
        }
    }
    else {
        if (grep(/^Perforce client error:/, @output) and grep(/Connect to server failed/, @output)) {
            return(0);
        }
        else {
            return(1);
        }
    }
}

# stop the server
sub StopServer {
    my($tmp) = &ExecuteCommand($StopCmd);
    # wait 5 seconds
    sleep 5;
    # verify the server is stopped
    $tmp = &VerifyServerState("stop");
    unless ($tmp or $printonly) {
        &AbortOnError("$ThisCmd: error - couldn't stop the perforce server\n$tmp");
    }
    $stopped_p = 1;
}

# start server
sub StartServer {
    my($tmp) = &ExecuteCommandSystem($StartCmd);
    if ($tmp) {
        &AbortOnError("$ThisCmd: error - something went wrong with perforce server start\n$tmp");
    }
    # sleep for 5 seconds
    sleep 5;
    # verify the server is stopped
    $tmp = &VerifyServerState("start");
    unless ($tmp or $printonly) {
        &AbortOnError("$ThisCmd: error - couldn't start the perforce server\n$tmp");
    }
    $stopped_p = 0;
}

# checkpoint the database and truncate (rename) the journal file (bumping the journal counter)
sub CheckPoint {
    my($ckpt_output) = &ExecuteCommand($CkptCmd);
    my($ckptnumber, $journalfile);
    $ckpt_output = &other2unix($ckpt_output); # make sure that everything is unix
    # Note: inspect $ckpt_output to determine checkpoint number
    unless ($printonly) {
        unless ($ckpt_output =~ /^Checkpointing to $CkptPname\.$CkptSuffix\.([0-9]+)/i) {
            $ckptnumber = $1;   # save away the ckptnumber for later
            &AbortOnError("$ThisCmd: error - trouble creating checkpoint\n$ckpt_output");
        }
        else {
            $ckptnumber = $1;   # save away the ckptnumber for later
            &PrintAndLog("$ckpt_output");
        }
        if ($ckptnumber eq "") {
            &AbortOnError("$ThisCmd: internal error - checkpoint number is nil");
        }
        # note: get journal file too...
        unless ($ckpt_output =~ /Saving journal to (.*\.[0-9]+)/i) {
            $journalfile = $1;
            &PrintErrorAndLog("$ThisCmd: error - trouble creating journal\n$ckpt_output");
        }
        else {
            $journalfile = $1;
        }
    }
    else {
        $ckptnumber = $fakeckp;
        my($foo) = $fakeckp - 1;
        $journalfile = "$CkptPname.$JnlSuffix.$foo";
    }
    return($ckptnumber, $journalfile);
}

# truncate (rename) the journal file (bumping the journal counter)
sub Truncate {
    my($ckpt_output) = &ExecuteCommand($CkptJnlCmd);
    my($ckptnumber, $journalfile);
    $ckpt_output = &other2unix($ckpt_output); # make sure that everything is unix
    # note: get journal file too...
    unless ($printonly) {
        unless ($ckpt_output =~ /^Saving journal to ($CkptPname\.$JnlSuffix\.[0-9]+)/i) {
            $journalfile = $1;
            &PrintErrorAndLog("$ThisCmd: error - trouble creating journal\n$ckpt_output");
        }
        else {
            $journalfile = $1;
            &PrintAndLog("$ckpt_output");
        }
        $ckpt_output =~ /^Saving journal to $CkptPname\.$JnlSuffix\.([0-9]+)/i;
        $ckptnumber = $1;
        if ($ckptnumber eq "") {
            &AbortOnError("$ThisCmd: internal error - checkpoint number is nil");
        }
        # journal numbers are always one less than a ckptnumber...
        $ckptnumber++;
    }
    else {
        $ckptnumber = $fakeckp;
        my($foo) = $fakeckp - 1;
        $journalfile = "$CkptPname.$JnlSuffix.$foo";
    }
    return($ckptnumber, $journalfile);
}

# checkpoint the database but no journal truncate
sub CheckPointOnly {
    my($number) = @_;
    my($ckpt_output) = &ExecuteCommand("$CkptFileCmd \"$CkptPname.$CkptSuffix.$number\"");
    my($ckptnumber);
    $ckpt_output = &other2unix($ckpt_output); # make sure that everything is unix
    # Note: inspect $ckpt_output to determine checkpoint number
    unless ($printonly) {
        unless ($ckpt_output =~ /^Dumping to $CkptPname\.$CkptSuffix\.([0-9]+)/i) {
            &AbortOnError("$ThisCmd: error - trouble creating checkpoint\n$ckpt_output");
        }
        else {
            &PrintAndLog("$ckpt_output");
        }
    }
}