Edit D:\app\Administrator\product\11.2.0\dbhome_1\sysman\admin\scripts\db\db

Edit D:\app\Administrator\product\11.2.0\dbhome_1\sysman\admin\scripts\db\db_common.pl

# $Header: emdb/sysman/admin/scripts/db/db_common.pl /st_emdbsa_11.2/1 2009/01/27 16:16:46 mmootha Exp $
#
# db_common.pl
#
# Copyright (c) 2002, 2008, Oracle and/or its affiliates. All rights reserved.
#
#    NAME
#      db_common.pl - <one-line expansion of the name>
#
#    DESCRIPTION
#      db_common.pl contains common routines for DB utility applications, such

#      dbclone, rman, and data utilities.
#
#    NOTES
#      <other useful comments, qualifications, etc.>
#
#    MODIFIED   (MM/DD/YY) 
#    rimmidi     07/30/08 - Code slap from 10205 to 11.2DBControl
#    mreddych    02/13/08 - Backport mreddych_bug-6728722 from
#                           st_emgc_10.2.0.1.0
#    sxzhu       03/15/07 - Modify permission for mkDir
#    sxzhu       02/08/07 - Get ORACLE_BASE on NT
#    vrajendr    01/11/07 - XbranchMerge vrajendr_bug-5642432 from main
#    vrajendr    11/10/06 - Bug# 5642432 : Fixed hardcoded temp dir location
#    sxzhu       06/21/05 - Add Linux as an OS type 
#    sxzhu       02/11/05 - Add doubleBackSlashes() 
#    sxzhu       10/07/04 - Fix debug info for filesReadPermission 
#    sxzhu       09/23/04 - Fix bug 3895311: dir command for Win2003 server 
#    szhu        04/14/04 - Do not use oradim to get registry value 
#    szhu        03/08/04 - Fix bug 3479581: use NT buildin command dir 
#    szhu        02/23/04 - Pass in OH to get TNS_ADMIN on NT 
#    szhu        02/11/04 - Fix bug 3437678: disk space check on Win2k 
#    szhu        01/09/04 - Get TNS_ADMIN from registry on NT 
#    szhu        12/09/03 - Handle temp locationon on NT 
#    ngade       09/19/03 - nt fix -bug 3134969 
#    ngade       09/18/03 - fix bug 3138944
#    szhu        08/07/03 - Differentiate NT and XP
#    szhu        08/05/03 - NT support 
#    gallison    06/16/03 - 
#    sjconnol    06/13/03 - Bug 2983009: Add default group to isDBAMember
#    szhu        06/05/03 - Get ORACLE_BASE and TNS_ADMIN env variables
#    szhu        04/08/03 - Set TNS_ADMIN env variable
#    szhu        03/31/03 - Add copyFile2()
#    szhu        03/19/03 - Add dirsPermission()
#    szhu        02/06/03 - Change dilimiter
#    sjconnol    02/05/03 - Set delimeter to :
#    szhu        01/31/03 - Change parameter delimiter
#    ngade       01/31/03 - add multiple file support for fileReadPermission
#    pbantis     01/27/03 - Fix perl script compilation error
#    sjconnol    01/22/03 - Add isDBAMember
#    szhu        01/24/03 - More on findNearestExistingParentDir
#    sjconnol    01/20/03 - Change findNearestExistingParentDir and dirWritePermission
#    szhu        01/15/03 - dirWritePermission and dirReadPermission
#    szhu        01/14/03 - Add findNearestExistingParentDir
#    sjconnol    01/10/03 - Modify mkDir error handling
#    ngade       01/02/03 - set_env_var based on db version
#    sjconnol    01/03/03 - set_env_var: add to LD_LIBRARY_PATH, not replace
#    ngade       11/04/02 - fix bug 2650042
#    ngade       10/23/02 - add fileExecute permission check
#    sjconnol    09/27/02 - Add platform-specific flags section
#    ngade       09/23/02 - add fileReadPermission
#    szhu        09/20/02 - Add removeFileWithPrefix()
#    szhu        09/12/02 - Add mkDirs(), getBasename(), getDirname()
#    sjconnol    09/11/02 - Add some debugging to copyFile()
#    szhu        09/06/02 - Add dirsExist() and removeDir()
#    szhu        08/15/02 - Add removeFilesInDir()
#    ngade       08/08/02 - Modify CLEANUP=>1
#    szhu        08/06/02 - Add getting existence status for multiple files
#    rgiroux     08/02/02 - begin 10i support
#    szhu        07/28/02 - Handle platform dependency for getFreeSpace
#    szhu        07/22/02 - szhu_db_common
#    szhu        07/22/02 - Creation
#

require "emd_common.pl";

use strict;
use File::Basename;
use File::Copy;
use File::Temp qw/ tempfile tempdir /;
use vars qw($OS $NT $S $TEMP $CP $MV $PS $DF $DELIMITER $Registry);

#A temporary solution and will be removed after EMD supports this setting
#in logging.xml.
#$ENV{EMAGENT_PERL_TRACE_LEVEL} = 0;  #DEBUG level.

