# DDCrun.def: Oracle Database Diagnostics Collector (Data Collection)
# $Id: DDCrun.def,v 1.18 2008/03/10 15:59:15 mschenke Exp $
# ARCS: $Header: /home/cvs/repository/RDA_4/src/scripting/lib/modules/DDCrun.def,v 1.18 2008/03/10 15:59:15 mschenke Exp $
#
# Change History
# 20080310  MSC  Improve the lock contention report.

=head1 NAME

DDCrun - Oracle Database Diagnostics Collector (Data Collection)

=head1 DESCRIPTION

This module executes the data collection part of the Oracle Database
Diagnostics Collector.

=cut

echo tput('bold'),'Collecting dumps/traces for Oracle Database processes ...',\
     tput('off')

# Initialisation
import $ORACLE_HOME,$ORACLE_SID,$RPT_DIRECTORY,$RPT_GROUP
import $DDC_CMD,$DDC_PID,$DDC_SLP,$DDC_USR,@DDC_BGP,@DDC_PID,%DDC_PRC,%DDC_DMP
import $WAIT

var $ABR = concat('DDC_',localtime('%y%m%d%H%M'))
var $CPG = getSetting('DDC_CALL_KSMCPG')
var $DBC = not(getSqlPrelim())
var $DIR = catDir(getSetting('RPT_DIRECTORY'),'extern')
var $KIP = 0
var $LGT = getSetting('RDA_BASENAME',38)
var $PID = getPid()
var $PRE = concat($RPT_GROUP,'_',$ABR,'_')
var $SID = field(':',-1,$ORACLE_SID)
var $STA = concat($RPT_GROUP,'_TMP_ddcst_',$SID,'.tmp')
var $TOC = '%TOC%'
var $TOP = '[[#Top][Back to top]]'
var $WUP = catFile($RPT_DIRECTORY,\
                   concat($RPT_GROUP,'_TMP_ddcup_',$SID,'.tmp'))
var $CLR = concat('TMP_ddcup_',quote($SID),'\.tmp')
var $REQ = concat($RPT_GROUP,'_TMP_ddcrq_',$SID,'_(\d+).tmp')
var ($TTL,@EVT,@HDR,@KIP,@TTL) = ()

call setAbbr($ABR)

# Load the common macros
run DBinfo()

# --- Features ----------------------------------------------------------------

# Generic dumps/reports:
#  A Hang Analyze Dump
#  C Locking Contention Report
#  H Shared Pool (Heap) Dump
#  L Library Cache Dump
#  R Row Cache Dump
#  S System State Dump
#  W Session Wait Events Report

# Process dumps/traces:
#  E Process Error Stack
#  O Operating System Trace
#  P Process State Dump
#  S Process Stack
#  T 10046 Trace

## Unimplemented features:
##  X  export SCRIPT_LIST=`echo ${OPTARG} | sed "s/,/ /g"`;;
## $DDC_TEST_MODE

# --- Process Control Macro Definitions ---------------------------------------

# Create an execution indicator
macro create_lock
{var ($job,$grp,$pid,@txt) = @arg

 var $nam = concat($grp,$pid)
 call createTemp($nam,concat('.',$job))
 if @txt
  call writeTemp($nam,@txt)
 call closeTemp($nam)
}

# Remove all execution indicators for a group
macro delete_group
{var ($job,$grp) = @arg

 call purge('O',concat('TMP_',$grp,'-?\d+_-?\d+\.',$job,'$'),-1,0)
}

# Remove an execution indicator
macro delete_lock
{var ($job,$grp,$pid) = @arg

 call purge('O',concat('TMP_',$grp,$pid,'_-?\d+\.',$job,'$'),-1,0)
}

# Get the lock pattern
macro get_lock
{var ($job,$grp) = @arg
 import $RPT_GROUP

 return concat('^',$RPT_GROUP,'_TMP_',$grp,'(-?\d+)_-?\d+\.',$job,'$')
}

# Find running processes
macro grep_lock
{var ($job,$grp) = @arg
 import $RPT_DIRECTORY,$RPT_GROUP

 return grepDir($RPT_DIRECTORY,\
   concat('^',$RPT_GROUP,'_TMP_',$grp,'-?\d+_-?\d+\.',$job,'$'),'i')
}

# Check the synchronization requirements
macro check_wait
{if get_wait(@arg)
  return sprintf('!!call kip(%d)',last)
 return ''
}

macro get_wait
{var $txt = join('',@arg)
 import $KIP,$WAIT,@KIP
 keep $KIP,$WAIT,@KIP

 if $WAIT
 {incr $KIP
  var $KIP[$KIP] = $txt
  return $KIP
 }
 return 0
}

# Synchronize the execution
macro kip
{var ($off) = @arg
 import $CLR,$REQ,$RPT_DIRECTORY,$STA,$WUP,@KIP
 keep $CLR,$REQ,$RPT_DIRECTORY,$STA,$WUP,@KIP

 var $txt = $KIP[$off]
 suspend report
 output EF,log
 call dsp_event('Waiting on wake-up for ',$txt)
 close

 while true
 {# Touch the timestamp file
  output ON,$STA
  write
  close

  # Check the presence of the wakeup file
  sleep 3
  if testFile('f',$WUP)
  {output EF,log
   call dsp_event('Waking up for ',$txt)
   break
  }

  # Detect a status request
  if grepDir($RPT_DIRECTORY,$REQ,'if')
  {var ($req) = last
   var ($pid) = match($req,$REQ,true)
   next expr('==',$pid,$prv)
   output OF,$req
   write '- Pending on ',$txt
   close
   var $prv = $pid
  }
 }
 resume report
}

# --- Output Macro Definitions ------------------------------------------------

# Start logging events
macro begin_log
{prefix
  write '<verbatim>'
}

# Display and log an event
macro dsp_event
{debug @arg
 call log_event(@arg)
}
macro DspEvent
{var ($evt) = @arg
 import @EVT
 keep @EVT

 suspend report
 output EF,log
 call dsp_event($EVT[$evt])
 resume report
}

# Display and log a line
macro dsp_line
{debug @arg
 write @arg
}

# End logging events
macro end_log
{if hasOutput(true)
  write '</verbatim>'
}

# Log an event
macro log_event
 write localtime('%H:%M:%S'),': ',@arg

# --- Macro Definitions -------------------------------------------------------

# Check hanganalyze dump for suspicious sessions
macro check_hanganalyze
{var ($log) = @arg

 call dsp_event('Checking hanganalyze dump for hangs and blockers ...')
 if grepFile($log,'hanganalyze.*\.trc','i')
 {# Identify the corresponding trace list (excluding duplicates)
  loop $lin (last)
   var $fil{value($lin)} = 1

  # Treat all files
  var $pre = '            '
  loop $fil (keys(%fil))
  {# List 'in-hang' SIDs
   var %tbl = ()
   loop $lin (grepFile($fil,'IN_HANG'))
   {var @tbl = split('\/',$lin)
    next !length($tbl[5])
    var $tbl{concat($tbl[2],' (',$tbl[5],')')} = true
   }
   if keys(%tbl)
   {var @tbl = last
    call dsp_line()
    call dsp_event('Examining file: ',$fil)
    call dsp_event('The following "in hang" SIDs (O/S PIDs) found:')
    loop $lin (@tbl)
     call dsp_line($pre,$lin)
    call dsp_event('Consider running a process state dump for these ...')
    call dsp_line()
   }

   # List blocking SIDs
   var %tbl = ()
   loop $lin (grepFile($fil,'LEAF'))
   {var @tbl = split('\/',$lin)
    next !length($tbl[5])
    var $tbl{concat($tbl[2],' (',$tbl[5],')')} = true
   }
   if keys(%tbl)
   {var @tbl = last
    call dsp_line()
    call dsp_event('Examining file: ',$fil)
    call dsp_event('The following blocking SIDs (O/S PIDs) found:')
    loop $lin (@tbl)
     call dsp_line($pre,$lin)
    call dsp_event('Consider running a process state dump for these ...')
   }

   # List process dumps
   call dsp_line()
   call dsp_event('** If process traces have been generated')
   call dsp_event('     by hanganalyze the PIDs will appear below ...')
   var %tbl = ()
   loop $lin (grepFile($fil,'^Dumping'))
   {if match($lin,'^.* (\d+)')
    {var ($pid) = last
     var $tbl{$pid} = true
    }
   }
   if keys(%tbl)
   {var @dmp = last
    call dsp_line()
    call dsp_event('The hanganalyze has already generated process dumps for \
                    the following:')
    var %tbl = ()
    loop $lin (grepFile($fil,'^Dumping'))
     var $tbl{replace($lin,'Dumping','Dumped')} = 1
    loop $lin (keys(%tbl))
     call dsp_line($pre,$lin)
    call dsp_line()

    call dsp_line()
    call dsp_event('Trace/dump files generated by HANGANALYZE:')
    var $bdd = get_bdump()
    var $udd = get_udump()
    loop $pid (@dmp)
    {loop $trc (grepDir($udd,concat('_',$pid,'_.*\.trc$'),'inp'))
      call dsp_line($pre,$trc)
     loop $trc (grepDir($bdd,concat('_',$pid,'_.*\.trc$'),'inp'))
      call dsp_line($pre,$trc)
    }
   }
   else
    call dsp_event('The hanganalyze did not appear to generate any process \
                    dumps.')
  }
 }
}

