Edit D:\app\Administrator\product\11.2.0\dbhome_1\oc4j\j2ee\oc4j_applications\applications\em\em\WEB-INF\perl\db\ob\ob

Edit D:\app\Administrator\product\11.2.0\dbhome_1\oc4j\j2ee\oc4j_applications\applications\em\em\WEB-INF\perl\db\ob\ob_o.pl

#!/usr/local/bin/perl
# 
# $Header: emdb/sysman/webapps/em/WEB-INF/perl/db/ob/ob_o.pl /stpl_db_11.2.0.1.0_gen/1 2009/09/21 11:54:59 pfgavin Exp $
#
# ob_o.pl
# 
# Copyright (c) 2002, 2009, Oracle and/or its affiliates. All rights reserved. 
#
#    NAME
#      ob_o.pl - Perl script for Oracle Backup remote operations.
#
#    DESCRIPTION
#      Remote execution routines for Oracle Backup.
#
#    NOTES
#      <other useful comments, qualifications, etc.>
#
#    MODIFIED   (MM/DD/YY)
#    pfgavin     09/17/09 - XbranchMerge pfgavin_hpux-lrgfix-4050441 from
#                           st_emdbgc_10.2.0.1.0
#    pfgavin     07/27/09 - fix 4050441
#    swbalasu    02/04/09 - action required jobs to map to running
#    swbalasu    01/28/09 - NT perl crash bug 7848752
#    swbalasu    01/06/09 - win: status check issue
#    swbalasu    11/14/08 - commenting sleep 20 to reduce delays
#    pfgavin     09/23/08 - 
#    swbalasu    09/17/08 - 
#    swbalasu    09/05/08 - fix command block syntax for 10.2.0.5
#    sksantha    02/05/08 - 6736728 bug fix
#    swbalasu    05/25/07 - add job params cmdblk
#    swbalasu    07/23/07 - switching CLEAR_STEP_OUTPUT to corr. JOB API
#    swbalasu    04/06/07 - streaming of transcript
#    pfgavin     10/14/06 - overhaul of on_o.pl for ASBR, e.g. strict prag.
#    pfgavin     10/07/06 - fix 5573980
#    swbalasu    07/14/06 - fixed bug 5631829 
#    pfgavin     08/05/05 - fixed 4538635.
#    pfgavin     07/21/05 - fixed 4499006.
#    pfgavin     07/13/05 - add check for .local.bin 
#    bseiger     03/04/05 - Fix MBCS issue 
#    pfgavin     02/22/05 - fixed rbmapvar.sh path and parsing.
#    pfgavin     02/11/05 - move rbmapvar.sh to $ADE_VIEW_ROOT
#    pfgavin     01/31/05 - windows mods. extended wait period for obtool to timeout.
#    pfgavin     10/15/04 - pfgavin_text-fixups
#    pfgavin     10/15/04 - moved from agent side perl, ob.pl.
#    pfgavin     10/07/04 - rb->ob
#    pfgavin     05/28/04 - pfgavin_oracle-backup-init
#    pfgavin     03/17/04 - Creation
#

use FileHandle;
use utf8;
use IPC::Open2;
use POSIX "sys_wait_h";
use vars qw/ $OS $NT $S $TEMP $CP $MV $PS $DF $DELIMITER /;
if ( !defined $ENV{'EMHA_SKIP_LOCAL_IMPORTS'} )
{
 require "$ENV{EMDROOT}/sysman/admin/scripts/db/db_common.pl";
}

use strict;

use vars qw/ $sd_password $ob_command $ob_result $ob_password
             $results $poll_command $trans_command $rbug
             $fpoll $jstate $frest $tmprb $rbtmpfile $orig_ob_command 
             $ob_command_ext
         /;