#### GLOBAL Platform-specific flags for all EM OSs ####
if($^O =~ /solaris/i){
  $OS = "SOL2";
 $NT = 0;
  $S = '/';
  $TEMP = "/tmp";
 $CP = "/bin/cp";
 $MV = "/bin/mv";
 $PS = "/bin/ps";
  $DF = "/bin/df -k"
}
elsif($^O =~ /MSWin32/i){
  $OS = "NT";
 $NT = 1;
  eval 'use Win32::TieRegistry';
  $S = '\\';
 if(exists($ENV{TMP})){
  $TEMP = $ENV{TMP};
 }
 elsif(exists($ENV{TEMP})){
  $TEMP = $ENV{TEMP};
 }
 else{
  $TEMP = $ENV{SYSTEMDRIVE} . "\\temp"; # Bug# 5642432
 }
 ## The %SystemDrive% variable seems to come back in TEMP;
 ##  substitute in the value
 $TEMP =~ s/%SystemDrive%/$ENV{SYSTEMDRIVE}/i;
 $CP = "copy";
 $MV = "rename";
 $PS = "ps";
}
elsif($^O =~ /aix/i){
  $OS = "AIX";
  $NT = 0;
  $S = '/';
  $TEMP = "/tmp";
 $CP = "/bin/cp";
 $MV = "/bin/mv";
 $PS = "/bin/ps";
  $DF = "/bin/df -Pk"
}
elsif($^O =~ /linux/i){
  $OS = "LINUX";
  $NT = 0;
  $S = '/';
  $TEMP = "/tmp";
 $CP = "/bin/cp";
 $MV = "/bin/mv";
 $PS = "/bin/ps";
  $DF = "/bin/df -k"
}
elsif($^O =~ /hpux/i){
  $OS = "HPUX";
  $NT = 0;
  $S = '/';
  $TEMP = "/tmp";
	$CP = "/bin/cp";
	$MV = "/bin/mv";
	$PS = "/bin/ps";
  $DF = "/usr/bin/bdf"
}
## Operating system unknown (probably Unix)
else{
  $OS = "";
 $NT = 0;
  $S = '/';
  $TEMP = "/tmp";
	$CP = "/bin/cp";
	$MV = "/bin/mv";
	$PS = "/bin/ps";
  $DF = "/bin/df -k"
}

sub isWinOS
{
  my $isWin = "NOK";
  if($^O =~ /MSWin/i)
   {
     $isWin = "OK";
   }
   return $isWin;
}

## The delimiter is used to separate paramters passed in perl routines from Java
## code.  In most cases, it is used to separate file names.
$DELIMITER = ":::";

# --------- OS platform-specific (for "getFreeSpace" only) -------------

# Run command $df, the free space information shows at $row (usually the last
# row) and $column.  If the unit is K-bytes, $divide = 1, if bytes, $divide = 1024.
# paramForGetFreeSpace()
sub paramForGetFreeSpace
{
  my $df = ""; 
  my $row = "";
  my $column = "";
  my $divide = "";

if($^O =~ /MSWin32/i)
  {
    EMD_PERL_DEBUG("db_common.paramForGetFreeSpace(): OS platform: MSWin32");
    $ENV{dircmd}="";
    my $cmd = $ENV{ComSpec}." /c";
    $df = "$cmd dir /ad /-c";
    $row = -1;

#For XP, W2K, Win2003 server
    #Expect this format will continue for later versions
    $column = 2;

my $NTorXP= `ver`;
    if($NTorXP =~ "NT")
    {
      $column = 0;
    }
    
    $divide = 1024;
  }
  # This should cover all UNIX variants
  else #may be Unix
  {
    EMD_PERL_DEBUG("db_common.paramForGetFreeSpace(): OS platform: UNIX");
    $df = "$DF .";
    $row = -1;
    $column = 3;
    $divide = 1;
  }

return ($df, $row, $column, $divide);
}
# --------- OS platform-specific (END) -----------------------------------