# Collate produced traces
macro collate_traces
{var ($log) = @arg
 import $LGT,$PRE,$TOP,$STK_PGM,$TRC_PGM

 # Stop event logging
 call end_log()
 write $TOP
 prefix
 {write '---+ Trace File Summary'
  write '**Note:** Some trace files may also contain other diagnostic types \
         in addition to what indicated, depending on the combination of \
         options selected.%BR%&nbsp;'
 }

 # Define a macro retrieving reports
 macro find_traces
 {var ($log,$pat) = @arg
  import $DIR
  keep $DIR

  var @lnk = ()
  loop $lin (grepFile($log,$pat))
  {var $fil = field(':\s+',2,$lin)
   if testFile('r',catFile($DIR,$fil))
    var @lnk = (@lnk,concat('[[',$fil,'][_blank][',$fil,']]'))
  }
  return @lnk
 }
 macro find_reports
 {var ($log) = @arg

  var @lnk = ()
  loop $lin (grepFile($log,'Spooling to:'))
  {var $fil = field(':\s+',2,$lin)
   var @lnk = (@lnk,concat('[[',value($fil),'][_blank][',key($fil),']]'))
  }
  return @lnk
 }

 # Collate report files
 if find_reports($log)
  write '|*Reports*|',join('%BR%',last),'|'

 # Collate stack traces
 if find_traces($log,'Stack trace written to:')
  write '|*Stack (',$STK_PGM,') Traces*|',join('%BR%',last),'|'

 # Collate O/S traces
 if find_traces($log,'O/S trace written to:')
  write '|*O/S (',$TRC_PGM,') Traces*|',join('%BR%',last),'|'

 # Collate Oracle dumps
 if grepFile($log,'Trace identifier:')
 {var ($cnt,@lin) = (0,last)
  suspend log
  loop $lin (@lin)
  {var $lin = field(':\s+',2,$lin)
   var $trc = catFile(value($lin))
   if missing($lnk{$trc})
   {incr $cnt
    output EN,concat(\
      substr(concat($PRE,'trc',$cnt,'_',basename($trc,'.trc')),0,$LGT),\
      '.dat')
    call writeData($trc)
    var $rpt = basename(getFile('.'))
    var $lnk{$trc} = concat('[[',basename(getFile('.')),'][_blank][',$trc,']]')
    close
   }
   call setDataValue('trc',key($lin),$lnk{$trc},1)
  }
  resume log
  loop $key (getDataKeys('trc'))
   write '|*',$key,'*|',join('%BR%',getDataKeys('trc',$key)),'|'
 }

 # Terminate the report and restart event logging
 if hasOutput(true)
  write $TOP
 write '---### ORADDC collection ended at ',localtime('%d-%b-%Y %H:%M:%S')
}

# Collect a 10046 trace
macro collect_10046
{var ($pid) = @arg
 import $PID,$PRE
 keep $PID,$PRE

 job
 {call create_lock($PID,'ddcpt',getPid(),'pid=',$pid)
  var $sql = check_wait('10046 trace (PID: ',$pid,')')
  append $sql
  {oradebug setospid :1
  "PROMPT oradebug event 10046 trace name context forever, level 12
  "oradebug event 10046 trace name context forever, level 12
  "oradebug tracefile_name
  "oradebug setmypid
  }
  output EN,concat($PRE,'pt_',$pid,'.tmp')
  call writeSql(bindSql($sql,$pid))
  var $rpt = getFile('/')
  output EF,log
  if grepFile($rpt,'\.trc','if')
   call log_event('Trace identifier: 10046 Trace=',trim(last))
  close
 }
}

# Collect an error stack
macro collect_error_stack
{var ($pid) = @arg
 import $DDC_SLP,$PID,$PRE,@EVT
 keep $DDC_SLP,$PID,$PRE,@EVT

 var $min = expr('*',3,$DDC_SLP)
 call dsp_event('Please wait, this will take at least ',$min,' seconds ...')
 job
 {call create_lock($PID,'ddcps',getPid())
  var $sql = check_wait('error stack (PID: ',$pid,')')
  append $sql
  {oradebug setospid :2
  "oradebug unlimit
  "PROMPT oradebug dump errorstack 3
  "oradebug dump errorstack 3
  "PROMPT ___Macro_DspEvent(2)___
  "!!sleep(:1)
  "oradebug dump errorstack 3
  "PROMPT ___Macro_DspEvent(1)___
  "!!sleep(:1)
  "oradebug dump errorstack 3
  "oradebug tracefile_name
  "PROMPT ___Macro_DspEvent(0)___
  }
  output EN,concat($PRE,'pe_',$pid,'.tmp')
  var @EVT = (\
    concat('(PID: ',$pid,' / errorstack 3 of 3) Done.'),\
    concat('(PID: ',$pid,' / errorstack 2 of 3) Sleeping for ',$DDC_SLP,\
           ' seconds ...'),\
    concat('(PID: ',$pid,' / errorstack 1 of 3) Sleeping for ',$DDC_SLP,\
           ' seconds ...'))
  call writeSql(bindSql($sql,$DDC_SLP,$pid))
  var $rpt = getFile('/')
  output EF,log
  if grepFile($rpt,'\.trc','if')
   call log_event('Trace identifier: Error Stack=',trim(last))
  close
  call delete_lock($PID,'ddcps',getPid())
 }
}

# Collect hang analyze information
macro collect_hang_analyze
{import $CPG,$DBC,$DDC_SLP,$PID,$PRE,@EVT
 keep $CPG,$DBC,$DDC_SLP,$PID,$PRE,@EVT

 var $min = expr('*',3,$DDC_SLP)
 call dsp_event('Please wait, this will take at least ',$min,' seconds ...')
 job
 {call create_lock($PID,'ddcps',getPid())
  var $sql = check_wait('hang analyze')
  if $DBC
  {append $sql
   {alter session set tracefile_identifier='hanganalyze';
   }
  }
  elsif $CPG
  {append $sql
   {oradebug call ksmcpg
   }
  }
  append $sql
  {oradebug setmypid
  "oradebug unlimit
  "PROMPT oradebug hanganalyze 3
  "oradebug hanganalyze 3
  "PROMPT ___Macro_DspEvent(2)___
  "!!sleep(:1)
  "oradebug hanganalyze 3
  "PROMPT ___Macro_DspEvent(1)___
  "!!sleep(:1)
  "oradebug hanganalyze 3
  "oradebug tracefile_name
  "PROMPT ___Macro_DspEvent(0)___
  }
  output EN,concat($PRE,'da.tmp')
  var @EVT = (\
    '(hang_analyze 3 of 3) Done.',\
    concat('(hang_analyze 2 of 3) Sleeping for ',$DDC_SLP,' seconds ...'),\
    concat('(hang_analyze 1 of 3) Sleeping for ',$DDC_SLP,' seconds ...'))
  call writeSql(bindSql($sql,$DDC_SLP))
  var $rpt = getFile('/')
  output EF,log
  if grepFile($rpt,'\.trc','i',-1)
   call log_event('Trace identifier: Hang Analyze=',trim(last))
  close
  call delete_lock($PID,'ddcps',getPid())
 }
}

