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

# Copyright (c) 2001, 2009, Oracle and/or its affiliates. All rights reserved. 
#
#  $Id: sCommon.pm /st_emdbsa_11.2/5 2009/07/02 22:34:19 rsamaved 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 has::sCommon;

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

$Data::Dumper::Indent = 2;
$Data::Dumper::Deepcopy = 1;
$Data::Dumper::Purity = 1;
$Data::Dumper::Sortkeys = 1;

#------------------------------------------------------------------------------
# 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( $;$$ )
{
    
  # function to save the results of the os command to the hash structure
  #  if running in regression or capture mode
  sub save_to_regression_capture ( $$$$; )
  {

my ( $cmd,$ncmd,$valueref,$argref) = @_;

# If running in test mode then get output from the txt file specified
    # create a mangled name for the command
    if ( $ENV{HAS_TEST_MODE} and $ENV{HAS_TEST_MODE} =~ /capture/i )
    {
      # save the list result 
      my @results_array;
      @results_array =  @$valueref if $valueref;

my $dumped_results;
  
      if ( \@results_array )
      {
       $dumped_results = Dumper(\@results_array) 
        or warn "WARN::has::sCommon::runsystemcommand Failed to save results for function $cmd\n" and return;
      }
     
      $has::Common::has_test_res_ref->{$ncmd} = $dumped_results if $dumped_results;
      $has::Common::has_test_res_ref->{$ncmd} = undef unless $dumped_results;
      
      # save the command status , with ref dumped
      my $dumped_cmd_status;
  
      $dumped_cmd_status = Dumper(\$argref->{command_return_status}) 
        if $argref and defined $argref->{command_return_status};
  
      $has::Common::has_test_res_ref->{"$ncmd"."_command_return_status"} = $dumped_cmd_status if defined $dumped_cmd_status;
      $has::Common::has_test_res_ref->{"$ncmd"."_command_return_status"} = undef 
       unless defined $has::Common::has_test_res_ref->{"$ncmd"."_command_return_status"};
  
      # save the command error , with ref dumped
      my $dumped_cmd_error;
  
      $dumped_cmd_error = Dumper(\$argref->{command_error_message}) 
        if $argref and defined $argref->{command_error_message};
  
      $has::Common::has_test_res_ref->{"$ncmd"."_command_error_message"} = $dumped_cmd_error if $dumped_cmd_error;
      $has::Common::has_test_res_ref->{"$ncmd"."_command_error_message"} = undef 
       unless defined $has::Common::has_test_res_ref->{"$ncmd"."_command_error_message"};

}
  
    return 1;

}

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}  )
  {

$ncmd = has::Common::hasGetFunctionString($cmd,$args);

if ( $ENV{HAS_TEST_MODE} =~ /regression/i )
    {

# return the results from the variable built from file
      my $resvalueref;
      $resvalueref = has::Common::get_fn_results($ncmd);

# get the exit status too 
      my $cmd_status_ref;

$cmd_status_ref = has::Common::get_fn_results("$ncmd".'_command_return_status');

$argref->{command_return_status} = $$cmd_status_ref if defined $cmd_status_ref;

# get the exit status too 
      my $cmd_error_ref;

$cmd_error_ref = has::Common::get_fn_results("$ncmd".'_command_error_message');

$argref->{command_error_message} = $$cmd_error_ref if defined $cmd_error_ref;

return unless $resvalueref;

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 unless $argref->{no_alarm_reset};   #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 unless $argref->{no_alarm_reset};

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
    if ( $argref->{return_timeout} )
    {
      warn "ERROR:Timed out during execution of command $cmd $args after $tries tries\n";
      $argref->{command_timedout_mesg}="Timedout:$cmd:tries:$tries";

save_to_regression_capture($cmd,$ncmd,\@value,$argref);
       
      return
    }

# 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";
    $argref->{command_timedout_mesg}="Timedout:$cmd:tries:$tries";
  }

# 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 $@;
  if ( $@ )
  {
    warn "ERROR:Failed during execution of command $cmd $args, error $@\n";
   
    save_to_regression_capture($cmd,$ncmd,\@value,$argref);

return;
  }

# 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";

save_to_regression_capture($cmd,$ncmd,\@value,$argref);

return;
  }

save_to_regression_capture($cmd,$ncmd,\@value,$argref);

# 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