#!/usr/local/bin/perl
# 
# $Header: waitChains.pl 25-jan-2008.13:08:25 jsoule Exp $
#
# waitChains.pl
# 
# Copyright (c) 2006, 2008, Oracle. All rights reserved.  
#
#    NAME
#      waitChains.pl - Get the wait chains data from the server.
#
#    DESCRIPTION
#      Use the direct_access API to retrieve wait chain data from the server.
#
#    NOTES
#      The following conventions must be followed.
#      1) SYSDBA user/password are to be passed on stdin.
#         If the password is missing, that signals the script to attempt
#         OS authentication using BEQ protocol.
#      2) The TNS descriptor is passed as an environment variable.
#         This is unused if password is missing (use "/ as sysdba").
#      3) Command-line parameters are $ORACLE_HOME $ORACLE_SID [global]
#         If global is present, this gets the chains for all instances.
#
#    MODIFIED   (MM/DD/YY)
#    jsoule      01/25/08 - add global area option
#    jsoule      10/04/06 - better tracing
#    jsoule      09/15/06 - Creation
# 

use strict;

require "emd_common.pl";

require "$ENV{EMDROOT}/sysman/admin/scripts/db/direct_access.pl";

################################
## process inputs
################################

# stdin
my %stdinArgs = get_stdinvars();
my $username  = $stdinArgs{"EM_SYSDBA_USERNAME"};
my $password  = $stdinArgs{"EM_SYSDBA_PASSWORD"};

# environment variables
my $connect_string = $ENV{"EM_TARGET_ADDRESS"};
if ($password)
{
  EMAGENT_PERL_INFO("using SYSDBA credentials");

  $connect_string = "$username/$password as sysdba";
  #$connect_string = "$username/$password\@$connect_string as sysdba";
}
else
{
  EMAGENT_PERL_INFO("trying BEQ protocol and OS authentication");

  $connect_string = "/ as sysdba";
}