# Collect a heapdump
macro collect_heapdump
{import $CPG,$DBC,$PID,$PRE,@EVT
 keep $CPG,$DBC,$PID,$PRE,@EVT

 job
 {call create_lock($PID,'ddcps',getPid())
  var $sql = check_wait('heapdump')
  if $DBC
  {append $sql
   {alter session set tracefile_identifier='heapdump';
   }
  }
  elsif $CPG
  {append $sql
   {oradebug call ksmcpg
   }
  }
  append $sql
  {oradebug setmypid
  "oradebug unlimit
  "PROMPT oradebug dump heapdump 536870915;
  "oradebug dump heapdump 536870915;
  "oradebug tracefile_name
  "PROMPT ___Macro_DspEvent(0)___
  }
  output EN,concat($PRE,'dh.tmp')
  var @EVT = ('(heapdump 536870915) Done.')
  call writeSql($sql)
  var $rpt = getFile('/')
  output EF,log
  if grepFile($rpt,'\.trc','if')
   call log_event('Trace identifier: Heapdump=',trim(last))
  close
  call delete_lock($PID,'ddcps',getPid())
 }
}

# Collect the library cache
macro collect_lib_cache
{import $CPG,$DBC,$PID,$PRE,@EVT
 keep $CPG,$DBC,$PID,$PRE,@EVT

 job
 {call create_lock($PID,'ddcps',getPid())
  var $sql = check_wait('library cache')
  if $DBC
  {append $sql
   {alter session set tracefile_identifier='libcache';
   }
  }
  elsif $CPG
  {append $sql
   {oradebug call ksmcpg
   }
  }
  append $sql
  {oradebug setmypid
  "PROMPT oradebug dump library_cache 4
  "oradebug dump library_cache 4
  "oradebug tracefile_name
  "PROMPT ___Macro_DspEvent(0)___
  }
  output EN,concat($PRE,'dl.tmp')
  var @EVT = ('(library cache) Done.')
  call writeSql($sql)
  var $rpt = getFile('/')
  output EF,log
  if grepFile($rpt,'\.trc','if')
   call log_event('Trace identifier: Library Cache=',trim(last))
  close
  call delete_lock($PID,'ddcps',getPid())
 }
}

# Collect a process state dump
macro collect_process_state
{var ($pid) = @arg
 import $DDC_SLP,$PID,$PRE,@EVT
 keep $DDC_SLP,$PID,$PRE,@EVT

 var $min = expr('*',3,$DDC_SLP)
 call dsp_event('Please wait, this will take at least ',$min,' seconds ...')
 job
 {call create_lock($PID,'ddcps',getPid())
  var $sql = check_wait('process state (PID: ',$pid,')')
  append $sql
  {oradebug setospid :2
  "PROMPT oradebug dump processstate 10
  "oradebug dump processstate 10
  "PROMPT ___Macro_DspEvent(2)___
  "!!sleep(:1)
  "oradebug dump processstate 10
  "PROMPT ___Macro_DspEvent(1)___
  "!!sleep(:1)
  "oradebug dump processstate 10
  "oradebug tracefile_name
  "oradebug setmypid
  "PROMPT ___Macro_DspEvent(0)___
  }
  output EN,concat($PRE,'pp_',$pid,'.tmp')
  var @EVT = (\
    concat('(PID: ',$pid,' / process_state 3 of 3) Done.'),\
    concat('(PID: ',$pid,' / process_state 2 of 3) Sleeping for ',$DDC_SLP,\
           ' seconds ...'),\
    concat('(PID: ',$pid,' / process_state 1 of 3) Sleeping for ',$DDC_SLP,\
           ' seconds ...'))
  call writeSql(bindSql($sql,$DDC_SLP,$pid))
  var $rpt = getFile('/')
  output EF,log
  if grepFile($rpt,'\.trc','if')
   call log_event('Trace identifier: Process State=',trim(last))
  close
  call delete_lock($PID,'ddcps',getPid())
 }
}

# Collect the row cache
macro collect_row_cache
{import $CPG,$DBC,$PID,$PRE,@EVT
 keep $CPG,$DBC,$PID,$PRE,@EVT

 job
 {call create_lock($PID,'ddcps',getPid())
  var $sql = check_wait('row cache')
  if $DBC
  {append $sql
   {alter session set tracefile_identifier='rowcache';
   }
  }
  elsif $CPG
  {append $sql
   {oradebug call ksmcpg
   }
  }
  append $sql
  {oradebug setmypid
  "PROMPT oradebug dump row_cache 10
  "oradebug dump row_cache 10
  "oradebug tracefile_name
  "PROMPT ___Macro_DspEvent(0)___
  }
  output EN,concat($PRE,'dr.tmp')
  var @EVT = ('(row cache) Done.')
  call writeSql($sql)
  var $rpt = getFile('/')
  output EF,log
  if grepFile($rpt,'\.trc','if')
   call log_event('Trace identifier: Row Cache=',trim(last))
  close
  call delete_lock($PID,'ddcps',getPid())
 }
}

# Collect a system state dump
macro collect_system_state
{import $CPG,$DBC,$DBVER,$DDC_SLP,$PID,$PRE,@EVT
 keep $CPG,$DBC,$DBVER,$DDC_SLP,$PID,$PRE,@EVT

 var $min = expr('*',3,$DDC_SLP)
 call dsp_event('Please wait, this will take at least ',$min,' seconds ...')
 job
 {call create_lock($PID,'ddcps',getPid())
  var $sql = check_wait('system state')
  if $DBC
  {append $sql
   {alter session set tracefile_identifier='systemstate';
   }
  }
  elsif $CPG
  {append $sql
   {oradebug call ksmcpg
   }
  }
  append $sql
  {oradebug setmypid
  "oradebug unlimit
  "PROMPT oradebug dump systemstate :2
  "oradebug dump systemstate :2
  "PROMPT ___Macro_DspEvent(2)___
  "!!sleep(:1)
  "oradebug dump systemstate :2
  "PROMPT ___Macro_DspEvent(1)___
  "!!sleep(:1)
  "oradebug dump systemstate :2
  "oradebug tracefile_name
  "PROMPT ___Macro_DspEvent(0)___
  }
  output EN,concat($PRE,'ds.tmp')
  var @EVT = (\
    concat('(system_state 3 of 3) Done.'),\
    concat('(system_state 2 of 3) Sleeping for ',$DDC_SLP,' seconds ...'),\
    concat('(system_state 1 of 3) Sleeping for ',$DDC_SLP,' seconds ...'))
  call writeSql(bindSql($sql,$DDC_SLP,check($DBVER,'^(10|11)',266,10)))
  var $rpt = getFile('/')
  output EF,log
  if grepFile($rpt,'\.trc','if')
   call log_event('Trace identifier: System State=',trim(last))
  close
  call delete_lock($PID,'ddcps',getPid())
 }
}

# Get the process identifier of a background process
macro get_background
{# Use the ps command on Unix to get the process identifier
 if !or(isWindows(),isVms())
  return field('\s+',1,grepCommand('ps -ef',join('_',@arg),'i'))

 # Otherwise, use the database
 if !$flg
 {debug 'Loading the background process identifiers ...'
  set $sql
  {SELECT b.name || '=' || p.spid
  " FROM gv$process p,gv$bgprocess b
  " WHERE p.inst_id = b.inst_id
  "   AND p.addr    = b.paddr;
  }
  call loadSql($sql)
  var $flg = true
  keep $flg
 }
 return value(grepLastSql(concat($arg[0],'='),'if'))
}

# Collect the session process identifiers for the blocking sessions
macro get_blocking_pids
{var $sql = check_wait('blocking sessions PIDs')
 append $sql
 {SELECT 'pid=' || p.spid
 " FROM v$process p,v$session s,dba_blockers b
 " WHERE p.addr = s.paddr
 "   AND b.holding_session = s.sid;
 }
 var @tbl = ()
 loop $lin (grepSql($sql,'^pid='))
  var @tbl = (@tbl,value($lin))
 return @tbl
}