#
# OBset_ob_env()
#
# If the perl script is run in an ade environment then
# look for the env script in the temp dir. This script fille
# will set the nessessary environment variables to access
# the ob administrative domain running in a view.
#
sub OBset_ob_env
{
  EMD_PERL_DEBUG("ob_o.OBset_ob_env(): start");
  open rbtmpfile or die "Can't find $rbtmpfile\n";
  while (<rbtmpfile>)
  {
    my $xtra;
    my $varname;
    my $varvalue;
    ($xtra, $varname, $varvalue) = split / /;
    if ($NT)
    {
      substr($varvalue, -1)   = "";
    }
    else
    {
      substr($varvalue, 0, 1) = "";
      substr($varvalue, -2)   = "";
    }
    $ENV{$varname} = $varvalue;
    if (rindex($varname, "OBCONFIG") != -1)
    {
      my $ldpath;
      my $ldconfig;
      ($ldpath, $ldconfig) = split /oracle/, $varvalue;
      $ENV{'LD_LIBRARY_PATH'} = "$ENV{'LD_LIBRARY_PATH'}:$ldpath/oracle/reliaty/lib";
      EMD_PERL_DEBUG("ob_o.OBset_ob_env(): path: $ENV{'LD_LIBRARY_PATH'}");
    }
  }
  EMD_PERL_DEBUG("ob_o.OBset_ob_env(): end");
}

sub ltrim($)
{
  my $string = shift;
  $string =~ s/^\s+//;
  return $string;
}

#
# OBset_sh_lib_path
#
# fix for lrg 4050441. Set the shlib path for *uix OSB shiphomes.
#
sub OBset_sh_lib_path
{
  my $obconfig = "/etc/obconfig";
  open obconfigpath, $obconfig or die "Can't find $obconfig: $!";
  while (<obconfigpath>)
  {
     my $varname;
     my $varvalue;
    ($varname, $varvalue) = split /:/;
    if (rindex($varname, "ob dir") != -1)
    {
      chomp($varvalue);
      $varvalue = ltrim($varvalue);
      $ENV{'LD_LIBRARY_PATH'} = "$ENV{'LD_LIBRARY_PATH'}:$varvalue/lib";
      EMD_PERL_DEBUG("ob_o.OBset_sh_lib_path(): 4:  ($ENV{'LD_LIBRARY_PATH'})");
     }
   }
   EMD_PERL_DEBUG("ob_o.OBset_sh_lib_path(): end");
}

