Perl module xmpPerl.pm – function package used by DBA Perl scripts
This perl module contains all functions need by xmp perl scripts, published at www.ruban.de. You should easily adapt some constant values to your pesonal needs.
Some comments are in german. If you need assistence, don’t hesitate to contact me.
#!/usr/local/bin/perl -w
################################################################################
# DBA Perl function package:
# - deploy with "use xmpPerl;"
# - execute a function by "xmpPerl::fn(...);", where fn=function listed below
#-------------------------------------------------------------------------------
# @|$ = trim(@|$); Cut-off Leading/Trailing Blanks
# $ = doCmdOut($); Run External Command and return Output
# $ = doDB2CmdOut(db u p cmd); Run DB2 Command and return Output, incl. Connect
# $ = getSqllibPath(); DB2 Path suchen in PATH und z’ckgeben
# $ = getTimestamp(); Datum/Uhrzeit im DB2 Timestamp Format
# $ = getTime(); Uhrzeit
# - = LogLine(@|$); Meldung in Log protokollieren, ruft ...File|Table
# - = LogLineFile(@|$); Meldung in Log File protokollieren
# - = LogLineTable(@|$); Meldung in Log Table protokollieren
# $ = getProcDescr(); Für Process ID den Process Namen und Argumente
# $ = getDBMCfgValue(var); Liefert Wert eines DBM Config Parameters
# $ = getDBCfgValue(db,var); Liefert Wert eines Database Config Parameters
# $ = getDBAUser(); Liefert Wert der lP_LUS Umgebungsvariablen
# $ = getDBAPsw(); Liefert Wert der lP_LPW Umgebungsvariablen
# $ = getDBALog(); Liefert Wert der lP_LOG Umgebungsvariablen oder Default
# $ = getDBALDB(); Liefert Wert der lP_LDB Umgebungsvariablen oder Default
# $ = getCTRL(); Liefert Wert der lP_CTRL Umgebungsvariablen oder Default
# - = prtHeaderDB2($); Gibt einen Informationblock aus für Scripts mit DB2
# - = prtHeader($); Prints block of information for non-DB2 scripts
# - = chkDB2(); Checks existence of DB2
# $ = getDB2Version(); Provides DB2 version and release number
# $ = MailText(); Sends text via sendmail IP command
# $ = getDB2AddressMode(); Provides addressing mode (32 or 64 bit)
#-------------------------------------------------------------------------------
# Changes - GR / 10.01.00 erste Version
# G.Ruban / 02.02.2000 V1.1 neue Funktion getDBCfgValue und getDBMCfgValue,
# getDBALog
# G.Ruban / 02.02.2000 V1.1 in LogLineTable den Empfang der Argumente korrigiert
# G.Ruban / 29.05.2000 V1.2 getDBAUser/getDBAPsw: User und Passwort aus Umgebungs-
# variablen, doDB2CmdOut um Parms -u und -p erweitert,
# G.Ruban / 31.05.2000 V1.3 neue Funktion prtHeader(), getINSTHOME, chkDB2
# und getDBALDB angelegt, LogLine...'s überarbeitet
# G.Ruban / 13.07.2000 V1.3.1 Logging in DBA Control DB problematisch, deswegen
# nur Logging in File, getProcDescr geändert
# G.Ruban / 28.08.2000 V1.3.2 Log Path für mydbadmin.log aus ENV Variable, falls vorh.
# G.Ruban / 29.08.2000 V1.3.2 chmod für mydbadmin.log wg. Permissions, sysopen wirkungslos
# G.Ruban / 17.07.2001 V1.3.3 neue Funktion getDB2Version()
# G.Ruban / 05.12.2001 V1.3.4 neue Funktion MailText(), neue Variable lP_CTRL
# G.Ruban / 11.12.2001 V1.3.5 neue Funktion getTime()
# G.Ruban / 19.12.2001 V1.3.5 Korrektur beim Einlesen von Recipient Lists
# G.Ruban / 30.01.2002 V1.3.6 Delete temporary file if work has been done
# G.Ruban / 12.02.2002 V1.3.6 Fixed problem with temp files
# G.Ruban / 21.01.2003 V1.3.7 New function prtHeader()
# G.Ruban / 21.07.2003 V1.3.8 chkDB2 extended with new checks
# G.Ruban / 13.01.2004 V1.4 Adapted to DB2 V8.1
# G.Ruban / 14.04.2004 V1.4.1 Adaptation to DB2 V8.1 correct for DB2Version+AddressMode
# G.Ruban / 15.06.2010 V1.4.2 LogLineTable set into comments (currently not used)
#-------------------------------------------------------------------------------
# Comments - $drh = DBI Driver Handle
# $dbh = DBD Database Handle
# $sth = SQL Statement Handle
# - PERL5LIB Environment Variable muss auf Perl Module Pfad zeigen,
# damit dieses Modul in Perl Scripts eingebunden werden kann.
################################################################################
package xmpPerl;
use vars qw(@ISA @EXPORT @EXPORT_OK);
use Exporter;
use Fcntl; # V1.3.2 File Constants
use strict; # strikte semantische/syntaktische Prüf.
use File::Basename; # V1.3.6
################################################################################
# Konstanten {Prefix lP für alle Package Variablen}
################################################################################
my $lP_VER = "1.4.2"; # Package Version
my $lP_PRG = "xmpPerl.PM"; # Program Name
# Logging Variablen: ###################
my $lP_LTB = "TLX90000"; # Logging Table by package
my $lP_LTC = "xmpDBA"; # Logging Table Creator function
my $lP_LOG = "/opt/dba/log/mydbadmin.log"; # Logging File
my $lP_CTRL= "/opt/dba/ctrl"; # Control File Path
################################################################################
# Export von Variablen (würden die Funktionsnamen ebensfalls aufgeführt, dann
# könnte in den nutzenden Moduln das Prefix "xmpPerl::" entfallen!
################################################################################
@ISA = ('Exporter');
@EXPORT = qw($lP_VER $lP_PRG $lP_LDB $lP_LTB $lP_LTC $lP_LUS $lP_LPW $lP_LOG $lP_CTRL);
################################################################################
# getDBALog: liefert Inhalt der Variablen lP_LOG zurück (Pfad für DBA-Meldungen)
################################################################################
sub getDBALog {
my $OS = ucfirst $^O;
if (! defined $ENV{lP_LOG}) {
if (! defined $ENV{xmpDBADIR})
{ if ($OS eq "Aix") { return "/opt/dba/log/mydbadmin.log";}
if ($OS eq "Solaris") { return "/opt/dba/log/mydbadmin.log";}
}
else { return trim($ENV{xmpDBADIR}."/log/mydbadmin.log") }
}
else { return trim($ENV{lP_LOG});
}
}
################################################################################
# getCTRL: liefert Inhalt der Variablen lP_CTRL zurück (Pfad für Control Files)
################################################################################
sub getCTRL {
my $OS = ucfirst $^O;
if (! defined $ENV{lP_CTRL}) {
if (! defined $ENV{xmpDBADIR})
{ if ($OS eq "Aix") { return "/opt/dba/ctrl";}
if ($OS eq "Solaris") { return "/opt/dba/ctrl";}
}
else { return trim($ENV{xmpDBADIR}."/ctrl") }
}
else { return trim($ENV{lP_CTRL});
}
}
################################################################################
# getDBAUser: liefert Inhalt der Variablen lP_LUS (autorisierte DB2 User) zurück
################################################################################
sub getDBAUser {
if (! defined $ENV{lP_LUS})
{ return ""; }
else
{ return trim($ENV{lP_LUS}); }
}
################################################################################
# getDBAPsw: liefert Inhalt der Variablen lP_LPW (Password DB2 User) zurück
################################################################################
sub getDBAPsw {
if (! defined $ENV{lP_LPW})
{ return ""; }
else
{ return trim($ENV{lP_LPW}); }
}
################################################################################
# getDBALDB: liefert Inhalt der Variablen lP_LDB (DBA Logging Database) zurück
################################################################################
sub getDBALDB {
if (! defined $ENV{lP_LDB})
{ return ""; }
else
{ return trim($ENV{lP_LDB}); }
}
################################################################################
# trim: Cut-off Leading/Trailing Blanks
################################################################################
sub trim {
my @out = @_;
for (@out) {
s/^\s+//;
s/\s+$//;
}
return wantarray ? @out : $out[0];
}
################################################################################
# doCmdOut: Run External Command and return Output
################################################################################
sub doCmdOut {
my $output;
open(xmptmp,"@_ |") or die ">>>Kann externen Command nicht ausführen!\n".
"RC=$!\nCMD=@_\n";
while() {
$output .= $_; # concat Output Lines
}
close(xmptmp);
return $output;
}
################################################################################
# doDB2CmdOut: Run DB2 Command and return Output, Connect to DB if necessary
################################################################################
sub doDB2CmdOut {
my ($opt_d, $opt_u, $opt_p, $opt_c);
my $output;
my $connect = 0;
my $work;
################################################################################
# get database and db2 command
################################################################################
($opt_d , $opt_u, $opt_p, $opt_c ) = @_;
################################################################################
# already connected or not
################################################################################
$work = &doCmdOut("db2 connect");
if ( $work =~ "SQLSTATE=08003") { # connection does not exist
$work = "db2 connect to $opt_d user $opt_u using $opt_p";
$output = &doCmdOut($work);
if ($output !~ "Connection Information") {
return $output; } # connect failed
}
else { $connect = 1 } # already connected
################################################################################
# execute DB2 command
################################################################################
$output = &doCmdOut($opt_c);
################################################################################
# disconnect, if necessary
################################################################################
if ($connect == 1) {$work = &doCmdOut("db2 connect reset")}
return $output;
}
################################################################################
# getSqllibPath: DB2 Library Path ermitteln
################################################################################
sub getSqllibPath {
use Env;
my $work;
my @work;
my $LP = "";
$work = trim($ENV{PATH}); # Environment Variable set by DB2
@work = split(/:/,$work); # remove separator
foreach $work (@work) { # search list for sqllib
if ($work =~ /sqllib/) {
$LP = $work;
last;
}
}
return $LP; # undefined if not found
}
################################################################################
# getTimestamp: Datum im DB2 Timestamp Format ermitteln
################################################################################
sub getTimestamp {
my $TS;
$TS = `date +%Y-%m-%d-%H.%M.%S`; # yyyy-mm-dd-hh.mm.ss
$TS = &trim($TS);
$TS.= ".000000"; # milliseconds = 0
return $TS;
}
################################################################################
# getTime: Datum im DB2 Timestamp Format ermitteln
################################################################################
sub getTime {
my ($s,$m,$h);
($s,$m,$h) = (localtime)[0,1,2]; # Local Time
$s = sprintf("%02u",$s); # rechtsbündig mit 0
$m = sprintf("%02u",$m); # rechtsbündig mit 0
$h = sprintf("%02u",$h); # rechtsbündig mit 0
return "$h:$m:$s"; # hh:mm:ss
}
################################################################################
# LogLine: Message in DBA Log File und Table schreiben
################################################################################
sub LogLine {
&LogLineFile(@_);
# &LogLineTable(@_); # inaktiviert 11.07.2000/GR
}
################################################################################
# getDB2AddressMode: Provide DB2 Addressing Mode 23/64 Bit 13.01.04
################################################################################
sub getDB2AddressMode {
my $V="";
my $Vl;
my @VA;
&chkDB2(); # Check DB2 existence
$V = &doCmdOut("db2level");
@VA = split(" ",$V);
$V = &trim($VA[5]); # 6th word
if ($V =~ "bits") { # indicator
$V = &trim($VA[4]); # 5th word
$Vl = length($V); # V1.4.1 [moved]
$V = substr($V,1,$Vl-2); # V1.4.1: skip 1, cut off 1(+1)
}
else {$V = "n/a" } # unknown/not available
#$Vl = length($V);
#$V = substr($V,1,$Vl-2); # skip 1, cut off 1(+1)
return $V; # returns >32< or >64< } ################################################################################ # getDB2Version: Provide DB2 Release and Version Information 17.07.01 ################################################################################ sub getDB2Version { my $V=""; my $Vl; my @VA; my $flag = 0; # V1.4.1 &chkDB2(); # Check DB2 existence V1.3.8 # db2licm -v works fine with V6 and V7, but not with V5 $V = &doCmdOut("db2level"); if ($V =~ "bits") { # V1.4.1: new with V8.x $flag = 1; # V1.4.1: set flag } @VA = split(" ",$V); # split string into words if ($flag) { # V1.4.1: indicates V8.x $V = &trim($VA[19]) } # 20th word else { $V = &trim($VA[16]) } # 17th word #$V = &trim($VA[16]); # 17th word #if ($V !~ "DB2 v") { # V1.4 does not contain version prefix # $V = &trim($VA[19]); # 20th word #} $Vl = length($V); $V = substr($V,1,$Vl-3); # skip 1, cut off 2(+1) return $V; } ################################################################################ # LogLineFile: Message in DBA Log File schreiben ################################################################################ sub LogLineFile { my $hMSGLOG; # Log Datei Handle my $UDT; # Auf Message Log schreiben, sofern möglich ############################ $UDT = &getTimestamp(); $UDT = substr($UDT,0,19); if ( open(hMSGLOG, ">> $lP_LOG") ) {
print hMSGLOG "$UDT @_\n";
close(hMSGLOG);
chmod 0664,$lP_LOG;
return 0;}
else { print ">>> $lP_PRG Es kann nicht in $lP_LOG geschrieben werden.\n";
print ">>> $lP_PRG Letzte Meldung lautete: $UDT @_\n";
return 8;}
}
################################################################################
# LogLineTable: Message in DBA Log Table schreiben
# Arguments : (1) Application
# (2) State
# (3) Message
################################################################################
#sub LogLineTable { # V 1.4.2 deactivated
#
# # Modules ####################################################################
# use DBI;
# use DBD::DB2::Constants;
# use DBD::DB2;
# use Sys::Hostname;
#
# my ($hostname,$udt,$stmt);
#
# use Getopt::Std;
# use vars qw($opt_a $opt_s $opt_t $opt_d $opt_u $opt_p);
#
# # Argumente ############################################################
# getopts("a:s:t:d:u:p:");
# if ( (! defined $opt_a ) # Application
# or (! defined $opt_s ) # Severity
# or (! defined $opt_d ) # DBA Database
# or (! defined $opt_u ) # User
# or (! defined $opt_p ) ) { # Password
# &LogLineFile(">>> $lP_PRG Problem mit Connect to $opt_d");
# &LogLineFile(">>> $lP_PRG ".$DBI::errstr);
# &LogLineFile("@_");
# return 8;
# }
#
# # DBI Switches #########################################################
# my $switch = DBI->internal;
# $switch->debug(0); # 1=normal debug, 2=detailed handle trace
#
# # Connect to Database ##################################################
# my $dbh = DBI->connect("dbi:DB2:$opt_d",
# $opt_u,
# $opt_p,
# { PrintError => 0, # don't print error by default
# RaiseError => 0, # don't print error and die by default
# AutoCommit => 1, # don't commit after each statement
# ChopBlanks => 0, # don't remove trailing blanks on CHAR-Types
# } );
# if (!$dbh) {
# &LogLineFile(">>> $lP_PRG Problem mit Connect to $opt_d");
# &LogLineFile(">>> $lP_PRG ".$DBI::errstr);
# &LogLineFile("@_");
# return 8;
# }
# else {
# # Build and Execute SQL Statement ######################################
# $hostname = hostname();
# $udt = &getTimestamp();
# $stmt = "INSERT INTO $lP_LTC.$lP_LTB
# (HOST, APPLICATION, STATE,
# MESSAGE, TIMESTAMP)
# VALUES ('$hostname','$opt_a', '$opt_s','$opt_t','$udt')";
# my $sth = $dbh->prepare($stmt);
# $sth->execute();
# if ( $dbh->err ) {
# &LogLineFile(">>> $lP_PRG Problem mit Insert into $opt_d");
# &LogLineFile(">>> $lP_PRG ".$DBI::errstr);
# &LogLineFile("@_");
# return 8;
# }
# # Disconnect from Database #####################################
# $sth->finish();
# $dbh->disconnect();
# }
#}
################################################################################
# getProcDescr: zu einer Process ID den Command und Argument verschaffen
################################################################################
sub getProcDescr {
my $id;
# execute PS command, ignore Output line containing the word COMMAND ###
$id = &doCmdOut("ps -p " . getppid . " -f | grep -v CMD");
$id = "PS=".&trim($id);
return $id;
}
################################################################################
# getDBMCfgValue: zu einem DBM Config Parameter den Wert ermitteln
################################################################################
sub getDBMCfgValue {
my $work;
my @work;
my $var;
my $val;
################################################################################
# Beschaffen der Datenbank Manager Configurationsvariablen
################################################################################
$work = &doCmdOut("db2 get dbm cfg");
@work = split("\n",$work);
# print "$#work lines returned from DB2 GET DBM CFG Command.\n";
foreach $work (@work) {
($var,$val) = split("=",$work);
if (! defined $var) {$var = "";}
if (! defined $val) {$val = "";}
$var = uc &trim($var);
# $val = uc &trim($val);
#######################################################################
if ($var =~ "@_") { # gesuchte Variable gefunden
$val = &trim($val); # nochmals Blanks entfernen
return $val; # Ja, denn Wert zur’ckgeben
}
}
return;
}
################################################################################
# getDBCfgValue: zu einer Datenbank von einem Config Parameter den Wert ermitteln
################################################################################
sub getDBCfgValue {
my $work;
my @work;
my $var;
my $val;
my ($opt_d, $opt_v);
################################################################################
# Argument sind Database und Database Cfg Variable (z.B. MAXAPPLS)
################################################################################
($opt_d , $opt_v ) = @_;
################################################################################
# Beschaffen der Datenbank Configurationsvariablen
################################################################################
$work = &doCmdOut("db2 get db cfg for $opt_d");
@work = split("\n",$work);
# print "$#work lines returned from DB2 GET DB CFG FOR $opt_d Command.\n";
foreach $work (@work) {
($var,$val) = split("=",$work);
if (! defined $var) {$var = "";}
if (! defined $val) {$val = "";}
$var = uc &trim($var);
# $val = uc &trim($val);
#######################################################################
if ($var =~ "$opt_v") { # gesuchte Variable gefunden
$val = &trim($val); # nochmals Blanks entfernen
return $val; # Ja, denn Wert zur’ckgeben
}
}
return;
}
################################################################################
# prtHeaderDB2: Gibt Informationsblock für Scripts mit DB2 Nutzung aus
################################################################################
sub prtHeaderDB2 {
use Env;
use Sys::Hostname;
my $DB2INSTANCE;
my $DB2Version; # 17.07.2001
my $DB2AMode; # 13.01.2004
my $UDT;
my $SSID;
my $HOST;
my $OS;
########################################################################
# Environment and Shell Variables
########################################################################
$UDT = &trim(getpwuid($>>Cannot locate path to an DB2 Instance e.g. .../sqllib/...\n".
">>>Please add DB2 instance PATH (see db2profile script).\n".
">>>Cannot execute DB2 Perl script as requested - ABEND";
}
########################################################################
# Kann db2 im Pfad lokalisiert werden?
########################################################################
if (&doCmdOut("which db2") =~ "no db2 in")
{die ">>>Cannot locate 'db2' in current enviroment.\n".
">>>Please add DB2 instance PATH (see db2profile script).\n".
">>>Cannot execute DB2 Perl script as requested - ABEND";
}
}
################################################################################
# MailText: Sends Text (File) using Recipient (List File)
# returns recipient(s) ID
################################################################################
sub MailText {
my ($opt_a, $opt_v, $opt_t);
my ($rlist, $text, $dmr, $dmt);
my $tempfile;
my $work;
my $hFile;
my ($pak,$script,$line) = caller(0);
########################################################################
# Get arguments: Application Name, Recipient (File), Text (File)
########################################################################
($opt_a, $opt_v , $opt_t ) = @_;
#print "a=$opt_a v=$opt_v t=$opt_t\n";
if ( (! defined $opt_a ) # Application
or (! defined $opt_v ) # Recipient (File)
or (! defined $opt_t ) # Text (File)
or ($opt_a eq "" ) # Application
or ($opt_v eq "" ) ) { # Recipient (File)
print ">>>xmpPerm.pm: Invalid options specified for function MailText()\n";
exit 16;
}
########################################################################
# Recipient is single ID or name of a recipient file
########################################################################
$dmr = "";
if (-r $opt_v) {
$dmr = $opt_v; # correct file name
}
else {
#####################################################################
# File exists in /opt/dba/ctrl ?
#####################################################################
if (-r &getCTRL()."/".$opt_v) { # file in /opt/dba/ctrl?
$dmr = &getCTRL()."/".$opt_v;
}
}
#print "opt_v->$dmr\n";
########################################################################
# Text is a string or name of a text file
########################################################################
$text = $opt_t;
$dmt = "";
if (-r $opt_t) {
$dmt = $opt_t; # correct file name
}
########################################################################
# Open temporary file to create mail text file, add recipient(s)
########################################################################
$script = basename($script);
$tempfile="/tmp/$script.$$-0";
#print "==> TEMPFILE=$tempfile\n";
if (! open(hFile, "> $tempfile") ) {
die ">>>$0 cannot write into $tempfile. \n".
"abends";
}
########################################################################
# Argument contains recipient file name or single recipient mail id
########################################################################
if ($dmr ne "") { # Yes, it is a file
#####################################################################
# Read recipient id's from file
#####################################################################
$/ = "\n"; # input record separator
if (! open(xmptmp,") {
next if /#/; # skip comment line
next if /^$/; # skip blank line
print hFile "$_"; # print line to text file
$rlist .= $_; # concat lines
}
close(xmptmp);
if ($rlist eq "") {
print ">>>$0 read $dmr successfully\n".
">>>but did not determine any E-Mail ID - please check file!\n".
">>>Program sendmail will fail with 'No recipient addresses found in header'\n";
}
#####################################################################
# Attention: Do not allow blank lines between To:, Cc:, Bcc:, Subject:
#####################################################################
}
else {
print hFile "To:$opt_v\n"; # print id to text file
$rlist = "To:$opt_v";
}
########################################################################
print hFile "Subject: ". uc hostname().": '$opt_a' at ".&getTimestamp()."\n";
print hFile "-----------------------------------------------------------\n";
print hFile "Automatic generated Mail Messsage from ...\n";
print hFile "Host ..........: ". uc hostname()."\n";
print hFile "Application ...: $opt_a\n";
print hFile "Created at ....: ".&getTimestamp()."\n";
print hFile "-----------------------------------------------------------\n";
########################################################################
# Text is a string or name of a text file
########################################################################
if ($dmt ne "") { # Yes, it is a file
open(xmptmp,") {
print hFile "$_"; # each line
}
close(xmptmp);
}
else {
print hFile "$text\n"; # only text passed
}
print hFile ".\n"; # end of mail
close(hFile); # close tempfile
########################################################################
# Send mail using sendmail program
########################################################################
system("/usr/lib/sendmail -t < $tempfile"); die ">>>xmpPerl.pm: /usr/lib/sendmail -t < $tempfile ends with RC=$?\n" unless $?==0;
unlink($tempfile);
return $rlist;
}
1;
Comments
Comments are closed.