# Collect the session process identifiers for the events specified
macro get_event_pids
{import $TOP

 # Display relevant events
 call end_log()
 prefix
 {write '---++ Requested Sessions on Following Wait Events'
  write '|*Event#*|*Wait Event*|'
 }
 var $sql = check_wait('event PIDs')
 append $sql
 {SELECT '|' ||
 "       e.event# || '|' ||
 "       e.name || '|'
 " FROM  v$event_name e
 " WHERE e.event# IN (:1);
 }
 call writeSql(bindSql($sql,join(',',@arg)))
 if hasOutput(true)
  write $TOP
 call begin_log()

 # Collect the 10 first session process identifiers for each event specified
 loop $evt (@arg)
 {var $sql = check_wait('10 first sessions for ',$evt,' event')
  append $sql
  {SELECT 'pid=' || p.spid
  " FROM v$process p,
  "      v$session s,
  "      v$session_wait w,
  "      v$event_name e
  " WHERE p.addr = s.paddr
  "   AND e.event# IN (:1)
  "   AND w.sid = s.sid
  "   AND e.name = w.event
  "   AND ROWNUM < 11;
  }
  loop $lin (grepSql(bindSql($sql,$evt),'^pid='))
   var @tbl = (@tbl,value($lin))
 }
 return @tbl
}

# Collect the session process identifiers for the Oracle process specified
macro get_oracle_pids
{var $sql = check_wait('Oracle PIDs')
 append $sql
 {SELECT 'pid=' || p.spid
 " FROM v$process p
 " WHERE p.pid IN (:1);
 }
 loop $lin (grepSql(bindSql($sql,join(',',@arg)),'^pid='))
  var @tbl = (@tbl,value($lin))
 return @tbl
}

# Collect the session process identifiers for the session identifiers specified
macro get_session_pids
{var $sql = check_wait('Session PIDs')
 append $sql
 {SELECT 'pid=' || p.spid
 " FROM v$process p,v$session s
 " WHERE p.addr = s.paddr
 "   AND s.sid IN (:1);
 }
 loop $lin (grepSql(bindSql($sql,join(',',@arg)),'^pid='))
  var @tbl = (@tbl,value($lin))
 return @tbl
}

# Collect the session process identifiers for the user specified
macro get_user_pids
{var $sql = check_wait('User PIDs')
 append $sql
 {SELECT 'pid=' || p.spid
 " FROM v$process p,v$session s
 " WHERE p.addr = s.paddr
 "   AND s.username = UPPER(':1');
 }
 loop $lin (grepSql(bindSql($sql,@arg),'^pid='))
  var @tbl = (@tbl,value($lin))
 return @tbl
}

# Report shared pool chunks
macro report_chunks
{import $PID,$TTL,@HDR,@TTL

 job
 {call create_lock($PID,'ddcps',getPid())
  output EN,dh
  var $TTL = '---++ Shared Pool Memory Utilisation'
  var @TTL = ('',\
              '---+++ Database Instance',\
              '---+++ Shared Pool Chunk Allocation (Size Aggregations)',\
              '---+++ Shared Pool Chunk Allocation (Detailed)')
  var @HDR = ('',\
              '|*DBname*|*Instance*|*Date/Time*|',\
              '| *SubPool*|*Size*|*Status*| *Min Bytes*| *Avg Bytes*| \
                 *Max Bytes*| *Tot Bytes*| *Count*|',\
              '| *SubPool*|*Chunk Comment*|*Size*| *Count*|*Status*| *Bytes*|')
  var $sql = check_wait('shared pool chunks')
  append $sql
  {SELECT '|' ||
  "       name || '|' ||
  "       instance_name || '|' ||
  "       TO_CHAR(SYSDATE,'DD-Mon-YYYY HH24:MI:SS') || '|'
  " FROM v$instance,v$database;
  "PROMPT ___Macro_separator(2)___
  "SELECT '| ' ||
  "      ksmchidx || '|' ||
  "      DECODE(ROUND(ksmchsiz/1000),0,'0-1K',
  "                                  1,'1-2K',
  "                                  2,'2-3K',
  "                                  3,'3-4K',
  "                                  4,'4-5K',
  "                                  5,'5-6k',
  "                                  6,'6-7k',
  "                                  7,'7-8k',
  "                                  8,'8-9k',
  "                                  9,'9-10k',
  "                                  '> 10K') || '|' ||
  "      ksmchcls || '| ' ||
  "      MIN(ksmchsiz) || '| ' ||
  "      ROUND(AVG(ksmchsiz)) || '| ' ||
  "      MAX(ksmchsiz) || '| ' ||
  "      SUM(ksmchsiz) || '| ' ||
  "      COUNT(*) || '|'
  " FROM x$ksmsp
  " GROUP BY ksmchidx,ksmchcls,ksmchcls,
  "          DECODE(ROUND(ksmchsiz/1000),0,'0-1K',
  "                                      1,'1-2K',
  "                                      2,'2-3K',
  "                                      3,'3-4K',
  "                                      4,'4-5K',
  "                                      5,'5-6k',
  "                                      6,'6-7k',
  "                                      7,'7-8k',
  "                                      8,'8-9k',
  "                                      9,'9-10k',
  "                                      '> 10K')
  " ORDER BY ksmchidx,ksmchcls;
  "PROMPT ___Macro_separator(3)___
  "SELECT '| ' ||
  "       ksmchidx || '|' ||
  "       ksmchcom || '|' ||
  "       DECODE(ROUND(ksmchsiz/1000),0,'0-1K',
  "                                   1,'1-2K',
  "                                   2,'2-3K',
  "                                   3,'3-4K',
  "                                   4,'4-5K',
  "                                   5,'5-6k',
  "                                   6,'6-7k',
  "                                   7,'7-8k',
  "                                   8,'8-9k',
  "                                   9,'9-10k',
  "                                   '> 10K') || '| ' ||
  "       COUNT(*) || '|' ||
  "       ksmchcls || '| ' ||
  "       SUM(ksmchsiz) || '|'
  " FROM x$ksmsp
  " GROUP BY ksmchidx,
  "          ROUND(ksmchsiz/1000),
  "          ksmchcls,
  "          'sga heap(' || ksmchidx || ',0)',
  "          ksmchcom,
  "          ksmchcls,
  "          DECODE(ROUND(ksmchsiz/1000),0,'0-1K',
  "                                      1,'1-2K',
  "                                      2,'2-3K',
  "                                      3,'3-4K',
  "                                      4,'4-5K',
  "                                      5,'5-6k',
  "                                      6,'6-7k',
  "                                      7,'7-8k',
  "                                      8,'8-9k',
  "                                      9,'9-10k',
  "                                      '> 10K')
  " ORDER BY ksmchidx;
  }
  call separator(1)
  call writeSql($sql)
  call separator(0)
  if isCreated(true)
  {var $rpt = renderFile()
   output EF,log
   call dsp_event('(shared spool chunks) Done.')
   call log_event('Spooling to: Shared Pool Chunks=',basename($rpt))
  }
  close
  call delete_lock($PID,'ddcps',getPid())
 }
}