#
# OBpollJob
#
# Poll b/r jobs until they are completed, failed, or pended.
# Return the transcript. 
# 
sub OBpollJob()
{
  EMD_PERL_DEBUG("ob.OBpollJob(): start");

my @ids =  split(/Info:/, $rbug);
  my $results = 0;
  my $err_msg;
  
  # If we get an error then just get out.
  if (rindex($rbug, "Error:") != -1  ||
      rindex($rbug, "obtool:") != -1 ||
      rindex($rbug, "Obtool:") != -1 ||
      rindex($rbug, "Obtar:") != -1  ||
      rindex($rbug, "obtar:") != -1)
  {
    my $err;
    if (rindex($rbug, "Error:") > -1)
    {
      $err = "Error:";
    }
    if (rindex($rbug, "obtool:") > -1)
    {
      $err = "obtool:";
    }
    if (rindex($rbug, "Obtool:") > -1)
    {
      $err = "Obtool:";
    }
    if (rindex($rbug, "obtar:") > -1)
    {
      $err = "obtar:";
    }
    if (rindex($rbug, "Obtar:") > -1)
    {
      $err = "Obtar:";
    }
    my $lt;
    my $msg;
    ($lt, $msg) = split /$err/, $rbug;
    ($lt, $msg) = split /\n/, $msg;

print "$rbug\n";
    #api not supported in 11.2 DB
    #printAddJobParamsCmdBlk("-1","","$rbug"); 
    return -1;
  }

# Take a breath and sleep.
  #sleep 20;

# Loop through all captured jobs and return the transcaripts.
  foreach (@ids)
  {
    # Get the job ID from $results.
    my $blah;
    my $jid;
    ($blah, $jid) = split /job id is/, $_;
    my $lindex = index $jid,'.';
    if ($lindex != -1)
    {
      my $mpid = substr($jid, 1, $lindex - 1);

# Poll OSB for job status
      my $temp_poll_command = "$poll_command --subjobs $mpid";
      $ob_command = "$temp_poll_command";
      OBrunOb();

# If the job has not finished then sleep and retry.
      my $len = length $mpid;

while (checkForError() == 0 &&
             checkForFailed($jstate) == 0 &&
             $len > 0 &&
             ( rindex($jstate, "running") > -1 ||
               rindex($jstate, "ready to run") > -1 ||
               rindex($jstate, "retryable") > -1 ||
               rindex($jstate, "scheduled") > -1 ||
               rindex($jstate, "pending resource availability") > -1 ||
               rindex($jstate, "pending successful completion of preceding job") > -1 ||
               rindex($jstate, "will start after specified restore delay") > -1
             )
           )
      {  
        my $trans_level = "3";
        my $job_status = $rbug;
        #in emdbsa "action required" support is not available in EM job system.
        #so till that is available, OSB input pending jobs should be mapped to running status. Hence commenting out the section between **** ****.
    #*************************************
        #my $trans = fetchTranscript("$mpid",$trans_level);
        #printStepOutput("$trans","$orig_ob_command","$job_status");
        #print "\n------------------\n";
        #print "Operation in progress...         \n";
        
        #last if isUserActionRequired("$mpid", "$trans");
    #*************************************

# Sleep for 5 seconds.
        sleep 5;
        # Rerun the poll command. ob_command is a global variable and fetchTranscript needs to overwrite it with transcript command, so replacing it again here with the poll_command.
        $ob_command = "$temp_poll_command";
        OBrunOb();
      }

#job is now succeeded or failed or pending user input
     #get the final status
     #sleep 20;
     $ob_command = "$temp_poll_command";
     OBrunOb();
     my $job_status = $rbug;

# Set the status bit.
      if (checkForError() == 1 ||
          $len == 0 || 
          checkForFailed($jstate) == 1
        ) 
      {
        # mapped to failed
        $results = -1;
        $err_msg = "$jstate";
      }
      elsif ((rindex($jstate, "completed successfully") > -1 ||
          rindex($jstate, "completed with warnings") > -1 ) &&
             $len > 0)
      {
        # mapped to success
        $results = 0;
      }
      else
      {
        # pending user input
        $results = 1;
      }

# We r done, so return the transcript.
      my $trans_level = "3";
      my $trans = fetchTranscript("$mpid",$trans_level);
      printStepOutput("$trans","$orig_ob_command","$job_status");
      #api not supported in 11.2 DB
      #printAddJobParamsCmdBlk("$results","$mpid","$err_msg"); 
    }
  }
  $fpoll = "no";

# print final status
  print "\n------------------\n";
  my $optype = "Restore";
  if ($frest == 0)
  {
    $optype = "Backup";
  }
 
  print("$optype operation ");
  if ($results == 0)
  {
    print("successful.");
  }
  elsif ($results == -1)
  {
    print("failed.");
  }
  else
  {
    print("pending user input.");
  }
  
  return $results;
}

#
# checkForError, each OBrunOb updates the $rbug variable with the output/error
# so check the $rbug for different error strings and return 0 false or 1 true.
#
sub checkForError
{
  my $isError = 0;

if (rindex($rbug, "Error:") != -1  ||
      rindex($rbug, "obtool:") != -1 ||
      rindex($rbug, "Obtool:") != -1 ||
      rindex($rbug, "Obtar:") != -1  ||
      rindex($rbug, "obtar:") != -1)
  {
     $isError = 1;
  }
  else
  {
     $isError = 0;
  }

return $isError;
}