# Set environment variables
# set_env_var(oracleHome, oracleSid)
sub set_env_var
{
    my $PATH_SP= ":";
    if($NT)
    {
	$PATH_SP=";";
    }
    ($ENV{ORACLE_HOME},$ENV{ORACLE_SID}, my $isDB10iOrHigher, my $tns) = @_;

if(defined($ENV{LD_LIBRARY_PATH})){
    $ENV{LD_LIBRARY_PATH} = "$ENV{ORACLE_HOME}${S}lib${PATH_SP}$ENV{LD_LIBRARY_PATH}";
	}
	else{
    $ENV{LD_LIBRARY_PATH} = "$ENV{ORACLE_HOME}${S}lib";
	}

if(defined($ENV{SHLIB_PATH})){
    $ENV{SHLIB_PATH} = "$ENV{ORACLE_HOME}${S}lib${PATH_SP}$ENV{SHLIB_PATH}";
	}
	else{
    $ENV{SHLIB_PATH} = "$ENV{ORACLE_HOME}${S}lib";
	}

if(defined($ENV{LIBPATH})){
    $ENV{LIBPATH} = "$ENV{ORACLE_HOME}${S}lib${PATH_SP}$ENV{LIBPATH}";
	}
	else{
    $ENV{LIBPATH} = "$ENV{ORACLE_HOME}${S}lib";
	}

if(defined($ENV{PATH})){
    $ENV{PATH} = "$ENV{ORACLE_HOME}${S}bin${PATH_SP}$ENV{PATH}";
	}
	else{
    $ENV{PATH} = "$ENV{ORACLE_HOME}${S}bin";
	}

if (!defined($isDB10iOrHigher))
  {
    $isDB10iOrHigher = "FALSE";
  }
  if($isDB10iOrHigher =~ /TRUE/i)
  {
    $ENV{ORA_NLS} = "$ENV{ORACLE_HOME}${S}nlsrtl${S}admin${S}nlsdata";
    $ENV{ORA_NLS32} = "$ENV{ORACLE_HOME}${S}nlsrtl${S}admin${S}nlsdata";
    $ENV{ORA_NLS33} = "$ENV{ORACLE_HOME}${S}nlsrtl${S}admin${S}nlsdata";
  }
  else
  {
    $ENV{ORA_NLS} = "";
    $ENV{ORA_NLS32} = "";
    $ENV{ORA_NLS33} = "";
  }

#not sure what should be the right behavior
  #provide ways to set TNS_ADMIN
  if(!$tns)
  {
    if(defined($ENV{TNS_ADMIN})){
      #$ENV{TNS_ADMIN} = "$ENV{ORACLE_HOME}${S}network${S}admin${PATH_SP}$ENV{TNS_ADMIN}";
    }
    else{
      $ENV{TNS_ADMIN} = "$ENV{ORACLE_HOME}${S}network${S}admin";
    }
    if($NT)
    {
      $ENV{TNS_ADMIN} = getTNS_ADMINOnNT();
    }
  }
  else
  {
    $ENV{TNS_ADMIN} = "$tns";
  }
  
  EMD_PERL_DEBUG("db_common.set_env_var(): ORACLE_HOME: $ENV{ORACLE_HOME}");
  EMD_PERL_DEBUG("db_common.set_env_var(): ORACLE_SID: $ENV{ORACLE_SID}");
  EMD_PERL_DEBUG("db_common.set_env_var(): LD_LIBRARY_PATH: $ENV{LD_LIBRARY_PATH}");
  EMD_PERL_DEBUG("db_common.set_env_var(): SHLIB_PATH: $ENV{SHLIB_PATH}");
  EMD_PERL_DEBUG("db_common.set_env_var(): LIBPATH: $ENV{LIBPATH}");
  EMD_PERL_DEBUG("db_common.set_env_var(): PATH: $ENV{PATH}");
  EMD_PERL_DEBUG("db_common.set_env_var(): ORA_NLS: $ENV{ORA_NLS}");
  EMD_PERL_DEBUG("db_common.set_env_var(): ORA_NLS32: $ENV{ORA_NLS32}");
  EMD_PERL_DEBUG("db_common.set_env_var(): ORA_NLS33: $ENV{ORA_NLS33}");
  EMD_PERL_DEBUG("db_common.set_env_var(): TNS_ADMIN: $ENV{TNS_ADMIN}");
}

# Create a temporary file
# create_temp_file()
# return fileHandle and fileName
sub create_temp_file
{
  my ($suffix) = @_;
  my $dir = tempdir(CLEANUP => 1);
  my $temp_fh;
  my $temp_filename;
  
  if(defined($suffix))
  {
     ($temp_fh, $temp_filename) = tempfile(DIR => $dir, SUFFIX => $suffix );
  }
  else
  {
    ($temp_fh, $temp_filename) = tempfile(DIR => $dir);
  }
  
  EMD_PERL_DEBUG("db_common.create_temp_file(): Temp file name: $temp_filename");

#For NT only
  &tempLocFallback();
  
  if(!$NT)
  {
    #cd to OH to deal with a perl behavior change
    #When removing the temp file/dir, the perl executor needs r+x permission
    #in the current directory.
    #When executing remote ops, the current dir is agent sysman/emd dir,
    #which does not give r+x permission to g+o users.
    #Change to OH, which gives r+x to g+o.
    #If callers change to other dir after calling this sub, we assume they
    #have r+x permission in the dir, otherwise, they could not chdir to there.
    chdir $ENV{ORACLE_HOME}
      or (chdir $TEMP);
  }
  
  return ( $temp_fh, $temp_filename);
}

