#!/usr/local/bin/perl
# 
# $Header: direct_access.pl 24-may-2007.12:15:26 jsoule Exp $
#
# direct_access.pl
# 
# Copyright (c) 2006, 2007, Oracle. All rights reserved.  
#
#    NAME
#      direct_access.pl - Provide oradebug direct_access support.
#
#    DESCRIPTION
#      This file encapsulates the support for oradebug direct_access.
#
#    NOTES
#      Not every potential replacement character is listed here.  Only will the
#      special characters:
#       '$', '#'
#      be properly translated in query columns.
#
#    MODIFIED   (MM/DD/YY)
#    jsoule      05/24/07 - enable prelim mode
#    jsoule      04/19/07 - spool NT output to file
#    jsoule      11/30/06 - avoid open("-|") on NT
#    jsoule      11/16/06 - use new direct_access syntax/output format
#    jsoule      10/04/06 - better tracing
#    jsoule      09/15/06 - Creation
# 

use vars qw($NT);
use strict;
use XML::Parser;

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

package DirectAccess;

################################
## context attributes
################################

my $oracle_home;
my $oracle_sid;
my $connect_string;

#
# Subroutine: setContextAttributes
#  $_[0] => oracle_home
#  $_[1] => oracle_sid (may be '')
#  $_[2] => connect string (should be as SYSDBA)
#
sub setContextAttributes
{
  $oracle_home    = shift;
  $oracle_sid     = shift;
  $connect_string = shift;

  ::EMAGENT_PERL_DEBUG("oracle_home: $oracle_home");
  ::EMAGENT_PERL_DEBUG("oracle_sid: $oracle_sid");
}

################################
## parsing state
################################

my $fixed_table;
my @fixed_table_rows;
my @fixed_table_colnames;
my $fixed_table_colname;
my $fixed_table_colval;

################################
## NT XML output file
################################

my $outfile_name;

################################
## public variable for error code
################################

our $ERROR_CODE;  # error codes are as follows:
                  #     0 - no error
                  #   750 - unable to spawn SQL*Plus
                  #   942 - unsupported fixed table
                  #  1017 - invalid SYSDBA username/password

#
# Subroutine: parseXML
#  $_[0] => fixed table name
#  $_[1] => filehandle for reading
#  $_[2] => list of fixed table column names to track
#
# Returns: An array of hashes, one hash per row of the fixed table.
#          Each hash is an associative array of [column_name]->[column value]
#
sub parseXML
{
  $fixed_table          = shift;
  my $output_stream     = shift;
  @fixed_table_colnames = @_;

  my $parser = new XML::Parser(ErrorContext => 2);

  $parser->setHandlers(Start => \&start_handler,
                       End   => \&end_handler,
                       Char  => \&char_handler);

  $parser->parse($output_stream);

  return @fixed_table_rows;
}

#
# Subroutine: parseXMLFailure
#
# The last thing this process does after parse failure.
#
sub parseXMLFailure
{
  if (defined($outfile_name) && open(DIRECTACCESS_XML, "$outfile_name"))
  {
    while (<DIRECTACCESS_XML>) { ::EMD_PERL_ERROR($_); }
    close(DIRECTACCESS_XML);
  }
}