sub checkForFailed
{
  my $state = $_[0];
  my $isFailed = 0;
  if (rindex($state, "failed") > -1 ||
      rindex($state, "cancelled") > -1 ||
      rindex($state, "invalid") > -1 ||
      rindex($state, "expired") > -1 ||
      rindex($state, "exited") > -1 ||
      rindex($state, "killed") > -1 ||
      rindex($state, "completed partially") > -1 ||
      rindex($state, "superseded") > -1 ||
      rindex($state, "mixed results") > -1
     )
   {
      $isFailed = 1;
   }

return $isFailed;
}

# isUserActionRequired (jobid, transcript) returns true or false
# lsjob --inputrequest <jobid> is one way to find if the job needs user input
# however checking the transcript may cover more cases.
sub isUserActionRequired
{
   my $actionRequired = 0;
   my $mpid = $_[0];
   my $trans = $_[1];

#sleep 20;
   $ob_command = "$poll_command --inputrequest --subjobs $mpid";
   OBrunOb();

#rbug will have the job status if this jobid is indeed waiting for user input
   #else rbug says "Error: job <jobid> not found or doesn't match selection criteria."
   if (rindex($rbug, "not found or doesn't match selection criteria") == -1)
   {
      $actionRequired = 1;
   } 
   # quick way to put backup, restore job in action required status only for dev testing
   # uncomment the following elsif block, comment when done
   # for backup and restore, choose device that does not have volume loaded
   #elsif (rindex($trans, "A volume is needed to perform a backup") > -1 ||
   #       rindex($trans, "No volume could be found in") > -1)
   #{
   #   $actionRequired = 1;
   #}
   else
   {
      $actionRequired = 0;
   }

return $actionRequired;
}

# fetchTranscript (jobid, trans_level) returns transcript
sub fetchTranscript
{
  my $mpid = $_[0];
  my $trans_level = $_[1];
  my $trans;
  my $len = length $mpid;
  my $temp_trans_command = $trans_command;

if ($len > 0)
      {
        my $i = 1;

#if transcript_level is non-empty, replace this level in the transcript command
        if ($trans_level)
        {
           my $indexLevel = index($trans_command, "--level");
           if ($indexLevel > -1)
           {
              $temp_trans_command = substr($trans_command, 0, $indexLevel);
              $temp_trans_command .= "--level $trans_level";
           }
        }

# Build Job ID and get transcript.
        # If it was a backup then append the subjobs .x.
        my $lpid;
        if ($frest == 0)
        {
          $lpid = sprintf("$mpid.%d", $i);
        }
        else
        {
          $lpid = $mpid;
        }
    
        # Sleep for 20 seconds.
        #sleep 20;

$ob_command = "$temp_trans_command $lpid";
        OBrunOb();
    
        if ($frest == 0)
        {
          # Loop unilt there are no more transcripts.
          my $br = 0;
          while (rindex($rbug, "not found or doesn't match selection criteria") == -1 && $br == 0 && $len > 0)
          {
            $i = $i + 1;

# Sleep for 20 seconds.
            #sleep 20;

# If it was a backup then append the subjobs .x.
            $lpid = sprintf("$mpid.%d", $i);
            $ob_command = "$temp_trans_command $lpid";
            $trans .= $rbug;
            OBrunOb();
          }
        }
        else
        {
          $trans .= $rbug;
        }
      }
   
  return $trans;
}

#
# prints the step output, input: transcript, obtool command, job status
# clears the previous output and prints in the order : command, status, transcript
#
sub printStepOutput
{
  my $trans = $_[0];
  my $command = $_[1];
  my $status = $_[2];

#api not supported in 11.2 DB
  #printClearOutputCmdBlk();
  if ($command)
  {
     print "Command\n";
     print "------------------\n";
     print "$command\n\n";
  }
  
  if ($status)
  {
     print "Current Status\n";
     print "------------------\n";
     print "$status\n\n";
  }

print "$trans      \n";  
}