# Report locking contention
macro report_locking_contention
{import $PID,$TTL,@HDR,@TTL

 job
 {call create_lock($PID,'ddcps',getPid())
  output EN,dc
  var $TTL = '---++!! Locking Contention Report'
  var @TTL = ('',\
              '---+++ Database Instance',\
              '---+++ Lock Tree',\
              '---+++ Lock / Block Objects',\
              '---+++ Lock / Block Processes',\
              '---+++ Lock / Block Transactions')
  var @HDR = ('',\
              '|*DBname*|*Instance*|*Date/Time*|',\
              '|*Instance-SID*|*Username*|*Lock%BR%Type*|*Mode%BR%Held*|\
                *Mode%BR%Requested*|*ID1-ID2*|',\
              '|*Instance-SID*|*Object*|*Lock Wait*|*ID1-ID2*|*SQL Text*|',\
              '|*Instance*|*Oracle%BR%User*| *Oracle%BR%PID*|\
                *Session%BR%Module*| *SID*|*SERIAL#*|*OSUser*| *O/S%BR%PID*| \
                *O/S%BR%PPID*|*Lockwait*|*ID1-ID2*|',\
              '|*Instance-SID*|*Username*|*Table Name*|*Mode%BR%Held*|\
                *Mode%BR%Requested*|*ID1-ID2*|*Lock%BR%Type*|')
  var $sql = check_wait('locking contention')
  append $sql
  {SELECT '|' ||
  "       name || '|' ||
  "       instance_name || '|' ||
  "       TO_CHAR(SYSDATE,'DD-Mon-YYYY HH24:MI:SS') || '|'
  " FROM v$instance,v$database;
  "PROMPT ___Macro_separator(2)___
  "SELECT '|' ||
  "       REPLACE(LPAD(' ',3*(LEVEL-1)),' ','&nbsp;') || wait_id || '|' ||
  "       wusername || '|' ||
  "       lock_type || '|' ||
  "       mode_held || '|' ||
  "       mode_requested || '|' ||
  "       DECODE(lock_id1,NULL,NULL,lock_id1 || '-' || lock_id2) || '|'
  " FROM (SELECT sw.inst_id || '-' || sw.sid wait_id,
  "              sh.inst_id || '-' || sh.sid hold_id,
  "              lh.type lock_type,
  "              DECODE(sh.command,0,'None',
  "              DECODE(lh.lmode,
  "                     0,'None',          /* Mon Lock equivalent */
  "                     1,'Null',          /* N */
  "                     2,'Row-S (SS)',    /* L */
  "                     3,'Row-X (SX)',    /* R */
  "                     4,'Share',         /* S */
  "                     5,'S/Row-X (SSX)', /* C */
  "                     6,'Exclusive',     /* X */
  "                     TO_CHAR(lh.lmode))) mode_held,
  "              DECODE(lw.request,
  "                     0,'None',          /* Mon Lock equivalent */
  "                     1,'Null',          /* N */
  "                     2,'Row-S (SS)',    /* L */
  "                     3,'Row-X (SX)',    /* R */
  "                     4,'Share',         /* S */
  "                     5,'S/Row-X (SSX)', /* C */
  "                     6,'Exclusive',     /* X */
  "                     TO_CHAR(lw.request)) mode_requested,
  "              lw.id1 lock_id1,
  "              lw.id2 lock_id2,
  "              NVL(sw.username,'Internal') wusername,
  "              NVL(sh.username,'Internal') husername
  "        FROM gv$lock lh,gv$lock lw,gv$session sh,gv$session sw
  "        WHERE lh.sid = sh.sid
  "          AND lw.sid = sw.sid
  "          AND sh.type != 'BACKGROUND'
  "          AND sw.type != 'BACKGROUND'
  "          AND lh.lmode != 0
  "          AND lw.lmode = 0
  "          AND lw.id1 = lh.id1
  "          AND lw.id2 = lh.id2
  "       UNION
  "       (SELECT hold_id,
  "               NULL,
  "               NULL,
  "               NULL,
  "               NULL,
  "               NULL,
  "               NULL,
  "               NULL,
  "               NULL
  "         FROM (SELECT sh.inst_id || '-' || sh.sid hold_id,
  "                      NULL wait_id,
  "                      NULL lock_type,
  "                      NULL mode_held,
  "                      NULL mode_requested,
  "                      NULL lock_id1,
  "                      NULL lock_id2,
  "                      NULL wusername,
  "                      NULL husername
  "                FROM gv$lock lh,gv$lock lw,gv$session sh,gv$session sw
  "                WHERE lh.sid = sh.sid
  "                  AND lw.sid = sw.sid
  "                  AND sh.type != 'BACKGROUND'
  "                  AND sw.type != 'BACKGROUND'
  "                  AND lh.lmode != 0
  "                  AND lw.lmode = 0
  "                  AND lw.id1 = lh.id1
  "                  AND lw.id2 = lh.id2)
  "        MINUS
  "        SELECT wait_id,
  "               NULL,
  "               NULL,
  "               NULL,
  "               NULL,
  "               NULL,
  "               NULL,
  "               NULL,
  "               NULL
  "         FROM (SELECT sw.inst_id || '-' || sw.sid wait_id,
  "                      NULL hold_id,
  "                      NULL lock_type,
  "                      NULL mode_held,
  "                      NULL mode_requested,
  "                      NULL lock_id1,
  "                      NULL lock_id2,
  "                      NULL wusername,
  "                      NULL husername
  "                FROM gv$lock lh,gv$lock lw,gv$session sh,gv$session sw
  "                WHERE lh.sid = sh.sid
  "                  AND lw.sid = sw.sid
  "                  AND sh.type != 'BACKGROUND'
  "                  AND sw.type != 'BACKGROUND'
  "                  AND lh.lmode != 0
  "                  AND lw.lmode = 0
  "                  AND lw.id1 = lh.id1
  "                  AND lw.id2 = lh.id2)
  "       )
  "      )
  " CONNECT BY PRIOR wait_id = hold_id
  " START WITH hold_id IS NULL;
  "PROMPT ___Macro_separator(3)___
  "SELECT '|'||
  "      inst_sid || ' |' ||
  "      object || ' |' ||
  "      lock_wait || ' |' ||
  "      id || ' |' ||
  "      REPLACE(REPLACE(REPLACE(sql_text,
  "        '|', '&#124;'),
  "        '<', '&lt;'),
  "        '>', '&gt;') || ' |'
  "FROM (SELECT b.inst_id || '-' || b.sid inst_sid,
  "             c.owner || '.' || c.object object,
  "             b.lockwait lock_wait,
  "             d.id1 || '-' || d.id2 id,
  "             a.sql_text sql_text
  "       FROM gv$sqltext a,gv$session b,gv$access c,
  "            (SELECT a.inst_id,a.sid,a.id1,a.id2
  "              FROM gv$lock a
  "              WHERE EXISTS (SELECT NULL
  "                             FROM gv$lock b
  "                             WHERE b.id1=a.id1
  "                               AND b.id2=a.id2
  "                               AND b.request > 0)) d
  "       WHERE a.address = b.sql_address
  "         AND a.inst_id = b.inst_id
  "         AND b.inst_id = c.inst_id
  "         AND c.inst_id = d.inst_id
  "         AND a.hash_value = b.sql_hash_value
  "         AND b.sid = c.sid
  "         AND c.sid = d.sid
  "         AND c.owner != 'SYS'
  "      UNION
  "      SELECT b.inst_id || '-' || b.sid inst_id,
  "             c.owner || '.' || c.object object,
  "             '<BLOCKER>'  lock_wait,
  "             d.id1 || '-' || d.id2 id,
  "             a.sql_text sql_text
  "       FROM gv$sqltext a,gv$session b,gv$access c,
  "            (SELECT a.inst_id,a.sid,a.id1,a.id2
  "              FROM gv$lock a
  "              WHERE (id1,id2) IN (SELECT b.id1,b.id2
  "                                   FROM gv$lock b
  "                                   WHERE b.id1 = a.id1
  "                                     AND b.id2 = a.id2
  "                                     AND b.request > 0)) d
  "       WHERE a.address = b.prev_sql_addr
  "         AND b.sql_address = '00'
  "         AND a.inst_id = b.inst_id
  "         AND b.inst_id = c.inst_id
  "         AND c.inst_id = d.inst_id
  "         AND b.sid = c.sid
  "         AND c.sid = d.sid
  "         AND a.hash_value = b.prev_hash_value
  "         AND c.owner != 'SYS')
  " ORDER BY id,lock_wait desc,inst_sid;
  "PROMPT ___Macro_separator(4)___
  "SELECT '|' ||
  "       s.inst_id || ' |' ||
  "       SUBSTR(s.username,1,11) || ' | ' ||
  "       p.pid || '|' ||
  "       s.module || ' |' ||
  "       s.sid || ' |' ||
  "       s.serial# || ' |' ||
  "       osuser || ' | ' ||
  "       p.spid || '| ' ||
  "       s.process || '|' ||
  "       NVL(s.lockwait,'<BLOCKER>') || ' |' ||
  "       l.id1 || '-' || l.id2 || ' |'
  " FROM gv$process p,gv$session s,
  "      (SELECT a.inst_id,a.sid,a.id1,a.id2
  "        FROM gv$lock a
  "        WHERE EXISTS (SELECT NULL
  "                       FROM gv$lock b
  "                       WHERE b.id1 = a.id1
  "                         AND b.id2 = a.id2
  "                         AND b.request > 0)) l
  " WHERE p.inst_id = s.inst_id
  "   AND s.inst_id = l.inst_id
  "   AND l.sid = s.sid
  "   AND p.addr = s.paddr
  " ORDER BY l.id1,l.id2,s.lockwait desc,s.inst_id,s.sid;
  "PROMPT ___Macro_separator(5)___
  "SELECT '|' ||
  "       s.inst_id || '-' || s.sid || '|' ||
  "       NVL(s.username,'Internal') || '|' ||
  "       DECODE(command,0,'None',
  "              DECODE(l.id2,0,u1.name || '.' || SUBSTR(t1.name,1,20),
  "                     'Rollback Segment')) || '|' ||
  "       DECODE(l.lmode,
  "              0,'None',          /* Mon Lock equivalent */
  "              1,'Null',          /* N */
  "              2,'Row-S (SS)',    /* L */
  "              3,'Row-X (SX)',    /* R */
  "              4,'Share',         /* S */
  "              5,'S/Row-X (SSX)', /* C */
  "              6,'Exclusive',     /* X */
  "              TO_CHAR(l.lmode)) || '|' ||
  "       DECODE(l.request,
  "              0,'None',          /* Mon Lock equivalent */
  "              1,'Null',          /* N */
  "              2,'Row-S (SS)',    /* L */
  "              3,'Row-X (SX)',    /* R */
  "              4,'Share',         /* S */
  "              5,'S/Row-X (SSX)', /* C */
  "              6,'Exclusive',     /* X */
  "              TO_CHAR(l.request)) || '|' ||
  "       l.id1||'-'||l.id2 || '|' ||
  "       l.type || '|'
  " FROM gv$lock l,gv$session s,sys.user$ u1,sys.obj$ t1
  " WHERE l.sid = s.sid and
  "       t1.obj# = DECODE(l.id2,0,l.id1,1) and
  "       u1.user# = t1.owner# and
  "       s.type != 'BACKGROUND'and
  "       (l.sid) IN (SELECT b.sid
  "                    FROM gv$lock b
  "                    WHERE b.request > 0)
  " ORDER BY l.id1,l.id2,l.request;
  }
  call separator(1)
  call writeSql($sql)
  call separator(0)
  if isCreated(true)
  {var $rpt = renderFile()
   output EF,log
   call dsp_event('(locking contention) Done.')
   call log_event('Spooling to: Locking Contention=',basename($rpt))
  }
  close
  call delete_lock($PID,'ddcps',getPid())
 }
}