#
# Subroutine: getFixedTable
#  $_[0] => fixed table name
#  $_[1] => list of columns to supply
#
# Returns: see parseXML
#
# Note: Set the context attributes first.
#
sub getFixedTable
{
  $fixed_table          = shift;
  @fixed_table_colnames = @_;

  $ERROR_CODE = 0;

  ################################
  ## establish the "start parsing" prompt
  ################################
  my $prompt = "direct_access XML";

  ################################
  # create a temporary file with the script
  ################################
  my $direct_access_stmt =
   "select ".join(', ', @fixed_table_colnames)." from $fixed_table";
  ::EMAGENT_PERL_DEBUG("direct_access statement: $direct_access_stmt");
  my ($sqlfile_handle, $sqlfile_name) = ::create_temp_file(".sql");
  print $sqlfile_handle <<"EOS";
oradebug setmypid;
oradebug direct_access set content_type = "text/xml";
prompt $prompt
prompt <DIRECT_ACCESS>
oradebug direct_access $direct_access_stmt;
prompt </DIRECT_ACCESS>
exit;
EOS
  close $sqlfile_handle;

  my $prelim_mode = '-prelim';

  ################################
  ## spawn sqlplus, piping back the output
  ################################
  if (!$::NT)
  {
    if (!open(SQLPLUS, "-|"))
    {
      # Locally instantiate the relevant pieces of the ENV array so that
      #  SQL*Plus is spawned in the correct context.
      # Override the ORACLE_HOME, ORACLE_SID, LD_LIBRARY_PATH env variables.
      $ENV{'ORACLE_HOME'}     = $oracle_home;
      $ENV{'ORACLE_SID'}      = $oracle_sid;
      $ENV{'LD_LIBRARY_PATH'} = $oracle_home."/lib:".$ENV{'LD_LIBRARY_PATH'};

      my $exit_status =
       system("$oracle_home/bin/sqlplus $prelim_mode -S \"$connect_string\" < $sqlfile_name");

      if ($exit_status)
      {
        ################################
        ## when this fails, it may be because SQL*Plus could not be found
        ## assume it is because $oracle_home is improperly set and append
        ##   an artificial error to the output
        ## note: any true error will override this
        ################################
        ::EMAGENT_PERL_ERROR("$oracle_home/bin/sqlplus command returned status $exit_status");
        print "SP2-00750\n";
      }
      exit;
    }
  }
  else
  {
    # Locally instantiate the relevant pieces of the ENV array so that
    #  SQL*Plus is spawned in the correct context.
    # Override the ORACLE_HOME, ORACLE_SID, LD_LIBRARY_PATH env variables.
    $ENV{'ORACLE_HOME'}     = $oracle_home;
    $ENV{'ORACLE_SID'}      = $oracle_sid;
    $ENV{'LD_LIBRARY_PATH'} = $oracle_home."\\lib:".$ENV{'LD_LIBRARY_PATH'};

    # open("-|") is not permitted on NT, but it provides better diagnostics
    # so we keep it for non-NT platforms.
    $outfile_name = ::create_temp_file(".xml");
    my $exit_status =
      system("$oracle_home\\bin\\sqlplus $prelim_mode -S \"$connect_string\" < $sqlfile_name > $outfile_name");
    if ($exit_status)
    {
      ################################
      ## when this fails, it may be because SQL*Plus could not be found
      ## assume it is because $oracle_home is improperly set and append
      ##   an artificial error to the output
      ################################
      ::EMAGENT_PERL_ERROR("$oracle_home\\bin\\sqlplus command returned status $exit_status");
      print "SP2-00750\n";
      exit;
    }
    else
    {
      open(SQLPLUS, "$outfile_name");
    }
  }

  ################################
  ## peel off everything before the prompt...
  ################################
  while (<SQLPLUS>)
  {
    if (/^$prompt/)
    {
      last;
    }
    elsif (/[A-Z][0-9a-zA-Z]{2}-([0-9]+)/)
    {
      if ($1 != 1012)
      {
        ################################
        # ...but abort on the first error (except the expected 01012)
        ################################
        $ERROR_CODE = $1;
        last;
      }
    }
  }

  if (!$ERROR_CODE)
  {
    ################################
    ## parse the rest as an XML document
    ################################
    $SIG{__DIE__} = \&parseXMLFailure;
    parseXML($fixed_table, *SQLPLUS, @fixed_table_colnames);
    $SIG{__DIE__} = 'DEFAULT';
  }

  close(SQLPLUS);

  ################################
  ## return the parse results
  ################################
  ::EMAGENT_PERL_INFO("found ".(@fixed_table_rows+0)." rows in $fixed_table");
  return @fixed_table_rows;
}

################################
# replacement characters
################################

my @replacements = ('x0023', 'x0024');
my @originals    = ('#',     '$');

#
# Subroutine: start_handler
#  $_[0] => expat (unused)
#  $_[1] => XML element
#
# This is a callback for parsing an XML start-element tag.
#
sub start_handler
{
  my $self = shift;
  my $el   = shift;

  my $replace;
  for ($replace = 0; $replace < @replacements; $replace++)
  {
    $el =~ s/_$replacements[$replace]_/$originals[$replace]/g;
  }

  if ($el eq "RESULT")
  {
    # initialize the array of rows
    @fixed_table_rows = qw();
  }
  elsif ($el eq "ROW")
  {
    # add a new hash for the current row
    push(@fixed_table_rows, {});
  }
  elsif ($el ne "DIRECT_ACCESS")
  {
    # set the column being parsed
    $fixed_table_colname = $el;
  }
}

#
# Subroutine: end_handler
#  $_[0] => expat (unused)
#  $_[1] => XML element
#
# This is a callback for parsing an XML end-element tag.
#
sub end_handler
{
  my $self = shift;
  my $el   = shift;

  my $replace;
  for ($replace = 0; $replace < @replacements; $replace++)
  {
    $el =~ s/_$replacements[$replace]_/$originals[$replace]/g;
  }

  if ($el eq "RESULT")
  {
    # nothing to finalize
  }
  elsif ($el eq "ROW")
  {
    # nothing to finalize
  }
  elsif ($el ne "DIRECT_ACCESS")
  {
    if ($el eq $fixed_table_colname)
    {
      if (grep {/$fixed_table_colname/} @fixed_table_colnames)
      {
        # add the column name/value to this row
        $fixed_table_rows[$#fixed_table_rows]->{$fixed_table_colname} =
          $fixed_table_colval;
      }
    }
    else
    {
      # this should never be
      ::EMAGENT_PERL_ERROR("column $fixed_table_colname is inconsistent");
    }

    # reset column name/value
    $fixed_table_colname = '';
    $fixed_table_colval  = '';
  }
}

#
# Subroutine: char_handler
#  $_[0] => expat (unused)
#  $_[1] => character string
#
# This is a callback for parsing character data in an XML element.
#
sub char_handler
{
  my $self = shift;
  my $ch   = shift;

  if ($fixed_table_colname)
  {
    # append these characters
    $fixed_table_colval .= $ch;
  }
  elsif (!@fixed_table_rows)
  {
    if ($ch eq "Non existent or unsupported table")
    {
      ::EMAGENT_PERL_WARN("table or view $fixed_table does not exist");

      $ERROR_CODE = 942;
    }
    elsif ($ch =~ /ORA-(\d+)/)
    {
      ::EMAGENT_PERL_WARN("ORA error encountered: $ch");

      $ERROR_CODE = $1;
    }
  }
  else
  {
    # ::EMAGENT_PERL_WARN("processing character $ch outside of table cell");
  }
}

1;