# This method is platform specific, will be dealt with later.
# Get free space (KB) for a given directory
# getFreeSpace(dirName)
sub getFreeSpace
{
  my ($dirName) = @_;
  EMD_PERL_DEBUG("db_common.getFreeSpace(): Passed in dir: $dirName");
  $dirName = &findNearestExistingParentDir($dirName);
  EMD_PERL_DEBUG("db_common.getFreeSpace(): cd to the nearest existing parent dir: $dirName");
  chdir($dirName)
    or (((EMD_PERL_ERROR("db_common.getFreeSpace(): chdir $dirName failed")) && return "-1") || (return "-1"));
  my $freeKB = 0;

(my $df, my $row, my $column, my $divide) = &paramForGetFreeSpace();
  EMD_PERL_DEBUG("db_common.getFreeSpace(): df: $df, row: $row, column: $column, divide: $divide");
  
  my @temp = `$df`;
  $_ = $temp[$row];
  my @tokens = split;

if(($^O !~ /MSWin32/i) && (@temp == 3)){
      EMD_PERL_DEBUG("\tdf output on three lines\n");
      $column = 2;
  }

$freeKB = $tokens[$column]/$divide;
  
  if("$freeKB" eq "")
  {
    EMD_PERL_ERROR("db_common.getFreeSpace(): Could not get free space: $!");
    $freeKB = -1;
  }
  
  EMD_PERL_DEBUG("db_common.getFreeSpace(): Free space (KB) in $dirName: $freeKB");
  
  return $freeKB;
}

# Get file size (Bytes) for a given file name
# getFileSize(fileName)
sub getFileSize
{
  my ($fileName) = @_;
  my $byteSize = -s $fileName;
  if(!defined($byteSize))
  {
    EMD_PERL_ERROR("db_common.getFileSize(): Invalid file '$fileName': $!");
    $byteSize = -1;
  }
  
  EMD_PERL_DEBUG("db_common.getFileSize(): Size (Bytes) for file $fileName: $byteSize");
  
  return $byteSize;
}

# Remove a file for a given file name
# removeFile(fileName)
sub removeFile
{
  my ($fileName) = @_;

EMD_PERL_DEBUG("db_common.removeFile(): To remove file $fileName");
  
  unlink $fileName
    or warn "Could not remove '$fileName': $!";
}

# Remove files for a given prefix
# removeFilesWithPrefix(fileName)
sub removeFilesWithPrefix
{
  my ($fileName) = @_;

EMD_PERL_DEBUG("db_common.removeFilesWithPrefix(): To remove files starting with $fileName");
  
  unlink glob "$fileName*"
    or warn "Could not remove fils starting with '$fileName': $!";
}

# Remove all files under a given directory
# removeFilesInDir(dirName)
sub removeFilesInDir
{
  my ($dirName) = @_;

EMD_PERL_DEBUG("db_common.removeFilesInDir(): To remove all files under $dirName");

if($NT)
  {
    my @files = glob "$dirName/*";
    if(!@files)
    {
      return;
    }
    unlink glob "$dirName/*"
      or warn "Could not remove all files under '$dirName': $!";
    return;
  }
  
  unlink glob "$dirName/* $dirName/.*"
    or warn "Could not remove all files under '$dirName': $!";
}

# Remove a given directory, including all files under it (not dir tree under it)
# removeDir(dirName)
sub removeDir
{
  my ($dirName) = @_;

EMD_PERL_DEBUG("db_common.removeDir(): To remove dir and all files under $dirName");

&removeFilesInDir($dirName);
  rmdir $dirName
    or warn "Could not remove directory '$dirName': $!";
}

# Check if multiple files exist for given file names
# Return an array containing OK and NOK.
# Flag OK is returned if the file exists, otherwise, NOK is returned.
# filesExist(fileNameArray)
sub filesExist
{
  my ($fileNameArray) = @_;

my @fileNames = split /$DELIMITER/, $fileNameArray;
  my $existStatus = "";
  my $fileNames;

foreach $fileNames (@fileNames)
  {
    if(! -e "$fileNames")
    {
      EMD_PERL_DEBUG("db_common.filesExists(): File $fileNames does not exist");
      $existStatus .= "NOK:";
    }
    else
    {
      EMD_PERL_DEBUG("db_common.filesExists(): File $fileNames exists");
      $existStatus .= "OK:";
    }
  }
  
  return $existStatus;
}

# Check if a specified directory exists
# Return OK if the directory exists, otherwise, return NOK.
# dirExists(dirName)
sub dirExists
{
  my ($dirName) = @_;
  if(! -e "$dirName")
  {
    EMD_PERL_DEBUG("db_common.dirExists(): Directory $dirName does not exist");
    return "NOK";
  }
  elsif(! -d "$dirName")
  {
    EMD_PERL_DEBUG("db_common.dirExists(): $dirName is not a directory");
    return "NOK";
  }
  
  EMD_PERL_DEBUG("db_common.dirExists(): Directory $dirName exists");
  
  return "OK";
}

# Check if multiple directoris exist for given dir names
# Return an array containing OK and NOK.
# Flag OK is returned if the dir exists, otherwise, NOK is returned.
# dirsExist(dirNameArray)
sub dirsExist
{
  my ($dirNameArray) = @_;

my @dirNames = split /$DELIMITER/, $dirNameArray;
  my $existStatus = "";
  my $dirNames;

foreach $dirNames (@dirNames)
  {
    if(! -e "$dirNames")
    {
      EMD_PERL_DEBUG("db_common.dirsExist(): Directory $dirNames does not exist");
      $existStatus .= "NOK:";
    }
    else
    {
      EMD_PERL_DEBUG("db_common.dirsExist(): Directory $dirNames exists");
      $existStatus .= "OK:";
    }
  }
  
  return $existStatus;
}