# command line
my $oracle_home = $ARGV[0];
my $oracle_sid  = $ARGV[1];
my $analysisArea = "local";
if ($#ARGV >= 2)
{
  $analysisArea = $ARGV[2];
}
EMAGENT_PERL_DEBUG("analysisArea=$analysisArea");

DirectAccess::setContextAttributes($oracle_home, $oracle_sid, $connect_string);

my @rows;

################################
## get the total number of sessions
################################

my $total_sessions;

if ($oracle_sid)
{
  #
  # At this time (pre 11.1 beta 4), there has been no arrangement to guarantee
  #  safety of the x$kslwt fixed table direct_access lookup.  At the same time,
  #  there is no strong requirement to display the total number of sessions.
  # This code remains as a reference and in case the requirement is renewed.
  #

  #@rows = DirectAccess::getFixedTable('X$KSLWT', ('KSLWTSID'));

  #if ($DirectAccess::ERROR_CODE)
  #{
  #  EMAGENT_PERL_ERROR("received error code $DirectAccess::ERROR_CODE");

    # allow this failure; don't die
  #}
  #else
  #{
  #  $total_sessions = @rows;
  #}

  #
  # For now, we return no total sessions value.
  #
  $total_sessions = '';
}

################################
## get wait chain data
################################

@rows = DirectAccess::getFixedTable('X$KSDHNG_CHAINS', ("INSTANCE",
                                                        "SID",
                                                        "SESS_SERIAL#",
                                                        "OSID",
                                                        "BLOCKER_IS_VALID",
                                                        "BLOCKER_INSTANCE",
                                                        "BLOCKER_SID",
                                                        "BLOCKER_SESS_SERIAL#",
                                                        "INST_ID",
                                                        "CHAIN_ID",
                                                        "CHAIN_SIGNATURE",
                                                        "CHAIN_IS_CYCLE"));

if ($DirectAccess::ERROR_CODE)
{
  EMAGENT_PERL_ERROR("received error code $DirectAccess::ERROR_CODE");
  die "em_error=$DirectAccess::ERROR_CODE\n";
}

################################
## filter rows
################################

@rows = filter_chains($analysisArea ne "global", @rows);

################################
## print those that remain
################################

EMAGENT_PERL_INFO("returning ".(@rows+0)." waiting sessions");
write_sessions($total_sessions, $oracle_sid, @rows);

#
# Subroutine: filter_chains
#  $_[0] => true iff single-instance
#  $_[*] => rows in wait chains
#
# Returns: the set of filtered rows
#
sub filter_chains
{
  my $instance_only = shift;
  my @rows          = @_;

  # instance filtering
  if ($instance_only)
  {
    EMAGENT_PERL_DEBUG("keeping only this instance");
    @rows = grep { %{$_}->{"INST_ID"} == %{$_}->{"INSTANCE"} } @rows;
  }
  else
  {
    EMAGENT_PERL_DEBUG("keeping all instances");
  }

  EMAGENT_PERL_INFO("keeping ".(@rows+0)." sessions from instance(s)");

  ################################
  # trivial chain filtering
  ################################

  #
  # blocked sessions have BLOCKER_IS_VALID == 1; keep all of those
  #
  my @blocked = grep { %{$_}->{"BLOCKER_IS_VALID"} } @rows;
  EMAGENT_PERL_INFO("found ".(@blocked+0)." blocked sessions");

  #
  # find unblocked sessions which are blockers
  #
  my @unblocked_blockers = ();
  my @blocker_ids = ();
  for my $hash (@blocked)
  {
    my $instance = %{$hash}->{"BLOCKER_INSTANCE"};
    my $sid = %{$hash}->{"BLOCKER_SID"};
    my $serialno = %{$hash}->{"BLOCKER_SESS_SERIAL#"};
    my $blocker_id = $sid."#".$serialno."@".$instance;
    foreach (@rows)
    {
      if (!%{$_}->{"BLOCKER_IS_VALID"} &&
          %{$_}->{"INSTANCE"} eq $instance &&
          %{$_}->{"SID"} eq $sid &&
          %{$_}->{"SESS_SERIAL#"} eq $serialno)
      {
        if (!grep { /$blocker_id/ } @blocker_ids)
        {
          # only add each once
          EMAGENT_PERL_DEBUG("adding BLOCKER ".$blocker_id);
          push @blocker_ids, $blocker_id;
          push @unblocked_blockers, $_;
        }
        else
        {
          EMAGENT_PERL_DEBUG("skipping BLOCKER ".$blocker_id.
                             ": already added");
        }
      }
    }
  }

  #
  # return blocked + unblocked_blockers
  #
  my @waiters = ();
  push @waiters, @blocked;
  push @waiters, @unblocked_blockers;
  return @waiters;
}

#
# Subroutine: write_sessions
#  $_[0] => number of sessions
#  $_[1] => true iff single-instance
#  $_[*] => rows in wait chains
#
sub write_sessions
{
  my $session_count = shift;
  my $instance_only = shift;
  my @rows          = @_;

  # choose columns
  my @output_colnames = ("SID",
                         "SESS_SERIAL#",
                         "INSTANCE",
                         "OSID",
                         "BLOCKER_SID",
                         "BLOCKER_SESS_SERIAL#",
                         "BLOCKER_INSTANCE",
                         "CHAIN_ID",
                         "CHAIN_SIGNATURE",
                         "CHAIN_IS_CYCLE");

  print "em_result=$session_count|";
  my $row;
  for ($row = 0; $row <= $#rows; $row++)
  {
    print encode_delimiters($rows[$row]{$output_colnames[0]});
    my $col;
    for ($col = 1; $col <= $#output_colnames; $col++)
    {
      print ",".encode_delimiters($rows[$row]{$output_colnames[$col]});
    }
    if ($row != $#rows)
    {
      print "|";
    }
  }
  print "\n";
}

sub encode_delimiters
{
  my $value = shift;
  $value =~ s/\|/_x007C_/g;
  $value =~ s/\,/_x002C_/g;
  return $value;
}

exit 0;