Updated January, 2003.
This script is very useful for DBAs who want to use Perl for doing hot backups. Perl DBI/DBD provides very close integration and control of the state of the database. It also allows real time queries that allow the script to be self-learning about what dbf's are in the database. It has been tested on 8.1.7 and 9i. This script was originally written to invoke SQL*Plus. I have updated it to use zlib and DBI/DBD connections into Oracle to control the backup.
#!/usr/bin/perl
# ------------------------------------------------------------------------
# hotarch -- hotarchive backup for Microsoft copied from ye olde shell script
# G. Patterson, Nov 2001
#
# 9/2002 Enhanced by Frank Pantaleo (The Rochester Group) to use DBI 9/2002
# 1/2003 add Parallelization of dbf's relative to the tablespace
# 1/17/2003 Code Cleanup and add more verbose messages
# Deal with gzip return codes better and a bad connection in middle of hotbackup
#
use File::Basename;
use File::Copy;
use Parallel::ForkManager;
use DBI; use Compress::Zlib;
use File::Slurp;
$MyPath = dirname($0);
$return_code = 0;
# ------------------------------------------------------------------------
sub LogMsg{
my @t = localtime(time);
printf LOG "%04d-%02d-%02d %02d:%02d %sn",
$t[5]+1900,$t[4]+1,$t[3],$t[2],$t[1],$_[0];
}
sub Compress {
$in_file=$_[0];
$out_file=$_[1];
$status=0;
open(OUTFILE,'>',$out_file)
Requires Free Membership to View
or die "could not open $out_file";
binmode INFILE;
binmode OUTFILE;
my $gz = gzopen(*OUTFILE, "wb") or die "Cannot open stdout: $gzerrnon" ;
$input = read_file($in_file);
$gz->gzwrite($input) ;
$gz->gzclose ;
close OUTFILE;
return $gz->gzerror;
}
# ------------------------------------------------------------------------
sub OraDo {
($thesql) = $_[0];
local($sthx);
$status=0;
print "OraDo $thesqln";
if (($dbh) && ($dbh->ping)) {}
else {
$dbh = DBI->connect("dbi:Oracle:", '', '',{ PrintError=>0, RaiseError =>0, ora_session_mode => 2}) or wrapup(6);
}
$sthx = $dbh->prepare($thesql) or wrapup(5);
if ($DBI::errstr) {
LogMsg "$thesqlnParse Error $DBI::errstrn";
$status=-1;
}
$sthx->execute or wrapup(5);
if ($DBI::errstr) {
LogMsg "$thesqlnExec Error $DBI::errstrn";
$status=-1;
}
$sthx->finish;
return $status;
}
# ------------------------------------------------------------------------
sub OraQry {
($thesql) = $_[0];
$status=0;
print "OraQry $thesqln";
if ($dbh->ping) {}
else {
$dbh = DBI->connect("dbi:Oracle:", '', '',{ PrintError=>0, RaiseError =>0,ora_session_mode => 2}) or wrapup(6);
}
$sth1 = $dbh->prepare($thesql) or wrapup(5);
if ($DBI::errstr) {
LogMsg "$thesqlnParse Error $DBI::errstrn";
$status=-1;
}
$sth1->execute or wrapup{5};
if ($DBI::errstr) {
LogMsg "$thesqlnExec Error $DBI::errstrn";
$status=-1;
}
return $status;
}
sub OraQry2 {
($thesql) = $_[0];
$status=0;
print "OraQry2 $thesqln";
if ($dbh->ping) {}
else {
$dbh = DBI->connect("dbi:Oracle:", '', '',{ PrintError=>0, RaiseError =>0, ora_session_mode => 2}) or wrapup(6);
}
$sth2 = $dbh->prepare($thesql) or wrapup(5);
if ($DBI::errstr) {
LogMsg "$thesqlnParse Error $DBI::errstrn";
$status=-1;
}
$sth2->execute or wrapup{5};
if ($DBI::errstr) {
LogMsg "$thesqlnExec Error $DBI::errstrn";
$status=-1;
}
return $status;
}
# ------------------------------------------------------------------------
sub stop_backup{
#
# just in case previous hotarch died an untidy death
#
local($SQL)=<ping)) {
$dbh->disconnect;
}
if ($myrtn < $return_code) {
$myrtn = $return_code;
}
if (($return_code == 0) && ($myrtn == 0)) {
LogMsg "SUCCESS: $MyName completed";
}
else {
LogMsg "FAILURE: $MyName errors in logfile";
}
close LOG;
unlink $lockfile;
unlink $stopfile;
exit($myrtn);
}
# ------------------------------------------------------------------------
sub get_log_info{
$SQL = 'select log_mode from v_$database';
$rtn=OraQry($SQL);
($arch_mode) = $sth1->fetchrow_array;
$sth1->finish;
$rtn=OraQry('select archiver from v_$instance');
($archiver) = $sth1->fetchrow_array;
$sth1->finish;
$rtn=OraQry('select value from v_$parameter where name = ' . "'" . 'log_archive_dest' . "'");
($arcdir) = $sth1->fetchrow_array;
$sth1->finish;
$rtn=OraQry('select max(recid) from v_$archived_log where ' . " archived = 'YES'");
($log_cur_seq) = $sth1->fetchrow_array;
$sth1->finish;
$rtn=OraQry('select sequence# from v_$log where ' . "archived = 'NO'");
($next_archive) =$sth1->fetchrow_array;
$sth1->finish;
}
# ------------------------------------------------------------------------
sub get_oraparm{
# retrieve parameter values from v$parameter
$SQL = 'select name from v_$database';
$rtn=&OraQry($SQL);
($orasid) = $sth1->fetchrow_array;
$sth1->finish;
}
# ------------------------------------------------------------------------
sub backup_mode{
# alter tablespace begin/end backup
my ($tsname,$mode) = $_[0], $_[1];
if($tsname) {
$SQL="alter tablespace $_[0] $_[1] backup";
$rtn=OraDo($SQL);
LogMsg "tablespace $_[0] changed $_[1]";
}
else {
return -1;
}
}
# ------------------------------------------------------------------------
sub backup_init{
$BKUPDIR= $ENV{BKUPDIR} or die "Environment missing BKUPDIR can not run!";
get_oraparm();
get_log_info();
@start = localtime(time);
$start_str = sprintf "%04d-%02d-%02d %02d:%02d:%02d",$start[5]+1900,
$start[4]+1,$start[3],$start[2],$start[1],$start[0];
$logfile = sprintf "%s/%s_%s_%02d%02d%02d.log",$BKUPDIR,$orasid,$MyName,
$start[5]%100,$start[4]+1,$start[3];
open(LOG,">$logfile") || die "error opening $logfilen";
LogMsg "$MyName started at $start_str ORACLE_SID:
$orasid ORACLE_HOME: $ENV{ORACLE_HOME} BLOCK_SIZE:
$db_block_size START_SEQNO: $log_cur_seq Archive Mode: $arch_mode";
$lockfile = "$BKUPDIR/hotarch.$orasid.lock";
$stopfile = "$BKUPDIR/hotarch.$orasid.stop";
if ((-f $lockfile) && (-M $lockfile < 1)) {
LogMsg "$MyName is already running";
wrapup(5);
}
open (LOCK,">$lockfile") || die "Cannot write to $lockfile";
print LOCK "$MyName started $start_strn";
close (LOCK) || die "$!";
#
if ($arch_mode =~ "ARCHIVELOG") {}
else {
LogMsg "Error! No Archive Mode";
wrapup(5);
}
if ($archiver =~ "STARTED") {}
else {
LogMsg "Error! Archive disabled";
wrapup(5);
}
if ($arcdir) {}
else {
LogMsg "Error! No archive log destination";
wrapup(5);
}
stop_backup();
}
# ------------------------------------------------------------------------
sub backup_control_file{
# create a backup copy of the control file
my $backup_ctrl = "$BKUPDIR" . '/' . uc($orasid) . "_CTRL.FILE";
unlink "$backup_ctrl";
$SQL = "alter database backup controlfile to '$backup_ctrl'";
$rtn=OraDo($SQL);
}
# ------------------------------------------------------------------------
sub backup_dbfs {
my %ts_array;
$pm = new Parallel::ForkManager(40);
$pm->run_on_start( sub { my ($pid, $ident) = @_; print "** $ident just got in the pool with PID $pidn"; });
$pm->run_on_finish(
sub { my ($pid, $exit_code, $ident) = @_;
print "** $ident just got out of the pool with PID $pid and exit code: $exit_coden";
if ($exit_code != 0) {
#
# If there was a problem with a compress of a dbf
# its all over but the crying. Get out now.
#
$return_code=1;
problem('$exit_code Compression failure on dbf');
}
});
$rtn=OraQry2("select distinct(tablespace_name) from dba_data_files where status ='AVAILABLE'");
while (($ts_name) = $sth2->fetchrow_array) {
$ts_array{$ts_name}= "$ts_name";
}
$sth2->finish;
while (($ts_name,$value) = each %ts_array) {
backup_mode $ts_name,"BEGIN";
$SQL= "select file_name from dba_data_files where status = 'AVAILABLE' and tablespace_name = '$ts_name' order by tablespace_name, file_name";
$rtn=OraQry($SQL);
while( ($file_name) = $sth1->fetchrow_array ) {
LogMsg "compressing $ts_name, $file_name";
($base_name)=basename($file_name);
print "Queing compress of $file_namen";
my $pid = $pm->start and next;
$in_file=$file_name;
$out_file=$BKUPDIR . '/' . $base_name . '.gz';
open(OUTFILE,'>',$out_file) or die "could not open $out_file";
binmode INFILE;
binmode OUTFILE;
my $gz = gzopen(*OUTFILE, "wb") or die "Cannot open stdout: $gzerrnon" ;
$input = read_file($in_file);
$gz->gzwrite($input) or die "Error compressing file $in_filen" ;
$gz->gzclose ;
close OUTFILE;
$rtn = $gz->gzerror;
if ($rtn == Z_OK or $rtn == Z_STREAM_END) {
$pm->finish(0);
}
else {
$pm->finish($rtn);
}
}
$pm->wait_all_children;
backup_mode $ts_name,"END";
}
}
# ------------------------------------------------------------------------
sub switch_log{
# switch_log files ... then wait for the archiver to catch up
$SQL = "alter system switch logfile";
$rtn=OraDo($SQL);
$SQL = "alter system switch logfile";
$rtn=OraDo($SQL);
do {
OraQry('select max(recid) from v_$archived_log where ' . " archived = 'YES'");
($log_nxt_seq) = $sth1->fetchrow_array;
$sth1->finish;
sleep(60);
} until $log_nxt_seq > $log_cur_seq;
}
# ------------------------------------------------------------------------
sub copy_log_files{
my $i;
my $next_log = $next_archive;
$SQL='select name from v$archived_log where ' . " ARCHIVED = 'YES'";
&OraQry($SQL);
$df_cnt = 0;
while( ($file_name) = $sth1->fetchrow_array ) {
($base_name)=basename($file_name);
if (-r "$arcdir/$base_name") {
$df_cnt++;
LogMsg "compressing & moving $file_name";
$rtn=Compress($arcdir . '/' . $base_name,$BKUPDIR . '/' . $base_name . '.gz');
if ($rtn == Z_OK or $rtn = Z_STREAM_END ) {
unlink "$arcdir/$base_name";
}
else {
LogMsg "error compressing $file_name";
$return_code=1;
}
}
else {
LogMsg "warning: archive log $file_name not here";
}
}
$sth1->finish;
}
# ------------------------------------------------------------------------
# Main ... start here:
$MyName = basename $0,".pl";
$dbh = DBI->connect("dbi:Oracle:", '', '',{ PrintError=>0, RaiseError =>0, ora_session_mode => 2}) or die "Login error to db";
backup_init();
backup_dbfs();
stop_backup();
backup_control_file();
copy ($ENV{ORACLE_HOME} . '/dbs/init' . $orasid . '.ora',$BKUPDIR);
if ($!) {
LogMsg "Error copy " . $ORACLE_HOME . '/dbs/init' . $orasid . '.ora' . " $!. Return code was $? ";
}
switch_log();
copy_log_files();
wrapup(0);
--- end ---
For More Information
- Feedback: E-mail the editor with your thoughts about this tip.
- More tips: Hundreds of free Oracle tips and scripts.
- Tip contest: Have an Oracle tip to offer your fellow DBAs and developers? The best tips submitted will receive a cool prize -- submit your tip today!
- Ask the Experts: Our SQL, database design, Oracle, SQL Server, DB2, metadata, and data warehousing gurus are waiting to answer your toughest questions.
- Forums: Ask your technical Oracle questions--or help out your peers by answering them--in our active forums.
- Best Web Links: Oracle tips, tutorials, and scripts from around the Web.
This was first published in January 2003
Join the conversationComment
Share
Comments
Results
Contribute to the conversation