Edit D:\app\Administrator\product\11.2.0\dbhome_1\sysman\admin\scripts\siha\sCommon.pm

# Copyright (c) 2001, 2007, Oracle. All rights reserved.  
#
#  $Id: sCommon.pm 23-may-2007.00:07:36 ajdsouza Exp $ 
#
#
# NAME  
#	 sCommon.pm
#
# DESC 
#	 sCommon has subroutines which are os specific
#
#
# FUNCTIONS
# AUTOLOADER
#
# NOTES
#
#
# MODIFIED	(MM/DD/YY)
# ajdsouza       04/03/07 - Created 
#
#
package siha::sCommon;

require v5.6.1;

use Exporter;
use strict;
use warnings;
use locale;
use File::Spec::Functions;
use File::Path;
use Data::Dumper;
use XML::Parser;

#------------------------------------------------------------------------------
# FUNCTION : runsystemcommand($;$\%)
#
# DESC 
# Run a system command , retry n times if it times out
#
# ARGUMENTS
# command to be executed ( e.g. crsctl start crs )
# variable args to the command ( eg nodename)
#  a hash ref with
#  {timeout} in seconds, default 120
#  {tries} no of tries , default 2. 
#  {timeout_return} flag 1 to indicate if function should return 
#   in case of timeout, default is to die
#  {exit_failure_list}
#  {exit_success_list}
#   The lists to indicate failure and sucess exit status if they are other
#   than 0=Success all other exit status are =Fail
#   You can define one of the list of both the lists
#    e.g. for 'crsctl start crs' 
#    {exit_failure_list}=[(1,3,5,6)]
#    {exit_success_list}=[(0,2)]
#
# RETURNS:
#  result set either an array or a arg
#  the $? for the os command as {command_return_status} of the hash ref arg
#  {command_error_message} returns $! $@
#
#------------------------------------------------------------------------------
sub runsystemcommand( $;$\% )
{
    
  my ($cmd,$args,$argref) = @_;
  my $devnull =  File::Spec->devnull();
  my $timedout = 0;
  my $ncmd;
    
  $devnull = '/dev/null'
   unless $devnull;
    
  warn "No command to execute!"
   and return 
    if not $cmd;

$args = '' unless $args;
  
  # strip trailing and leading blanks from the command
  #  we append a space before concatenating cmd with args anyway
  $cmd =~ s/^\s+|\s+$//g;

# we are runnin in gtest mode capture or regression
  if ( $ENV{HAS_TEST_MODE}  )
  {
    # build the sting fomr comand and args
    $ncmd = "$cmd$args";
    $ncmd =~ s/\s//g;

if ( $ENV{HAS_TEST_MODE} =~ /regression/i )
    {
      # read results from file
      if ( not defined $siha::Common::has_test_res_ref )
      {
         my $has_result_fpath;

$has_result_fpath = $ENV{HAS_TEST_FILE_PATH} 
          if $ENV{HAS_TEST_FILE_PATH};

$has_result_fpath = File::Spec->catfile(File::Spec->tmpdir(),
          $siha::Common::has_test_res_filen)
          unless $has_result_fpath;

stat($has_result_fpath);

warn "ERROR:File $has_result_fpath for persisting command results is not accessible\n"
          and return
           unless -e $has_result_fpath and -r $has_result_fpath;

$siha::Common::has_test_res_ref = do "$has_result_fpath";
      }

# return the results from the variable built from file
      return unless $siha::Common::has_test_res_ref and $siha::Common::has_test_res_ref->{$ncmd};

my $resvalueref = $siha::Common::has_test_res_ref->{$ncmd};
  
      # get the exit status too 
      $argref->{command_return_status} = 
       $siha::Common::has_test_res_ref->{"$ncmd"."_command_return_status"}
         if $siha::Common::has_test_res_ref->{"$ncmd"."_command_return_status"};

# Return array or flat structure depending on type of return 
      # placeholder
      return wantarray ? @{$resvalueref} : join('',@{$resvalueref});
    }
  }

# Disable timeout if nothing was passed as an argument
  # (setting alarm to 0 disables it)
  my $timeout;
  $timeout = $argref->{timeout} if $argref and $argref->{timeout};
  $timeout = 120 unless $timeout;

# Set the number of times to try running the command.
  my $tries;
  $tries = $argref->{tries} if $argref and $argref->{tries};
  $tries = 2 unless $tries;

my ( $kid, $FH );
  my @value;
  my $diesh;

# save the signal handler defined for die
  $diesh = $SIG{__DIE__} if $SIG{__DIE__};

# catch the error here and die 
  # before enterign the eval block
  open(RSC_OLDERR,">&STDERR") 
   or die "ERROR:failed to open STDERR  during execution of command $cmd $args, aborting execution\n";

open(STDERR,"> $devnull")
   or die "ERROR:failed to redirect STDERR  during execution of command $cmd $args, command aborted\n";

# remove any signal handler defined for die
  $SIG{__DIE__}='';

for my $try (1..$tries)
  {

$timedout=0;

warn " Retrying $cmd $args, Count $try  \n" if $try > 1;

eval
    {

# SIGNAL HANDLER FOR TIMEOUT
      # Kill process and set error if command times out
      local $SIG{ALRM} = sub
      {
        alarm 0;   #reset the alarm

# kill the timedout process
        kill ("KILL", $kid) if $kid;

# set a flag to indicate that the command
        # timedout
        $timedout = 1;

warn "$cmd $args timed out \n";

# this die will end the eval block,
        # control will go to the line after the eval block
        die "Timed out on $cmd $args, $try times \n";

};

# return if error during forking of the command
      # discard stderr capture stdout only
      $kid = open $FH, "$cmd $args|";

# error opening a fd to the command
      die "Failed to open descriptor to execute $cmd $args: $!\n"
       if not $kid;

# Set the timeout
      alarm $timeout;

@value = <$FH> if $FH;

#reset the alarm
      alarm 0;

close $FH;

};

# Retry only for timeouts
    last unless $timedout;

}

# restore back the original die signal handler
  $SIG{__DIE__} = $diesh  if $diesh;

# capture the commadn status in $?
  # If the OS command executed thru open and has set a error then
  # $? is set AFTER close, $! and $^E may or may not be set
  # log error and return
  # $? is 16 bytes , first 8 bytes gives the exit status
  # next 8 bytes indicate the mode of failure
  # Error only if exit status != 0
  $argref->{command_return_status}=$? >> 8;

# Restore STDERR
  close(STDERR);
  open(STDERR,">&RSC_OLDERR") 
   or die "ERROR:Failed to restore STDERR when executing OS command $cmd $args\n";
  close(RSC_OLDERR);

# the command timed out after n tries
  if ( $timedout )
  {
    # if the caller specified the command to return, return with a error warning
    warn "ERROR:Timed out during execution of command $cmd $args after $tries tries\n"
     and return
      if $argref->{return_timeout};

# Abort command execution if the command timedout after $tries 
    #  and return is no specified
    die "ERROR:Timed out during execution of command $cmd after $tries tries, command aborted\n";
  }

# if the eval block died for any other cause other than timeout
  # then $@ is set to error
  # indicating the die for the eval block
  # $@ is set ONLY if the eval block dies
  # return if any other error in while executing the command
  # not prudent to die here as absense of a command ( eq vxprint )
  # can cause this error, let the caller decide if it wants to die
  $argref->{command_error_message}=$@ if $@;
  warn "ERROR:Failed during execution of command $cmd $args, error $@\n"
   and return
    if $@;

# If the OS command executed thru open and has set a error then
  # $? is set AFTER close, $! and $^E may or may not be set
  # log error and return
  # $? is 16 bytes , first 8 bytes gives the exit status
  # next 8 bytes indicate the mode of failure
  # Error only if exit status != 0
  # any value other than 0 construed to be a failure
  # if a command has a non zero value as success then define the
  # list of failures in exitfailurelist for that command
  # or
  #  define the list of sucess exit values in exitsuccesslist
  # or both  
  $argref->{command_error_message}="$cmd $args: $!--$^E--$?";

if (
      (
       # exit status in exitfailurelist
       exists $argref->{exit_failure_list} and 
         ref($argref->{exit_failure_list}) =~ /ARRAY/i and
        grep{1 if $?>>8 == $_ }@{$argref->{exit_failure_list}}
      )
      or
      (
       # exist status in exitsuccesslist
       exists $argref->{exit_success_list} and 
         ref($argref->{exit_success_list}) =~ /ARRAY/i and
        not grep{1 if $?>>8 == $_ }@{$argref->{exit_success_list}}
      )
      or
      (
       # exit status is not 0
       not exists $argref->{exit_success_list} and
        not exists $argref->{exit_failure_list} and 
        $? >> 8 != 0
      )
    )
  {
    warn "ERROR:Failed executing $cmd $args, $! $^E $? \n";
    return;
  }

# If running in test mode then get output from the txt file specified
  # create a mangled name for the command
  $siha::Common::has_test_res_ref->{$ncmd} = \@value
    if $ENV{HAS_TEST_MODE} and 
      $ENV{HAS_TEST_MODE} =~ /capture/i;

# create a mangled name for the command
  $siha::Common::has_test_res_ref->{"$ncmd"."_command_return_status"} = 
   $argref->{command_return_status}
    if $ENV{HAS_TEST_MODE} and 
      $ENV{HAS_TEST_MODE} =~ /capture/i;

# Return array or flat structure depending on type of return 
  # placeholder
  return wantarray ? @value : join('',@value);

}

1; #Returning a true value at the end of the module

Ms-Dos/Windows Unix Write backup

jsp File Browser version 1.2 by www.vonloesch.de