#!/usr/local/bin/perl # # # $Id: //guest/sandy_currier/utils/backup.pl#2 $ # # # Copyright (c) 2000, Sandy Currier ([email protected]) # 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"); } } }