# Check if the user has read/write permission for the specified directory
# Return OK if the user has read/write permission, otherwise, return NOK.
# dirPermission(dirName)
sub dirPermission
{
  my ($dirName) = @_;
  if(! -r "$dirName")
  {
    EMD_PERL_DEBUG("db_common.dirPermission(): UID $> does not have read permission for $dirName");
    return "NOK";
  }
  if(! -w _)
  {
    EMD_PERL_DEBUG("db_common.dirPermission(): UID $> does not have write permission for $dirName");
    return "NOK";
  }
  
  EMD_PERL_DEBUG("db_common.dirPermission(): UID $> has read/write permission for $dirName");
  
  return "OK";
}

# Check if the user has read/write permission for the multiple directories.
# Return an array containing OK and NOK.
# Flag OK is returned if user has read/write permission, otherwise, NOK is returned.
# dirsPermission(dirNameArray)
sub dirsPermission
{
  my ($dirNameArray) = @_;

my @dirNames = split /$DELIMITER/, $dirNameArray;
  my $permissionStatus = "";
  my $dirNames;

foreach $dirNames (@dirNames)
  {
    if(! -r "$dirNames")
    {
      EMD_PERL_DEBUG("db_common.dirsPermission(): UID $> does not have read permission for $dirNames");
      $permissionStatus .= "NOK:";
    }
    elsif(! -w "$dirNames")
    {
      EMD_PERL_DEBUG("db_common.dirsPermission(): UID $> does not have write permission for $dirNames");
      $permissionStatus .= "NOK:";
    }
    else
    {
      EMD_PERL_DEBUG("db_common.dirsPermission(): UID $> has read/write permission for $dirNames");
      $permissionStatus .= "OK:";
    }
  }
  
  return $permissionStatus;
}

# Check if the user has read permission for the specified directory
# Return OK if the user has read permission, otherwise, return NOK.
# dirReadPermission(dirName)
sub dirReadPermission
{
  my ($dirName) = @_;
  if(! -r "$dirName")
  {
    EMD_PERL_DEBUG("db_common.dirReadPermission(): UID $> does not have read permission for $dirName");
    return "NOK";
  }
  
  EMD_PERL_DEBUG("db_common.dirReadPermission(): UID $> has read permission for $dirName");
  
  return "OK";
}

# Check if the user has write permission for the specified directory
# Return OK if the user has write permission, otherwise, return NOK.
# dirWritePermission(dirName)
sub dirWritePermission
{
  my ($dirName) = @_;
  
  if(! -w $dirName)
  {
    EMD_PERL_DEBUG("db_common.dirWritePermission(): UID $> does not have write permission for $dirName");
    return "NOK";
  }
  
  EMD_PERL_DEBUG("db_common.dirWritePermission(): UID $> has write permission for $dirName");
  
  return "OK";
}

# Check if the user has read permission for the specified file
# Return OK if the user has read permission, otherwise, return NOK.
# fileReadPermission(fileName)
sub fileReadPermission
{
  my ($fileName) = @_;
  if(! -r "$fileName")
  {
    EMD_PERL_DEBUG("db_common.fileReadPermission(): UID $> does not have read permission for $fileName");
    return "NOK";
  }
  EMD_PERL_DEBUG("db_common.fileReadPermission(): UID $> has read permission for $fileName");
  return "OK";
}

# Check if multiple files have read permissions for given file names
# Return an array containing OK and NOK.
# Flag OK is returned if the file exists, otherwise, NOK is returned.
# filesReadPermission(fileNameArray)
sub filesReadPermission
{
  my ($fileNameArray) = @_;

my @fileNames = split /$DELIMITER/, $fileNameArray;
  my $existStatus = "";
  my $fileNames;

foreach $fileNames (@fileNames)
  {
    if(! -r "$fileNames")
    {
      EMD_PERL_DEBUG("db_common.filesReadPermission(): UID $> does not have read permission for $fileNames");
      $existStatus .= "NOK:";
    }
    else
    {
      EMD_PERL_DEBUG("db_common.filesReadPermission(): UID $> has read permission for $fileNames");
      $existStatus .= "OK:";
    }
  }  
  return $existStatus;
}

# Check if the user has executable permission for the specified file
# If the command succeeds then return OK else return NOK
# fileExecutePermission(commandToRun)
sub fileExecutePermission
{
  (my $commandToRun, my $oracle_home, my $oracle_sid) = @_;
  set_env_var($oracle_home, $oracle_sid);
  EMD_PERL_DEBUG("db_common.fileExecutePermission(): command: $commandToRun");
  `$commandToRun`;
  if($? == 0)
  {
    EMD_PERL_DEBUG("db_common.fileExecutePermission(): Exit Status: $?");
    return "OK";
  }
  else
  {
    EMD_PERL_DEBUG("db_common.fileExecutePermission(): Exit Status: $?");
    return "NOK";
  }
}