#
# prints the xml command block that is processed by the EM job system
# and used to clear the previous output of the step.
#
sub printClearOutputCmdBlk
{
    print "\n";
    print '$$$--*$$';
    print "<commandBlock>";
    print "    <executeProc name=\"MGMT_JOBS.TRUNCATE_STEP_OUTPUT\">";
    print "        <scalar>\%job_step_id\%</scalar>";
    print "    </executeProc>";
    print "</commandBlock>";
    print '$$$*--$$';
    print "\n";
}

#
# prints the xml command block to add obtool_job_status and obtool_job_id
# in the job parameter table of em jobs
#
sub printAddJobParamsCmdBlk
{
    my $obtool_job_status = $_[0];
    my $obtool_job_id = $_[1];
    my $obtool_job_errmsg = $_[2];

print "\n";
    print '$$$--*$$';
    print "<commandBlock>";
    print "<executeProc name=\"MGMT_JOBS.ADD_JOB_PARAMETERS\">";
    print "        <scalar>\%job_id\%</scalar>";
    print "        <scalar>\%job_execution_id\%</scalar>";
    print "        <array>";
    print "            <record>";
    print "                <scalar>obtool_job_status</scalar>";
    print "                <scalar>1</scalar>";
    print "                <scalar>$obtool_job_status</scalar>";
    print "                <array>null</array>";
    print "                <scalar>0</scalar>";
    print "            </record>";

# if job has failed or succeeded end the loop on emjob side
    # for this set the loopVar to 0 elements by setting to null
    if ($obtool_job_status == "-1" || $obtool_job_status == "0")
    {
       print "            <record>";
       print "                <scalar>loopVar</scalar>";
       print "                <scalar>0</scalar>";
       print "                <scalar>null</scalar>";
       print "                <array>null</array>";
       print "                <scalar>0</scalar>";
       print "            </record>";
    }

if($obtool_job_id)
    {
      print "            <record>";
      print "                <scalar>obtool_job_id</scalar>";
      print "                <scalar>1</scalar>";
      print "                <scalar>$obtool_job_id</scalar>";
      print "                <array>null</array>";
      print "                <scalar>0</scalar>";
      print "            </record>";
    }

if($obtool_job_errmsg)
    {
      print "            <record>";
      print "                <scalar>obtool_job_errmsg</scalar>";
      print "                <scalar>1</scalar>";
      print "                <scalar>$obtool_job_errmsg</scalar>";
      print "                <array>null</array>";
      print "                <scalar>0</scalar>";
      print "            </record>";
    }

print "         </array>";
    print "    </executeProc>";
    print "</commandBlock>";
    print '$$$*--$$';
    print "\n";
}

#
# isRestoreType (longstatus i.e. output of lsj -l <jobid>)
#
sub isRestoreType
{
  my $status = $_[0];
  my $ptr = index($status, "Type:");
  #24 = length of Type: + number of spaces before start of type string
  my $type = substr($status, $ptr+24,7);
  if (rindex($type,"restore") > -1)
  {
     return 1;
  }
  else
  {
    return 0;
  }
}