# Report session wait events
macro report_session_events
{import $PID,$TTL,@HDR,@TTL

 job
 {call create_lock($PID,'ddcps',getPid())
  output EN,dw
  var $TTL = '---++ Session Wait Events Report'
  var @TTL = ('',\
               '---+++ Database Instance',\
               '---+++ SMON Waits',\
               '---+++ All Waits')
  var @HDR = ('',\
              '|*DBname*|*Instance*|*Date/Time*|',\
              '|*Program*|*Sid*|*Event*|*Total_Waits*|*Total_Timeouts*|\
                *Average_Wait*|',\
               '|*Program*|*Sid*|*Event*|*Total_Waits*|*Total_Timeouts*|\
                *Average_Wait*|')
  var $sql = check_wait('session wait events')
  append $sql
  {SELECT '|' ||
  "       name || '|' ||
  "       instance_name || '|' ||
  "       TO_CHAR(SYSDATE,'DD-Mon-YYYY HH24:MI:SS') || '|'
  " FROM v$instance,v$database;
  "PROMPT ___Macro_separator(2)___
  "SELECT '|' ||
  "       p.program || '|' ||
  "       se.sid || '|' ||
  "       se.event || '| ' ||
  "       se.total_waits || '| ' ||
  "       se.total_timeouts || '| ' ||
  "       se.average_wait || '| '
  " FROM v$session_event se,v$process p,v$session s
  " WHERE s.paddr = p.addr and
  "       s.sid = se.sid and
  "       se.average_wait > 0 and
  "       p.program like '%(SMON)'
  " ORDER BY se.total_waits;
  "PROMPT ___Macro_separator(3)___
  "SELECT '|' ||
  "       p.program || '|' ||
  "       se.sid || '|' ||
  "       se.event || '| ' ||
  "       se.total_waits || '| ' ||
  "       se.total_timeouts || '| ' ||
  "       se.average_wait || '|'
  " FROM v$session_event se,v$process p,v$session s
  " WHERE s.paddr = p.addr and
  "       s.sid = se.sid and
  "       se.average_wait > 0
  " ORDER BY se.total_waits;
  }
  call separator(1)
  call writeSql($sql)
  call separator(0)
  if isCreated(true)
  {var $rpt = renderFile()
   output EF,log
   call dsp_event('(session wait events) Done.')
   call log_event('Spooling to: Sessions Wait Events=',basename($rpt))
  }
  close
  call delete_lock($PID,'ddcps',getPid())
 }
}

# Deal with the dumps/traces associated with the background processes
macro service_background
{var ($nam,$pid) = @arg
 import $DIR,$PID,$PRE,$STK_CMD,$TOC,$TOP,$TRC_CMD,$TRC_PGM,$WAIT
 import $DDC_SLP,%DDC_PRC

 call dsp_event('"',$nam,'" process id: ',$pid)

 # Request a 10046 trace
 if exists($DDC_PRC{'T'})
 {call dsp_event('Requesting a 10046, level 12 trace for ',$nam,' (PID: ',\
                 $pid,')')
  call collect_10046($pid)
 }

 # Request an error stack
 if exists($DDC_PRC{'E'})
 {call dsp_event('Requesting an error stack for ',$nam,' (PID: ',$pid,')')
  call collect_error_stack($pid)
 }

 # Request a process state dump
 if exists($DDC_PRC{'P'})
 {call dsp_event('Requesting a process state dump for ',$nam,' (PID: ',$pid,')')
  call collect_process_state($pid)
 }

 # Launch an operating system trace
 if exists($DDC_PRC{'O'})
 {var $fil = catFile($DIR,concat($PRE,'po_',$nam,'.trc'))
  var $cmd = concat($TRC_CMD,' -o ',$fil,' -p ',$pid)
  if $WAIT
  {call log_event('O/S trace written to: ',basename($fil))
   job
   {call kip(get_wait($nam,' trace (PID: ',$pid,') ...'))
    output EF,log
    call dsp_event('Command: ',$cmd)
    output P,$cmd
    call create_lock($PID,'ddcpo',getOutputPid())
   }
  }
  else
  {call log_event('Tracing with ',$TRC_PGM)
   call log_event('O/S trace written to: ',basename($fil))
   call dsp_event('Command: ',$cmd)
   job
   {output P,$cmd
    call create_lock($PID,'ddcpo',getOutputPid())
   }
  }
 }

 # Collect a stack trace
 if exists($DDC_PRC{'S'})
 {var $rpt = concat($PRE,'ps_',$nam,'.txt')
  var $cmd = concat($STK_CMD,' ',$pid)
  if $WAIT
  {job
   {call create_lock($PID,'ddcps',getPid())
    call kip(get_wait($nam,' stack trace'))
    output EF,log
    call dsp_event($nam,' stack trace (PID: ',$pid,\
                   ') - please wait (approx 6 minutes) ...')
    suspend log
    output EN,$rpt
    write '---+!! Stack Trace for PID ',$pid
    write $TOC
    var $txt = ' (sleep 12)'
    for $cnt (1,11)
    {write '---+ Stack Trace No ',$cnt,$txt
     call writeCommand($cmd)
     write $TOP
     sleep 12
    }
    for $cnt (12,24)
    {write '---+ Stack Trace No ',$cnt,$txt
     call writeCommand($cmd)
     write $TOP
     var $txt = ' (no sleep)'
    }
    var $rpt = basename(renderFile())
    resume log
    call dsp_event($nam,' stack trace (PID: ',$pid,') completed')
    call log_event('Stack trace written to: ',$rpt)
    call delete_lock($PID,'ddcps',getPid())
   }
  }
  else
  {call dsp_event('Writing ',$nam,' process stack (approx 6 minutes) ...')
   job
   {call create_lock($PID,'ddcps',getPid())
    sleep 1
    output EF,log
    call dsp_event($nam,' stack trace (PID: ',$pid,') - please wait ...')
    suspend log
    output EN,$rpt
    write '---+!! Stack Trace for PID ',$pid
    write $TOC
    var $txt = ' (sleep 12)'
    for $cnt (1,11)
    {write '---+ Stack Trace No ',$cnt,$txt
     call writeCommand($cmd)
     write $TOP
     sleep 12
    }
    for $cnt (12,24)
    {write '---+ Stack Trace No ',$cnt,$txt
     call writeCommand($cmd)
     write $TOP
     var $txt = ' (no sleep)'
    }
    var $rpt = basename(renderFile())
    resume log
    call dsp_event($nam,' stack trace (PID: ',$pid,') completed')
    call log_event('Stack trace written to: ',$rpt)
    call delete_lock($PID,'ddcps',getPid())
   }
  }
 }
}