# Create a specified directory.
# Return OK if succeed, otherwise, return NOK.
# OK is returned if the specified directory already exists.
# mkDir(dirName)
sub mkDir
{
  my ($dirName) = @_;
  EMD_PERL_DEBUG("db_common.mkDir(): Create directory $dirName");
  my $dirExist = &dirExists($dirName);
  if($dirExist eq "OK")
  {
    EMD_PERL_DEBUG("db_common.mkDir(): Directory $dirName already exists");
    return "OK";
  }

my (@create);
  push(@create, $dirName);

#create parent directories if necessary
  my($parent) = dirname($dirName);
  while(! -e "$parent")
  {
    EMD_PERL_DEBUG("db_common.mkDir(): Need to create $parent");
    push(@create, $parent);
    $parent = dirname($parent);
  }

while($dirName = pop(@create))
  {
    EMD_PERL_DEBUG("db_common.mkDir(): Creating $dirName");
    if(!mkdir($dirName, 0750)){
      EMD_PERL_ERROR("db_common.mkDir(): mkdir $dirName failed");
      ## Actually want this error to come out in the job output
      print "mkdir ${dirName}: $!\n";
      return "NOK";
    }
    EMD_PERL_DEBUG("db_common.mkDir(): chmod 0750 $dirName");
    chmod (0750, $dirName);
  }
  
  return "OK";
}

# Create multiple directoris for given dir names
# If certain dir's exist, skip them.
# Return an array containing OK (created) and NOK (exist or failed).
# mkDirs(dirNameArray)
sub mkDirs
{
  my ($dirNameArray) = @_;

my @dirNames = split /$DELIMITER/, $dirNameArray;
  my $createStatus = "";
  my $dirNames;
  my $created = "";

foreach $dirNames (@dirNames)
  {
    $created = &mkDir($dirNames);
    if($created eq "OK")
    {
      EMD_PERL_DEBUG("db_common.mkDirs(): Directory $dirNames has been created");
      $createStatus .= "OK:";
    }
    else
    {
      EMD_PERL_DEBUG("db_common.mkDirs(): Directory $dirNames is not created");
      $createStatus .= "NOK:";
    }
  }
  
  return $createStatus;
}

# Copy a file from source to destination location
# copyFile(sourceFile, destFile)
sub copyFile
{
  my ($sourceFile, $destFile) = @_;
  EMD_PERL_DEBUG("db_common.copyFile(): copying $sourceFile to $destFile");

copy($sourceFile, $destFile)
    or ((EMD_PERL_ERROR("db_common.copyFile(): $sourceFile could not be copied as $destFile")) && (die "Can't copy '$sourceFile' to '$destFile': $!") || (die "Can't copy '$sourceFile' to '$destFile': $!"));
    
  EMD_PERL_DEBUG("db_common.copyFile(): File $sourceFile has been copied as $destFile");
}

# Copy a file from source to destination location
# If could not copy, do not die.
# copyFile2(sourceFile, destFile)
sub copyFile2
{
  my ($sourceFile, $destFile) = @_;
  EMD_PERL_DEBUG("db_common.copyFile2(): copying $sourceFile to $destFile");

copy($sourceFile, $destFile)
    or (EMD_PERL_DEBUG("db_common.copyFile2(): File $sourceFile could not be copied as $destFile: $!"));
    
  EMD_PERL_DEBUG("db_common.copyFile2(): File $sourceFile has been copied as $destFile");
}

# Get the basename from a given full file name
# getBasename(fullFileName)
sub getBasename
{
  my ($fullFileName) = @_;
  EMD_PERL_DEBUG("db_common.getBasename(): getting basename from $fullFileName");

my $basename = basename $fullFileName
    or EMD_PERL_ERROR("db_common.getBasename(): could not get basename from $fullFileName");
    
  EMD_PERL_DEBUG("db_common.getBasename(): Basename of $fullFileName is $basename");
  
  return $basename;
}
# Get the dirname from a given full file name
# getDirname(fullFileName)
sub getDirname
{
  my ($fullFileName) = @_;
  EMD_PERL_DEBUG("db_common.getDirname(): getting dir name from $fullFileName");

my $dirname = dirname $fullFileName
    or EMD_PERL_ERROR("db_common.getDirname(): could not get dir name from $fullFileName");
    
  EMD_PERL_DEBUG("db_common.getDirname(): Dir name of $fullFileName is $dirname");
  
  return $dirname;
}

# Find the nearest existing parent dir for a given dir.
# Return dir found, otherwise, return "".
# findNearestExistingParentDir(dirName)
sub findNearestExistingParentDir
{
  my ($dirName) = @_;
  EMD_PERL_DEBUG("db_common.findNearestExistingParentDir(): Find nearest existing dir for $dirName");
  my $dirExist = &dirExists($dirName);
  if($dirExist eq "OK")
  {
    EMD_PERL_DEBUG("db_common.findNearestExistingParentDir(): Directory $dirName already exists");
    return $dirName;
  }

my($parent) = dirname($dirName);
  if($parent eq "/" || $parent =~ /:$/ || $parent eq "" || $parent eq ".")
  {
    return $parent;
  }
  
  while(! -e "$parent")
  {
    EMD_PERL_DEBUG("db_common.findNearestExistingParentDir(): $parent does not exist");
    $parent = dirname($parent);
    if($parent eq "/" || $parent =~ /:$/ || $parent eq "" || $parent eq ".")
    {
      return $parent;
    }
  }

return $parent;
}