#
# runOb
#
# Run Oracle Backup CLI and pass output backup up to the OMS.
# 
sub OBrunOb()
{
  my $opid = 0;
  EMD_PERL_DEBUG("ob.runOb(): start");
  $? = 0;
  local $SIG{PIPE};
  local $SIG{CHLD};
  if (!$NT)
  {
    $SIG{CHLD} = 'IGNORE';
  }
  my $rbpath;
  my $other;
  my $ack;
  my $rblocal;

# Check for obtool in the ob_command string.
  ($rbpath, $other) = split /obtool/, $ob_command;

EMD_PERL_DEBUG("ob.runOb(): obpath: $rbpath");

# Check for .local.bin.
  ($rblocal, $ack) = split /bin/, $ob_command;
  chop $rblocal;
  if (-e "$rblocal/.bin.local/obtool")
  {
    ($rbpath, $other) = split /obtool/, $ob_command;
    $ob_command = "$rblocal/.bin.local/obtool $other";
  }
  else
  {
    if (!-e "$rbpath/obtool" && !-e "$rbpath/obtool.exe")
    {
      print "ob_o.OBrunOb(): No obtool found:($ob_command): $rbpath [$rblocal/.bin.local/obtool]";
      return -1;
    }
  }

$tmprb = $ob_command;
  if ($NT)
  {
    $rbpath = join '\\', split /\//, $rbpath;
    my @leaves = split /\\/, $rbpath;
    $ob_command = "";
    my $f = 0;
    while (@leaves)
    {
      my $leaf = shift @leaves;
      if ($f == 0)
      {
        $ob_command = $leaf;
        $f = 1;
      }
      else
      {
        my $pos = -1;
        if (index($leaf, " ", $pos) > -1)
        {
          $ob_command = "$ob_command\\\"$leaf\"";
        }
        else
        {
          $ob_command = "$ob_command\\$leaf";
        }
      }
    }
    $ob_command = "$ob_command\\obtool.exe $other";
  }

# original ob_command variable is replaced by lsjob and catxcr command durig polling
  # so keeping a copy of the original command to print in step output
  if (!$orig_ob_command)
  {
    $orig_ob_command = $ob_command;
  }

# fix for long restore commands on NT
  if ($NT && rindex($ob_command, "; restore --tohost") != -1)
  {
    my $ob_initial;
    ($ob_initial, $ob_command_ext) = split /cd --host/, $ob_command;
    $ob_command = $ob_initial;
    $ob_command_ext = "cd --host $ob_command_ext";
  }

# Look for ADE env file.
  my $rest;
  ($rbtmpfile, $rest) = split /bin/, $tmprb;
  chop $rbtmpfile;
  $rbtmpfile = "$rbtmpfile/rbmapvars.sh";
  if (-e "$rbtmpfile")
  {
    OBset_ob_env();
  }
  else
  {
    if (!$NT)
    {
      OBset_sh_lib_path();
    }
  }

EMD_PERL_DEBUG("ob_o.OBrunOb(): open2: command: $ob_command");
  $opid = open2(\*RDRFH, \*WRITER, "$ob_command 2>&1")
      || ((print "ob_o.OBrunOb: Unable to open the obtool process.<br>") && (return -1)); 
  # Turn on autoflush for pipe output
  my $old_fh = select(RDRFH);
  $| = 1;
  select($old_fh);

if (!$NT)
  {  
      # set RDRFH non-blocking
      my $flags = '';
      fcntl(RDRFH, F_GETFL(), $flags)
          or die "Couldn't get flags for RDRFH : $!\n";
      $flags |= O_NONBLOCK();
      fcntl(RDRFH, F_SETFL(), $flags)
          or die "Couldn't set flags for RDRFH: $!\n";
  }

# Turn on autoflush for standard output
  $old_fh = select(STDOUT);
  $| = 1;
  select($old_fh);

# Write the password to obtool
  print WRITER $ob_password;
  print WRITER "\n";

if ($NT && $ob_command_ext)
  {
     print WRITER $ob_command_ext;
     print WRITER "\n";
  }

if ($sd_password)
  {
    print WRITER $sd_password;
    if ($NT)
    {
        print WRITER "\n";
    }
  }

if ($NT && $ob_command_ext)
  {
     print WRITER "quit\n";
     $ob_command_ext = "";
  }
  close WRITER;
  
  my $MAX_OUT_SIZE = 7168; #7K
  my $cur_out_size = 0;
  my $timeout = 0;
  my $rin;
  my $rout;
  $rbug = "";
  $jstate = "";

if (!$NT)
  {
      my $rin;
      # Construct the data structure for select call
      vec($rin, fileno(RDRFH), 1) = 1;
    
      my $bufSize = 100;
      my $fullBuf ="";
      my $buf;
      my $sysret;
      
      while (1)
      {
          # wait for reading event on RDRFH, or timeout after 5 seconds
          $a = select($rout=$rin, undef, undef, 5 );
        
          if ($a > 0 && vec($rout,fileno(RDRFH),1))
          {
              # There are something in RDRFH for read
              $sysret = sysread RDRFH, $buf, $bufSize;
            
              if (defined($sysret))
              {
                  if ($sysret == 0)
                  {
                      # RDRFH is closed by ob
                      last;
                  }
                  else
                  {
                      my $fullBuf .= $buf;
                      
                      $cur_out_size += length($buf);
                      my $f = rindex $fpoll,"yes";
                      if ($f < 0)
                      {
                        print "$buf";
                      }
                      else
                      {
                        $rbug .= $buf;
                        my $ptr  = rindex $rbug,"Priority:";
                        my $ptr2 = rindex $rbug,"State:";
                        my $lt = length($jstate);
                        if ($ptr > -1 && $lt == 0)
                        {
                          # 24 = length of State: + number of spaces before start of status string, 5 = number of spaces before Priority:
                          $jstate = substr ($rbug, ($ptr2 + 24), $ptr-$ptr2-24-5);
                        }
                        if (!$frest || $frest == 0)    
                        {
                           $frest = isRestoreType("$rbug");
                        }
                      }
                  }
              }
          }
          else
          {
             # select() times out or detects an error
             if ($timeout > 60)
             {
                # ob has exited as detected by the reaper
              
                # we do a final non-blocking reading in case there are something 
                # in the pipe left by obtool
                while ($sysret = sysread RDRFH, $buf, $bufSize)
                {
                    $fullBuf .= $buf;

$cur_out_size += length($buf);

my $f = rindex $fpoll,"yes";
                    if ($f < 0)
                    {
                      print "$buf";
                    }
                    else
                    {
                      $rbug .= $buf;
                    }
                }    
    
                last;
             } 
             $timeout = $timeout + 5;
          } 
      }
  }
  else
  {
    # NT case
    my $fullBuf ="";
    my $buf; 
    my $sysret;

do {
        $sysret = sysread RDRFH, $buf, 100;
        if (defined($sysret))
        {	
            $cur_out_size += length($buf);
            my $f = rindex $fpoll,"yes";
            if ($f < 0)
            {
              print "$buf";
            }
            else
            {
              $rbug .= $buf;
                        my $ptr  = rindex $rbug,"Priority:";
                        my $ptr2 = rindex $rbug,"State:";
                        my $lt = length($jstate);
                        if ($ptr > -1 && $lt == 0)
                        {
                          # 24 = length of State: + number of spaces before start of status string, 5 = number of spaces before Priority:
                          $jstate = substr ($rbug, ($ptr2 + 24), $ptr-$ptr2-24-5);
                        }
                        if (!$frest || $frest == 0)
                        {
                           $frest = isRestoreType("$rbug");
                        }

}
            $fullBuf=$fullBuf.$buf;
        }    
        else
        {
            print "An error ocurred when reading from ob: $? $!\n";
            $ob_result = -1;
        }

} while (defined($sysret) && $sysret != 0);
  
  }  
  # xun: close RDRFH after reading is done
  close RDRFH;

if ($NT)
  {
     # On NT, there is no reaper to collect the exit status of obtool.
     # We'll do it here.
     my $wpid = waitpid $opid, 0;
     
     if ($wpid != -1)
     {
        $ob_result = $?;
     }

# if waitpid returns -1 (in which case it's a bug for perl), 
     # we'll have to parse the obtool output to determine whether 
     # the operation is successful or not

}
  else
  {
    if (rindex( $fpoll,"yes") > -1)
    {
      sleep 5;
    }
    my $kid = 0;
    do 
    {
	$kid = waitpid(-1, WNOHANG);
    } while $kid > 0;
  }
      
  if ($ob_result != 0)
  {
    $ob_result = -1;
  }

EMD_PERL_DEBUG("ob.runOb(): end");

return("return -1;");
}

Ms-Dos/Windows Unix Write backup

jsp File Browser version 1.2 by www.vonloesch.de