# Wait for background task completion
macro wait_exit
{import $PID,$RPT_DIRECTORY,$RPT_GROUP,$TRC_PGM,%DDC_PRC

 if get_wait('all sub processes')
  call kip(last)
 call dsp_event('Waiting for background processing to complete ...')

 # Wait for trace completion
 sleep 5
 while grep_lock($PID,'ddcps')
  sleep 5

 # Stop operating system traces
 if exists($DDC_PRC{'O'})
 {var $pat = get_lock($PID,'ddcpo')
  if grep_lock($PID,'ddcpo')
  {var @lck = last
   call dsp_event('Terminating ',$TRC_PGM,' process(es) in 30 seconds ...')
   sleep 30
   loop $lck (@lck)
   {var ($pid) = match($lck,$pat,true)
    call dsp_event('Issuing: kill -9 ',$pid)
    call kill(9,$pid)
   }
   call delete_group($PID,'ddcpo')
  }
 }

 # Disable 10046 traces
 var @pid = ()
 loop $lck (grep_lock($PID,'ddcpt'))
  var @pid = (@pid,value(grepFile(catDir($RPT_DIRECTORY,$lck),'pid=','f')))
 if @pid
 {call dsp_event("The 10046 level 12 traces are still active for:\012 ",\
                 join(',',@pid))
  if missing($DDC_PRC{'O'})
  {call dsp_event('The 10046 traces will be switch off in approx. 30 seconds')
   sleep 30
  }
  call dsp_event('The 10046 traces will now be switch off.')
  set $sql
  {oradebug setospid :1
  "oradebug event 10046 trace name context off
  }
  loop $pid (@pid)
  {call dsp_event('Disabling 10046 trace (PID: ',$pid,') ...')
   call loadSql(bindSql($sql,$pid))
  }
  call delete_group($PID,'ddcpt')
 }
}

# ---  Main Section -----------------------------------------------------------

# Open the log report
output EN,log
write '---+!! ORADDC Collection Log'
write '---### ORADDC collection started at ',localtime('%d-%b-%Y %H:%M:%S')
output EF,log
write $TOC
call begin_log()
var $LOG = getFile('/')

# Set the current login and load passwords
debug 'Setting the current login ...'
if !defined(getSetting('ORACLE_SID'))
 call setSqlSid($ORACLE_SID)
var $log = setSqlLogin()
loop $key (grepSetting('^SQL_PASSWORD_'))
{if match($key,'^SQL_PASSWORD__([\+\w]+)__(.*)$')
 {var ($sid,$usr) = (last)
  var $sid = replace($sid,'plus','+',true)
 }
 else
  var ($usr,$sid) = (substr($key,13))
 call setSqlLogin($usr,unpack('u',getSetting($key)),$sid)
}
loop $key (grepSetting('^SQL_PASS_\d+$'))
{var ($usr,$sid) = split('\@',getSetting(replace($key,'_PASS_','_USER_')),2)
 call setSqlLogin($usr,unpack('u',getSetting($key)),$sid)
}
if defined(getSetting('SQL_LOGIN'))
 call setSqlLogin($log)
else
 call setSqlLogin('','','',true)

# Test the database connection
debug 'Testing the database connection ...'
if !$DBC
{call dsp_event('Prelim mode set')
 var ($DBVER) = ('10')
 delete $DDC_DMP{'C'}
 delete $DDC_DMP{'W'}
}
elsif testSql()
{call dsp_event('ERROR: Cannot connect to the database')
 var ($DBVER,%DDC_DMP) = ('')
 delete $DDC_PRC{'E'}
 delete $DDC_PRC{'T'}
 delete $DDC_PRC{'P'}
}
else
 var $DBVER = get_db_version(false,'10')

# Disable the timeout
call setSqlTimeout(0)

# Give an overview
call end_log()
write '---+ Report Overview'
write '|*Machine and Version*|',uname('a'),'|'
if and($DBC,$DBVER)
{var %ver = ('90','9i','92','9iR2',\
             '10','10g assumed','101','10gR1','102','10gR2',\
             '11','11g','111','11gR1','112','11gR2')
 write '|*Database Version*|',nvl($ver{$DBVER},$DBVER),' |'
}
write '|*ORACLE_SID*|',$ORACLE_SID,'|'
write '|*ORACLE_HOME*|',$ORACLE_HOME,'|'
write '|*ORADDC Options*|',\
      cond(isFiltered(),replace($DDC_CMD,':','&#58;',true),$DDC_CMD),' |'
write $TOP
write '---+ Collection Details'
call begin_log()

# Find a trace program
if exists($DDC_PRC{'O'})
{debug 'Searching for a trace command ...'
 if findCommand('truss')
  var ($TRC_PGM,$TRC_CMD) = ('truss',concat(last,' -f -a -i -e'))
 elsif findCommand('strace')
 {var ($TRC_PGM,$TRC_CMD) = ('strace',concat(last,' -f'))
  if !isWindows()
   var $TRC_CMD = concat($TRC_CMD,' -F')
 }
 elsif findCommand('tusc')
  var ($TRC_PGM,$TRC_CMD) = ('tusc',concat(last,' -f -a -i -e'))
 else
 {var ($TRC_PGM,$TRC_CMD) = ()
  call dsp_event('WARNING: No trace command could be located.')
  call log_event('WARNING: ORADDC will skip operating system traces.')
  delete $DDC_PRC{'O'}
 }
 if $TRC_CMD
  call log('Trace command: ',$TRC_CMD)
}

# Find the pstack program
if exists($DDC_PRC{'S'})
{debug 'Searching for the pstack command ...'
 if findCommand('procstack')
  var ($STK_PGM,$STK_CMD) = ('procstack',concat(last,' -F'))
 elsif findCommand('pstack')
 {var ($STK_PGM,$STK_CMD) = ('pstack',last)
  if match(getOsName(),'solaris')
   var $STK_CMD = concat($STK_CMD,' -F')
 }
 elsif testFile('x','/usr/proc/bin/pstack')
  var ($STK_PGM,$STK_CMD) = ('pstack','/usr/proc/bin/pstack')
 elsif testFile('x','/usr/bin/pstack')
  var ($STK_PGM,$STK_CMD) = ('pstack','/usr/bin/pstack')
 else
 {var ($STK_PGM,$STK_CMD) = ()
  call dsp_event('WARNING: No pstack command could be located.')
  call log_event('WARNING: ORADDC will skip stack trace requests.')
  delete $DDC_PRC{'S'}
 }
 if $STK_CMD
  call log('Pstack command: ',$STK_CMD)
}

# Put a notice for the wait mode
if $WAIT
{debug
 debug 'NOTE: You have specified the wait option. Use the wake-up command'
 debug 'to start diagnostic collections for the waiting sessions.'
 debug
}

# Get background process identifiers
if @DDC_BGP
{loop $nam (@DDC_BGP)
 {if get_background($nam,$SID)
   call service_background($nam,last)
  else
   call dsp_event('WARNING: Unable to identify the "',$nam,'" process')
 }
}

# Request a heapdump
if exists($DDC_DMP{'H'})
{call dsp_event('Requesting a heapdump ...')
 call collect_heapdump()
 if $DBC
 {call dsp_event('Requesting a shared pool chunks report ...')
  call report_chunks()
 }
}