# Determine if the specified user is a member of the dba group
# isDBAMember(user)
sub isDBAMember
{
  #For NT, getgrnam does not work
  #return OK for now
  if($NT)
  {
      return "OK";
  }

my($user) = @_;
  
  my($member);
  my($name, $passwd, $gid, $members) = getgrnam "dba";
  
  foreach $member (split / +/, $members){
    if($user =~ /^$member$/i){
      EMD_PERL_DEBUG("db_common.isDBAMember(): $user is a member of dba group");
      return "OK";
    }
  }

## If the member isn't in the group list, check their default group
  my($uname, $upasswd, $uid, $ugid) = getpwnam "$user";
  my($grname, $grpasswd, $grid, $gmembers) = getgrgid "$ugid";
  if($grname eq "dba"){
    EMD_PERL_DEBUG("db_common.isDBAMember(): $user is a member of dba group");
    return "OK";
  }
    
  EMD_PERL_DEBUG("db_common.isDBAMember(): $user is not a member of dba group");
  return "NOK";
}

# Get TNS_ADMIN env variable. Return a non-empty value if it is a directory.
# Need to pass in OracleHome for NT, otherwise, it returns agent's TNS_ADMIN
# getTNS_ADMIN(OracleHome)
sub getTNS_ADMIN
{ 
  my $oracleHome = $_[0];
  my $globalTnsAdminDir = "";
  if ( defined $ENV{TNS_ADMIN} )
  {
    $globalTnsAdminDir = trim ( $ENV{TNS_ADMIN} );
    if (! -d $globalTnsAdminDir )
    {
      $globalTnsAdminDir = "";
    } 
  }

if($NT)
  {
    $globalTnsAdminDir = getTNS_ADMINOnNT($oracleHome);
  }
  
  EMD_PERL_DEBUG("db_common.getTNS_ADMIN(): TNS_ADMIN is: $globalTnsAdminDir");
  return $globalTnsAdminDir;
}

# Get the TNS_ADMIN entry from registry on NT.
# getTNS_ADMINOnNT(OracleHome)
sub getTNS_ADMINOnNT
{
  my $passedInOracleHome = $_[0];
  
  if(!$NT)
  {
    return "";
  }

EMD_PERL_DEBUG("db_common.getTNS_ADMINOnNT(): *** START ***");

#Check: Look for existing entry by checking the registry.

my $oracleHome = $ENV{ORACLE_HOME};
  if(defined($passedInOracleHome))
  {
    $oracleHome = $passedInOracleHome;
  }

#defaultTNS is "".  Let OMS construct it as OH/network/admin.
  my $defaultTNS = "";
  EMD_PERL_DEBUG("db_common.getTNS_ADMINOnNT(): Oracle Home: $oracleHome, default TNS_ADMIN: $defaultTNS");

#get the registry key location from OH/bin/oracle.key
  my $oracle_key = "${oracleHome}${S}bin${S}oracle.key";
  open (ORACLE_KEY, "$oracle_key") || ((EMD_PERL_ERROR("db_common.getTNS_ADMINOnNT(): Unable to open $oracle_key") && (return $defaultTNS)) || (return $defaultTNS));
  my @oracle_key_content = <ORACLE_KEY>;
  my $key_loc = "@oracle_key_content";
  chomp($key_loc);
  close ORACLE_KEY;

EMD_PERL_DEBUG("db_common.getTNS_ADMINOnNT(): Oracle Home registry key: $key_loc");

my $homeTNS_ADMIN= $Registry->{"LMachine${S}${key_loc}${S}TNS_ADMIN"}
     or EMD_PERL_DEBUG("Can not find the TNS_ADMIN for LMachine${S}${key_loc}${S}TNS_ADMIN: $^E");
  if(!defined $homeTNS_ADMIN)
  {
    $homeTNS_ADMIN = $defaultTNS;
  }

EMD_PERL_DEBUG("db_common.getTNS_ADMINOnNT(): TNS_ADMIN:$homeTNS_ADMIN");
  EMD_PERL_DEBUG("db_common.getTNS_ADMINOnNT(): *** END ***");

return $homeTNS_ADMIN;
}

# Get ORACLE_BASE env variable. Return a non-empty value if it is a directory.
sub getORACLE_BASE
{ 
  my $oracleBase = "";
  if ( defined $ENV{ORACLE_BASE} )
  {
    $oracleBase = trim ( $ENV{ORACLE_BASE} );
    if (! -d $oracleBase )
    {
      $oracleBase = "";
    } 
  }

EMD_PERL_DEBUG("db_common.getORACLE_BASE(): ORACLE_BASE is: $oracleBase");
  return $oracleBase;
}

#strips leading and trailing spaces and returns the string
sub trim 
{
  my $origStr = $_[0];
  $origStr =~ s/^\s*|\s*$//g;
  return $origStr;
}

