#!/usr/local/bin/perl
#
#
# $Id: //guest/sandy_currier/utils/backup.pl#2 $
#
#
# 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 = 1; # whether or not to stop/start the servers
$gzip_p = 1; # whether or not to gzip
$snap_p = 0; # whether or not to snapshot a Network Appliance
@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 = "";
$P4InstallDir = "";
$DepotRoot = "";
$BackupDir = "";
$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
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
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)
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) {
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 ($CkptPname\.$JnlSuffix\.[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");
}
}
}