# Request a library cache dump
if exists($DDC_DMP{'L'})
{call dsp_event('Requesting a library cache dump ...')
 call collect_lib_cache()
}

# Request a locking contention report
if exists($DDC_DMP{'C'})
{call dsp_event('Requesting a locking contention report ...')
 call report_locking_contention()
}

# Request a row cache dump
if exists($DDC_DMP{'R'})
{call dsp_event('Requesting a row cache dump ...')
 call collect_row_cache()
}

# Request a session wait events report
if exists($DDC_DMP{'W'})
{call dsp_event('Requesting a session wait events report ...')
 call report_session_events()
}

# Request a hang analyze dump
if exists($DDC_DMP{'A'})
{call dsp_event('Requesting a hang analyze dump ...')
 call collect_hang_analyze()
}

# Request a system state sump
if exists($DDC_DMP{'S'})
{call dsp_event('Requesting a system state dump ...')
 call collect_system_state()
}

# Get the process identifiers to analyze
if and($WAIT,compare('ne',$DDC_PID,'-'))
{debug
 debug 'WARNING: The -W option has been specified. If this was specified due to'
 debug 'issues with making new connections then tracing analysis of specified'
 debug 'sessions may fail!'
 debug
}
if compare('eq',$DDC_PID,'B')
{# Get the PIDs of blocking sessions
 var @pid = get_blocking_pids()
 if @pid
  call dsp_event("Client PIDs [Blocking PIDs]:\012 ",join(',',@pid))
 else
 {call dsp_event('WARNING: No Oracle blocking sessions detected')
  call wait_exit()
 }
}
elsif compare('eq',$DDC_PID,'E')
{# Get the PIDs of sessions waiting on the wait#'s specified
 var @pid = get_event_pids(@DDC_PID)
 call dsp_event("Client PIDs [Waiting on event# ",join(',',@DDC_PID),\
                "]:\012 ",join(',',@pid))
}
elsif compare('eq',$DDC_PID,'O')
{# Get the PIDs of sessions connected as specified by Oracle PIDs
 var @pid = get_oracle_pids(@DDC_PID)
 if @pid
  call dsp_event("Client PIDs [-o ",join(',',@DDC_PID),"]:\012 ",\
                 join(',',@pid))
 else
 {call dsp_event('WARNING: No Oracle sessions found for Oracle PIDs specified')
  call wait_exit()
 }
}
elsif compare('eq',$DDC_PID,'P')
{# Get the PIDs of sessions connected as specified by UNIX PIDs (-U):
 var @pid = @DDC_PID
 call dsp_event("Client PIDs [For process ",join(',',@DDC_PID),"]:\012 ",\
                join(',',@pid))
}
elsif compare('eq',$DDC_PID,'S')
{# Get the PIDs for the sessions specified
 var @pid = get_session_pids(@DDC_PID)
 if @pid
  call dsp_event("Client PIDs [For SID(s) ",join(',',@DDC_PID),"]:\012 ",\
                 join(',',@pid))
 else
 {call dsp_event('WARNING: No Oracle sessions detected for SIDs ',\
                 join(',',@DDC_PID))
  call wait_exit()
 }
}
elsif compare('eq',$DDC_PID,'U')
{# Get the PIDs of sessions connected as specified by $DDC_USR
 var @pid = get_user_pids($DDC_USR)
 if @pid
  call dsp_event("Client PIDs [Username: ",$DDC_USR,"]:\012 ",join(',',@pid))
 else
 {call dsp_event('WARNING: No oracle sessions detected for username ',$DDC_USR)
  call wait_exit()
 }
}
else
 var @pid = ()

# Analyze specified process identifiers
loop $pid (@pid)
{# Request a 10046 trace
 if exists($DDC_PRC{'T'})
 {if $WAIT
  {job
   {call kip(get_wait('10046 trace (PID: ',$pid,')'))
    output EF,log
    call dsp_event('Tracing (10046) a shadow process (PID: ',$pid,') ...')
    call collect_10046($pid)
   }
  }
  else
  {call dsp_event('Tracing (10046) a shadow process (PID: ',$pid,') ...')
   call collect_10046($pid)
  }
  sleep 5
 }

 # Request a process state dump
 if exists($DDC_PRC{'P'})
 {call dsp_event('Requesting a process state dump (PID: ',$pid,') ...')
  call collect_process_state($pid)
 }

 # Collect error stack
 if exists($DDC_PRC{'E'})
 {call dsp_event('Requesting an error stack (PID: ',$pid,') ...')
  call collect_error_stack($pid)
 }

 # Launch an operating system trace
 if exists($DDC_PRC{'O'})
 {var $fil = catFile($DIR,concat($PRE,'po_',$pid,'.trc'))
  var $cmd = concat($TRC_CMD,' -o ',$fil,' -p ',$pid)
  if $WAIT
  {job
   {call kip(get_wait('trace (PID: ',$pid,')'))
    output EF,log
    call log_event('O/S trace written to: ',basename($fil))
    call dsp_event('Command: ',$cmd)
    output P,$cmd
    call create_lock($PID,'ddcpo',getOutputPid())
   }
  }
  else
  {call log_event('Tracing with ',$TRC_PGM,' ...')
   call log_event('O/S trace written to: ',basename($fil))
   call dsp_event('Command: ',$cmd)
   job
   {output P,$cmd
    call create_lock($PID,'ddcpo',getOutputPid())
   }
  }
 }

 # Collect stack traces
 if exists($DDC_PRC{'S'})
 {var $rpt = concat($PRE,'ps_',$pid,'.txt')
  var $cmd = concat($STK_CMD,' ',$pid)
  if $WAIT
  {job
   {call create_lock($PID,'ddcps',getPid())
    call kip(get_wait('process stack (PID: ',$pid,')'))
    output EF,log
    call dsp_event('Waking up to take stack trace (PID: ', $pid,') ...')
    call dsp_event('Stack trace (PID: ',$pid,') - please wait ...')
    suspend log
    output EN,$rpt
    write '---+!! Stack Trace for PID ',$pid
    write $TOC
    for $cnt (1,24)
    {write '---+ Stack Trace No ',$cnt
     call writeCommand($cmd)
    }
    var $rpt = basename(renderFile())
    resume log
    call dsp_event('Stack trace for ',$pid,' completed')
    call log_event('Stack trace written to: ',$rpt)
    call delete_lock($PID,'ddcps',getPid())
   }
  }
  else
  {call dsp_event('Writing process stack (PID: ',$pid,') ...')
   job
   {call create_lock($PID,'ddcps',getPid())
    sleep 1
    output EF,log
    call dsp_event('Stack trace (PID: ',$pid,') - please wait ...')
    suspend log
    output EN,$rpt
    write '---+!! Stack Trace for PID ',$pid
    write $TOC
    for $cnt (1,24)
    {write '---+ Stack Trace No ',$cnt
     call writeCommand($cmd)
     write $TOP
    }
    var $rpt = basename(renderFile())
    resume log
    call dsp_event('Stack trace for ',$pid,' completed')
    call log_event('Stack trace written to: ',$rpt)
    call delete_lock($PID,'ddcps',getPid())
   }
  }
 }
}

# Wait for trace completion
call wait_exit()

# Finalize the log
if exists($DDC_DMP{'A'})
 call check_hanganalyze($LOG)
call collate_traces($LOG)
if $WAIT
 call purge('O',concat('TMP_ddc(st|up)_',quote($SID),'\.tmp$'),-1,0)
debug 'ORADDC collection ended'
echo 'ORADDC log: ',renderFile()

=head1 SEE ALSO

See also L<DBinfo.def|modules::DBinfo>, L<TLoraddc.def|modules::TLoraddc>,
L<DDCstat.def|modules::DDCstat>.

=over 10

=begin credits

=item RDA 4.11:  Clive Bostock.

=back

=end credits

=head1 COPYRIGHT NOTICE

Copyright (c) 2002-2008, Oracle. All rights reserved.

=head1 TRADEMARK NOTICE

Oracle, JD Edwards, PeopleSoft, and Siebel are registered trademarks of Oracle
Corporation and/or its affiliates. Other names may be trademarks of their
respective owners.

=cut