#This is NT specific. Sometimes, $TEMP does not work, this 
#method provides some fallback.
sub tempLocFallback
{
  if(!$NT)
  {
    return;
  }

my $fallback = "N";
  my $filename = "$TEMP\\"."test_temp_location.$$";
  EMD_PERL_DEBUG("db_common.tempLocFallback(): Test filename: $filename");

my(@res) = `echo "This is a test!" >$filename 2>&1`;
    
  #Test opening the temp file
  open (OUT_PUT, "$filename") || ($fallback = "Y");

if($fallback eq "N")
  {
    close OUT_PUT;
    &removeFile($filename);
    EMD_PERL_DEBUG("db_common.tempLocFallback(): Tested TEMP location: $TEMP");
    return;
  }

${TEMP} = $ENV{SYSTEMDRIVE} . "\\TEMP"; #Bug# 5642432
  &mkDir(${TEMP}); #Bug# 5642432

EMD_PERL_DEBUG("db_common.tempLocFallback(): TEMP location fallback to: $TEMP");
}

#double all back slashes and return the string
sub doubleBackSlashes 
{
  my $origStr = $_[0];
  $origStr =~ s/\\/\\\\/g;
  return $origStr;
}

#Tests:
sub main
{
  $ENV{EMAGENT_PERL_TRACE_LEVEL} = 0;

#set_env_var("/ade/ngade_emdw1/oracle", "emdw1");

#(my $temp_fh1, my $temp_filename1) = create_temp_file();
  #print "temp_fh: $temp_fh1, temp_filename $temp_filename1\n";

#(my $temp_fh2, my $temp_filename2) = create_temp_file(".log");
  #print "temp_fh: $temp_fh2, temp_filename $temp_filename2\n";

#my $retVal1 = getFreeSpace("/private2/tmp/test");
  #my $retVal1 = getFreeSpace("C:\\temp");
  #print "Free space: $retVal1\n";

#my $retVal2 = getFileSize("/private1/backup/test");
  #my $retVal2 = getFileSize("c:\\temp\\initAUX10.ora");
  #print "File size: $retVal2\n";

#removeFile("/private1/backup/test_file");
  #removeFilesInDir("/private1/backup");
  #removeFile("c:\\temp\\test");
  #removeFilesInDir("c:\\temp\\tmp");

#my $retVal3 = filesExist("/private1/backup/test1");
  #my $retVal3 = filesExist("c:\\temp\\test");
  #print "File exists: $retVal3\n";

#my $retVal31 = filesExist("/private1/backup/test1:/private1/backup/test2:/private1/backup/test3");
  #my $retVal31 = filesExist("c:\\temp\\test:::c:\\temp\\test2:::c:\\temp\\test3");
  #print "File exists: $retVal31\n";

#my $retVal4 = dirExists("/private1/backup");
  #my $retVal4 = dirExists("c:\\ade\\szhu_sa0804\\oracle");
  #my $retVal4 = dirExists("/ade/szhu_sa0804/oracle");
  #print "Dir exists: $retVal4\n";

#my $retVal41 = dirsExist("/private1/backup/test1:/private1/backup/test2:/private1/backup/test3");
  #my $retVal41 = dirsExist("c:\\temp\\test:::c:\\temp\\test2:::c:\\temp\\test3");
  #print "Dirs exist: $retVal41\n";

#removeDir("/private1/backup/test1");
  #removeDir("c:\\temp\\tmp");

#my $retVal5 = dirPermission("/private1/backup");
  #my $retVal5 = dirPermission("c:\\temp\\tmp");
  #print "Dir permission: $retVal5\n";

#my $retVal6 = mkDir("/private1/backup/test/test1");
  #my $retVal6 = mkDir("c:\\temp\\tmp");
  #print "return value $retVal6\n";

#my $retVal7 = mkDirs("/private1/backup/test1:/private2/backup/test2:/private1/backup/test3");
  #my $retVal7 = mkDirs("c:\\temp\\tmp1:::c:\\temp\\tmp2:::c:\\temp\\tmp3");
  #print "return value $retVal7\n";

#copyFile("/private1/backup/test", "/private/test/test1");
  #copyFile("c:\\temp\\test", "c:\\temp\\test2");

#my $retVal8 = getBasename("/private1/backup/test/test1");
  #my $retVal8 = getBasename("c:\\temp\tmp\\test");
  #print "Basename: $retVal8\n";
  
  #my $retVal9 = getDirname("/private1");
  #my $retVal9 = getDirname("c:\\temp\\private1\\test");
  #print "Dirname: $retVal9\n";

#my $retVal10 = findNearestExistingParentDir("/private1");
  #my $retVal10 = findNearestExistingParentDir("c:\\temp\\tmp\\tmp1\\test");
  #print "Parent dir: $retVal10\n";

#my $retVal = isDBAMember("oracle");
  #print "DBA Member: $retVal\n";

#my $retVal = getTNS_ADMIN();
  #print "TNS_ADMIN: $retVal\n";
  
  #my $retVal = getORACLE_BASE();
  #print "ORACLE_BASE: $retVal\n";

#my $retVal = getTNS_ADMINOnNT();
  #print "TNS_ADMIN: $retVal\n";
}

#main();

Ms-Dos/Windows Unix Write backup

jsp File Browser version 1.2 by www.vonloesch.de