#!/usr/local/bin/perl
# 
# $Header: emdb/sysman/admin/scripts/rac/cls_services.pl /st_emdbsa_11.2.0.4.0dbpsu-spu/1 2016/11/13 19:32:02 mkiran Exp $
#
# cls_services.pl
# 
# Copyright (c) 2008, 2016, Oracle and/or its affiliates. All rights reserved.
#
#    NAME
#      cls_services.pl - <one-line expansion of the name>
#
#    DESCRIPTION
#      <short description of component this file declares/defines>
#	Use srvctl commands to retrieve information about Cluster Managed Services for rac_databases 
#	for a given cluster, use srvctl config to get list of rac database names
#	for each rac database use srvctl status service -d dbname -S 1 -f  to get list of services
# 	for each service following information is collected
#	service_name, enabled/disabled, tafpolicy, preferred instance list, available instance list,
#	running instance list
#
#    NOTES
#      <other useful comments, qualifications, etc.>
#
#    MODIFIED   (MM/DD/YY)
#    mkiran      11/13/16 - Backport mkiran_bug-24842886 from st_emdbsa_11.2
#                           24842886: Java dumps core if srvctl called w/o
#                                     appropriately setting ORACLE_HOME
#    mappusam    01/27/13 - bug-16052631 fix
#    pardutta    11/04/09 - RAC One Node: collect and update Database Type.
#    pardutta    10/07/11 - Bug 13069157 - BLR BACKPORT OF BUG 12757575
#    pardutta    07/25/11 - Version check for post 11.2 databases.
#    pardutta    06/09/09 - Total active server count.
#    pardutta    05/21/09 - Exclude internal service from services list.
#    pardutta    03/31/09 - Changes to update database service record in
#                           mgmt_rac_services.
#    rsamaved    12/31/08 - run srvctl service commands from db home
#    gallison    12/01/08 - Fix for in-view services
#    rsamaved    08/13/08 - 
#    sadattaw    03/05/08 - adding support for monitoring 11.2 cluster targets
#    sadattaw    03/01/07 - XbranchMerge rsamaved_demosa from st_emdbsa_11.1
#    rsamaved    01/31/07 - use em_error for err cases
#    kramarat    01/25/07 - XbranchMerge kramarat_cluster_db_services_fix2 from
#                           main
#    sadattaw    09/28/06 - collect cluster managed services information
#    sadattaw    09/28/06 - Creation
# 

use strict;
use DBI qw(:sql_types);
use Cwd;

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

BEGIN
{
 # temporarly setting environment only in dev view env
 # this code is not active in production
 if ( $ENV{ADE_VIEW_ROOT} and not $ENV{HAS_USE_SHIPHOME} )
 {
  my $advrt =  $ENV{ADE_VIEW_ROOT};
  $advrt  =~ s/_ag$//;
  $advrt  = $advrt."t";

  $ENV{ORA_CRS_HOME}="$advrt/oracle";
  $ENV{CSS_CLUSTERNAME}='newdb_cluster';

  $ENV{EM_CRS_HOME}="$ENV{ORA_CRS_HOME}";
  $ENV{CRS_HOME}="$ENV{ORA_CRS_HOME}";
  $ENV{CV_HOME}="$ENV{CRS_HOME}";
  $ENV{OCR_ROOT}="$ENV{CRS_HOME}/has_work/ocr.dat";
  $ENV{OCR_LOC}="$ENV{CRS_HOME}/has_work/ocr.loc";
  $ENV{CV_JDKHOME}="$ENV{CRS_HOME}/jdk15";
  $ENV{OCR_DEVELOPER_ENV}='TRUE';
  $ENV{ORA_ENVIRON_OPTS}='true';
  $ENV{ORA_CSS_VARS}='true';

  my $libs = "$ENV{CRS_HOME}/lib:$ENV{CRS_HOME}/has/lib:$ENV{CRS_HOME}/opsm/lib";
  $ENV{LD_LIBRARY_PATH}="$libs:$ENV{LD_LIBRARY_PATH}" if $ENV{LD_LIBRARY_PATH};
  $ENV{LD_LIBRARY_PATH}="$libs" unless $ENV{LD_LIBRARY_PATH};
  $ENV{PATH}="$ENV{CRS_HOME}/bin:$ENV{CRS_HOME}/has/bin:$ENV{PATH}" if $ENV{PATH};
  $ENV{PATH}="$ENV{CRS_HOME}/bin:$ENV{CRS_HOME}/has/bin" unless $ENV{PATH};

my $clusternm = "newdb_cluster";
 }
}
$ENV{LANG}="en_US.UTF-8";
my $crsHome = $ENV{EM_CRS_HOME};
EMD_PERL_DEBUG( "EM_CRS_HOME returned $crsHome \n");

$crsHome = $ENV{CRS_HOME} if ($crsHome eq "");
print( "CRS_HOME returned $crsHome \n");

#comment following for testing in view
my %stdinArgs = get_stdinvars();
my $clusternm = $stdinArgs{"EM_TARGET_CLUSTER_NAME"};

my %sg_maxsize = {};
my $clusterSize = 1;

EMD_PERL_DEBUG( "EM_TARGET_CLUSTER_NAME = $clusternm \n");

if ($crsHome eq "" || $crsHome eq "#CRS_HOME#" || $clusternm eq "")
{
    EMD_PERL_DEBUG("Ignoring cluster Services metric: either no CRS_HOME or cluster name is not found \n");
}   
else
{

    $clusterSize = get_cluster_size();
    EMD_PERL_DEBUG("ClusterSize = $clusterSize");

    EMD_PERL_DEBUG("Get database names for cluster $clusternm...");
    my @dblist = get_dbnames();


    my $srv_types = {};
    my $availlist = {};
    my $preflist = {};
    my @runlist = ();
    my $tafpolicy = {};
    my $enabled = {};
    my $srvgrp = {};
    my $resnames = {};
    my $srv_cardinality = {};
    my $db = '';
    my @all_services;		
    my %srvpool_cardinality_info = ();
    foreach $db (@dblist)
    {
        my @dbprops = split(',', $db);
        my $dbnm = shift(@dbprops);
        my $dbhom = shift(@dbprops);
        my $dbver = shift(@dbprops);
	my $dbtype = shift(@dbprops);

        EMD_PERL_DEBUG( "db name: $dbnm  db home: $dbhom db version: $dbver db type: $dbtype\n");

	my @kys = keys(%srvpool_cardinality_info);
	my $is_db112_or_later = $dbver == 'NA' ? 
				is_srvctl_version_112_or_higher($dbhom) :
				version_compare($dbver, "11.2") >= 0;

	if(@kys == 0 && $is_db112_or_later)
	{
	    %srvpool_cardinality_info = get_srvpool_cardinality($dbhom);
	}

	push(@all_services, 
		add_database_service_record($dbnm, $dbhom, $clusternm, 
						$is_db112_or_later, $dbtype));

	my @service_names = ();

	EMD_PERL_DEBUG("Retrieving database service configuration. \n");
	my $res = '';
	$res = get_service_config($dbnm, $dbhom);
	if (! defined $res)
        {
            print "em_error=get_service_config returned null, possible errs found \n";
            EMD_PERL_DEBUG( "em_error=get_service_config returned null, possible errs found\n");
	    next;
        }
        else
        {
	    EMD_PERL_DEBUG( "get_service_config returned $res \n");

	    # clear arrays before getting info for this db
	    $srv_types = {};
	    $availlist = {};
	    $preflist = {};
	    $tafpolicy = {};
	    $enabled = {};
	    $srvgrp = {};
	    $srv_cardinality = {};
    	    $resnames = {};

	    @service_names = parse_serviceconfig_res($res, \$srv_types, \$availlist, \$preflist, \$tafpolicy, \$enabled, \$srvgrp, \$resnames, \$srv_cardinality);
        } # else

	$res = '';
	$res = get_service_status($dbnm, $dbhom);
	if (!defined $res)
        {
            print "em_error=get_service_status returned null, possible errs found \n";
            EMD_PERL_DEBUG( "em_error=get_service_status returned null, possible errs found\n");
	    next;
        }
        else
        {
	    print " get_service_status returned : $res \n";
	    EMD_PERL_DEBUG( "get_service_status returned $res \n");
	 
	    # clear arrays before getting info for this db

	    splice(@runlist, 0);

	    parse_servicestat_res($res, \@runlist);

        } # else


	    EMD_PERL_DEBUG( "Service names from srvctl \n");

	    my $i = 0;
	    my $nm = '';
	    foreach $nm (@service_names)
	    {
		if($nm eq $dbnm) {
	    		EMD_PERL_DEBUG("Skip the Database service.");
			next;
		}
	       
                EMD_PERL_DEBUG(" service name : $nm ");

	    # get cardinality value for service
	    my $cardnl = 0;
	    if (lc($srv_cardinality->{$nm}) eq "singleton")
	    {
		$cardnl = 1;
	    } elsif(lc($srv_cardinality->{$nm}) eq "uniform")
	    {
    		$cardnl = $srvpool_cardinality_info{"ora.".$srvgrp->{$nm}}; 
	    }
	    else 
	    {
		$cardnl = 0;
		$srv_cardinality->{$nm} = "";
	    }

	    EMD_PERL_DEBUG(" service name : $nm, resnm = ".$resnames->{$nm}." , cardinality = $cardnl");	
    # hard code ecm_data_ver to 1
    #em_result format
    #  ecm_data_version|database_name|service_name|service_type|enabled|tafpolicy|preferred instance list|available instance list|running instance list

	       my $svc_entry = "em_result=1|$dbnm|$nm|$srv_types->{$nm}|$enabled->{$nm}|$tafpolicy->{$nm}|$preflist->{$nm}|$availlist->{$nm}|$runlist[$i]|$clusternm|$srvgrp->{$nm}|$resnames->{$nm}|$srv_cardinality->{$nm}|$cardnl|$dbtype\n";
		   push(@all_services, $svc_entry);
	       $i++;
	    } # for each nm
    } # for each dbnm
	
	EMD_PERL_DEBUG("The recordset:\n"); 

	my $record = "";
	foreach $record(@all_services)
	{
	    	EMD_PERL_DEBUG($record);
		print $record;
        	print "------ \n";
	}
}  # end of script

# Following are subroutines for adding server pool information
# in mgmt_rac_services.
# mgmt_rac_services subroutines START

# Adds a record for the database service in mgmt_rac_services.
# Currently the following attributes do not apply and thus 
# store dummy values:
# enabled 
# tafpolicy 
# pref_list
# availibility
# runlist
# cardinality
sub add_database_service_record
{
	my($dbnm, $dbhom, $clusternm, $isdb112orlater, $dbtype) = @_;
	my @mgmt_racsvc_params = ();
	my $srvpool = "";
	my $cardinality_type = "";
	my $tafpolicy = "NONE";
	my $pref_list = "";
	my $availibility = "";
	my $runlist = "";
	my $cardinality = 0;
	my $enabled = "true";

	if($isdb112orlater) {
		@mgmt_racsvc_params = get_mgmt_racsvc_params($dbnm, $dbhom);
		$srvpool = $mgmt_racsvc_params[0];
		$cardinality_type = $mgmt_racsvc_params[1];
	}
	my $record = "em_result=1|$dbnm|$dbnm|internal|true|$tafpolicy|$pref_list|$availibility|$runlist|$clusternm|$srvpool|ora.$dbnm.$dbnm.svc|$cardinality_type|$cardinality|$dbtype\n";
	EMD_PERL_DEBUG("mgmt_rac_services record for database service:\n$record");
	$record;
}

# Function used to determine srvctl version is 11.2 or higher 
# by passing in database home or grid home. 
#
# When srvctl is run from ORACLE_HOME, it returns the  srvctl 
# version corresponding to the database. 
# For 11.1 OH, it returns 11.0.0.0.0
#     10.2.0.5 OH returns 10.2.0.0.0
#     11.2 OH returns 11.2.0.0.0
#
# When srvctl is run from grid home, it returns the  srvctl 
# version corresponding to the clusterware.

sub is_srvctl_version_112_or_higher
{
    	my($home) = @_;
    	my $retval = 0;

    	my $result = run_command($home, "srvctl config -V");

    	if(!defined $result) {
		return undef;
    	}
	my @versionTokens = split(" ", $result);
        my @toks = split("\\.", $versionTokens[2]);
	if($toks[0] >= 11) {
		if(($toks[0] == 11 && $toks[1] >= 2) ||
		   ($toks[0] > 11)) { 
        		$retval = 1;
			EMD_PERL_DEBUG("is_srvctl_version_112_or_higher: ".
				"Srvctl version is 11.2 or higher.");
		} 
    	} 

	if(!$retval) {
		EMD_PERL_DEBUG("is_srvctl_version_112_or_higher: ".
				"Srvctl version is smaller than 11.2.");
	}

    	return $retval;
}

# Checks if clusterware version is 11202 or higher
sub is_cls_ver11202_or_higher
{
        my $result = run_command($ENV{EM_CRS_HOME}, "srvctl config -V");

        if(!defined $result) {
		EMD_PERL_DEBUG("is_cls_ver11202_or_higher:  ".
			"Cannot proceed with version check."); 
                return undef;
        }
        my @versionTokens = split(" ", $result);		

	my $vcheck = version_compare($versionTokens[2], "11.2.0.2.0");
	
	EMD_PERL_DEBUG("is_cls_ver11202_or_higher:  ".
		"Version compare results of $versionTokens[2] and \"11.2.0.2.0\" is $vcheck\n");
	return $vcheck >= 0 ? 1 : 0;
}

# version_compare(ver1, ver2) returns
# 1 / 0 / -1 if ver1 is newer/equal/older
# than ver2
sub version_compare
{
        my ($ver1, $ver2) = @_;
        my @ver1arr = split(/\./, $ver1);
        my @ver2arr = split(/\./, $ver2);
        my $test_res = 0;
        for(my $i = 0; $i < @ver1arr && $i < @ver2arr && $test_res == 0; $i++)
        {
                if($ver1arr[$i] > $ver2arr[$i])
                {
                        $test_res = 1;
                }
                elsif($ver1arr[$i] < $ver2arr[$i])
                {
                        $test_res = -1;
                }
                else
                {
                        $test_res = 0;
                }
        }

    	EMD_PERL_DEBUG("version_compare: Comparison of $ver1, $ver2 returned $test_res");
        return  $test_res;
}

sub get_srvpool_cardinality
{
    my ($dbhome) = @_;
    my $pool_hash = {};
    my $result = run_command($dbhome, "srvctl status srvpool -S 1");
    parse_pool_data($result);
}

sub parse_pool_data
{
    my($input) = @_;
    my @cmd_lines = split("\n", $input);
    my $line = "";
    my %srvpool_info = ();
    foreach $line (@cmd_lines)
    {
	my @toks = split(" ", $line);
	my @tok_list = grep(/res_name={.*}/, @toks);
	my $pool_name = "";
	if(@tok_list == 1)
	{
	    $tok_list[0] =~ /res_name={(.*)}/;  
	    $pool_name = $1;
	}

	@tok_list = grep(/active_servers={.*}/, @toks);
	my $pool_active_cardinality = 0;
	if(@tok_list == 1)
	{
	    $tok_list[0] =~ /active_servers={(.*)}/;
	    my @active_servers = split(",", $1);
	    $pool_active_cardinality = @active_servers;  
        }
	$srvpool_info{$pool_name} = $pool_active_cardinality;
    }
    my @arr = %srvpool_info;
    EMD_PERL_DEBUG("Server pool information hash contents @arr");
    return(%srvpool_info);
}

sub run_command
{
    my ($dbhome, $command) = @_;

    my $config_cmd = '';
    my $result = '';

    $config_cmd = $dbhome."/bin/".$command;
    print($config_cmd);
    EMD_PERL_DEBUG( "run_command: srvctl command $config_cmd  \n");

    my $saveOraHome = $ENV{ORACLE_HOME};
    $ENV{ORACLE_HOME} = $dbhome;
    chomp ($result = `$config_cmd`);
    if ($? != 0)
    {
       	$ENV{ORACLE_HOME} = $saveOraHome;
	my $errormsg = "Failed to run command ".$config_cmd." in run_command(). Return value - $?.\n";
	print($errormsg);
	EMD_PERL_DEBUG($errormsg);
       	return undef;
    }
    $ENV{ORACLE_HOME} = $saveOraHome;

    my $err= has_errcode($result);
    if ($err != 0)
    {
        EMD_PERL_DEBUG( "run_command(): error codes found in the srvctl result : $result \n");
        return undef;
    }
    return $result;
}

sub parse_db_config
{
	my($line) = @_;
	my @result = ("", "");

	if($line=~/(db_type={POLICY_MANAGED})/)
	{
		$result[1] = "UNIFORM";
		if($line=~/srvpool={(.*)} db_type/)
		{
			$result[0] = $1;
		}
	}
	return ($result[0], $result[1]);
}

# Retrieves server pools for a given database as
# comma seperated list in result[0] something like
# "racPool1,racPool2". Retrieves db service cardinality
# type in result[1], either UNIFORM or "". If db type
# is ADMIN_MANAGED, cardinality type is set to "".
# Also, If  database type is ADMIN_MANAGED, server pool
# list is empty
sub get_srvpool_param
{
	my($dbhm, $cmd) = @_;

	my $result = run_command($dbhm, $cmd);
	parse_db_config($result);
}

# Returns an array where index [0] contains server pool
# data and [1] contains cardinality type. For ADMIN_MANAGED
# databases, index [0] will have the value "".
sub get_mgmt_racsvc_params
{
    my($dbname, $dbhome) = @_;
    my $cmd = "srvctl config database -d ".$dbname." -S 1";
    my @mgmt_racsvc_params = get_srvpool_param($dbhome, $cmd);
	if($mgmt_racsvc_params[1] eq "UNIFORM")
	{
		$mgmt_racsvc_params[0] = setup_pool_maxsizes(\@mgmt_racsvc_params, $dbhome);
	}
    EMD_PERL_DEBUG( "get_mgmt_racsvc_params(): For database $dbname, Server Pools: $mgmt_racsvc_params[0] , Cardinality Type: $mgmt_racsvc_params[1].\n");
    return(@mgmt_racsvc_params);
}

sub setup_srvpool_config
{
        my($input, $pools) = @_;
        my @poolnms = split(",", $pools);
        my @cmd_lines = split("\n", $input);
        my $line = "";
	my $pool_names = "";
        my $srv_cnt= "";
        foreach $line (@cmd_lines)
        {
                my $poolnm = "";
                foreach $poolnm(@poolnms)
                {
                        if($line=~/res_name={.*$poolnm}/)
                        {
                                if($line=~ /active_servers={(.*)} online/)
                                {
                                	if($srv_cnt ne "")
                                	{
                                        	$srv_cnt .= ",";
                                	}

					if($1 ne "")
                                        {
                                         	my @active_srvs = split(",", $1);
						$srv_cnt .= @active_srvs;
                                        } else {
						$srv_cnt .= 0;
					}
                                }

                                if($pool_names ne "")
                                {
                                        $pool_names .= ",";
                                }
                                $pool_names.="ora.".$poolnm;
                        }
                }
        }
        $pool_names.":".$srv_cnt;
}

# Appends the pool max sizes to the server pool
# list, something like - racPool1,racPool2:6,4
sub setup_pool_maxsizes
{
	my @racsvc_params = @{$_[0]};
        my $dbhome = $_[1];
	my $cmd = "srvctl status srvpool -S 1";
	my $result = run_command($dbhome, $cmd);
	return(setup_srvpool_config($result, $racsvc_params[0]));
}
# mgmt_rac_services subroutines END

sub get_database_config
{
    my ($dbName, $dbhome) = @_;

    my $config_cmd = '';
    my $result = '';

    $config_cmd = "$dbhome/bin/srvctl config database -S 1 -d ".$dbName ;

#    print "Srvctl command: $config_cmd\n";
    EMD_PERL_DEBUG( "get_database_config : srvctl command $config_cmd  \n");

    my $saveOraHome = $ENV{ORACLE_HOME};
    $ENV{ORACLE_HOME} = $dbhome;
    chomp ($result = `$config_cmd`);
    if ($? != 0) 
    {
       $ENV{ORACLE_HOME} = $saveOraHome;
       print "Failed to run the srvctl config command in get_service_config $? \n";
   EMD_PERL_DEBUG( "get_service_config : failed to run srvctl config command status $?  \n");
	    return undef;
    }
    $ENV{ORACLE_HOME} = $saveOraHome;

##     print "in getServiceStatus, result : $result.\n";

# check if any error code found in result string else pass on to calling function
    my $err= has_errcode($result);
    if ($err != 0)
    {
        EMD_PERL_DEBUG( "get_service_config : error codes found in the srvctl result : $result \n");
        return undef;
    }
    return $result;
}
# Retrieves db name, home and version
# Note that it is applicable for 
# clusterware version 11.2.0.2.0 and
# hopefully later
sub get_dbnames_homes
{
	my $result = run_command($ENV{EM_CRS_HOME}, 
				"srvctl config database -v");

	EMD_PERL_DEBUG("get_dbnames_homes: : ".
		"Output from running srvctl config database -v: $result");

	if(!defined $result) {
		EMD_PERL_DEBUG("Could not retrieve database names.\n");
		return undef;
	}
	
	my @cmd_lines = split("\n", $result);
	my $line;
	my @dblist = ();
	foreach  $line(@cmd_lines) {
		my ($dbname, $dbhome, $dbver) = split(" ", $line);
                my $dbtype = parseForDbType($dbname,$dbhome);
		push(@dblist, "$dbname,$dbhome,$dbver,$dbtype");
	}

	EMD_PERL_DEBUG("get_dbnames_homes: ".
			"Return value <dbname, dbhome, dbversion>: @dblist\n");

	return @dblist;
}
	
	

# RAC One Node: Parse the Database Type value
sub parseForDbType
{
	my $type = 'RAC';
    	my($dbname,$dbhome) = @_;
        EMD_PERL_DEBUG( "Input for db type parsing:\n $dbname and $dbhome\n");
	my $result;
	my $cmd = "$dbhome/bin/srvctl config database -d $dbname -S 1";

	EMD_PERL_DEBUG("parseForDbType : srvctl command $cmd  \n");

        # bug 24842886 :
        #   If this dbcontrol home and dbhome are of different vers 
        #   (ex: 11g vs 12c), calling dbhome/bin/srvctl w/o setting OH 
        #   (i.e. ORACLE_HOME) to dbhome will cause dbhome Java (called by 
        #   srvctl) to core dump due to version mismatches (while searching 
        #   for dependencies like  lib*.so files, *.jar files, etc).
        #
        #   Prevent core dump by backing-up OH (pointing at this dbcontrol
        #   home), set OH to dbhome, run dbhome srvctl, handle 
        #   results/errors, and restore OH.
        #
	my $saveOraHome = $ENV{ORACLE_HOME};
	$ENV{ORACLE_HOME} = $dbhome;

        chomp ($result = `$cmd`);
       	if ($? == 0) {
		my @toks = split(" ", $result);
		my @tok_list = grep(/db_category={.*}/, @toks);
		if(@tok_list == 1)
		{
		    $tok_list[0] =~ /db_category={(.*)}/;  
		    $type = $1;
		} else {
                    my $err_msg = "Database type not found for ".  "$dbname.\n";
                    EMD_PERL_DEBUG("parseForDbType: $err_msg");
		}
	} else {
            my $err_msg = "Database type not found for ".  "$dbname.\n";
            EMD_PERL_DEBUG("parseForDbType: $err_msg");
	}

	$ENV{ORACLE_HOME} = $saveOraHome;

	$type;
}

# Usage: get_dbnames()
# Calls: srvctl config 
sub get_dbnames
{
     if(is_cls_ver11202_or_higher())
     {
	return get_dbnames_homes();
     }

     my $cmd = '';
     my $result = '';

     $cmd = "$ENV{EM_CRS_HOME}/bin/srvctl config" ;

     print "Srvctl command: $cmd\n";
     EMD_PERL_DEBUG( "get_dbnames : srvctl command $cmd  \n");

     my @dbnames = ();
     chomp ($result = `$cmd`);
     if ($? != 0) {
          print "em_error=Failed to run the srvctl command in get_dbnames $? \n";
          EMD_PERL_DEBUG( "em_error=get_dbnames : failed to run srvctl command status $?  \n");
#          print "$result\n";
          return @dbnames;
     }

#    print "in get_dbnames, result : $result.\n";
     @dbnames = split("\n", $result);

#    Get database homes
     my $dbname = '';
     my $dbversion = 'NA';
     my $dbtype = '';
     my $dbhome = $ENV{EM_CRS_HOME};
     my @dblist = ();
     foreach $dbname (@dbnames)
     {
	 my $dbhm = get_db_home($dbname);

	 if(!defined $dbhm) {
                $dbhm = $ENV{EM_CRS_HOME};
         	EMD_PERL_DEBUG(
		"Could not retrieve oracle home for database $dbname\n");
	 }
         $dbtype = parseForDbType($dbname,$dbhm);
         EMD_PERL_DEBUG( "db name: $dbname, db home: $dbhm, db version: $dbversion  \n");
         push(@dblist, "$dbname,$dbhm,$dbversion,$dbtype");
     }

     return @dblist;
}

sub get_db_home
{
	my($dbname) = @_;
	my $cmdErrStatus = '';
	my $result;
	my $isCls112orHigher = is_srvctl_version_112_or_higher($ENV{EM_CRS_HOME});
        if ($isCls112orHigher) {
		$result = parse_db112_config($dbname);
        } else {
		$result = parse_pre_db112_config($dbname);
	}
	return $result;
}

sub parse_db112_config
{
    	my($dbname) = @_;
	my $oh;
	my $result;
	my $cmd = "$ENV{EM_CRS_HOME}/bin/srvctl config database -d $dbname -S 1";
        chomp ($result = `$cmd`);
       	if ($? == 0) {
		my @toks = split(" ", $result);
		my @tok_list = grep(/oh={.*}/, @toks);
		if(@tok_list == 1)
		{
		    $tok_list[0] =~ /oh={(.*)}/;  
		    $oh = $1;
		} else {
			my $err_msg = "Error parsing database config output for oracle ".
					"home.\n";
			print $err_msg;
			EMD_PERL_DEBUG("parse_db112_config: $err_msg");
		}
	} else {
		my $cmd_err = $?;
		$oh = oracle_home_pre112_handler($result);
		if(!defined $oh) {
      			my $err = "em_error=Failed to run the srvctl config database -S 1".
			  "command $cmd_err\n";
			print $err;
       			EMD_PERL_DEBUG("parse_db112_config: $err");
		}
	}

    EMD_PERL_DEBUG("parse_db112_config: oh - $oh");
    return $oh;
}

# srvctl config database -d <dbnm> -S 1 executed from
# crs home gives error for 10.2 and 11.1 databses. 
# The error contains the oracle home. This function 
# attempts to retrieve the path from the error message.

sub oracle_home_pre112_handler
{
        my($input) = @_;

	EMD_PERL_DEBUG("oracle_home_pre112_handler: ".
		"Input error string: $input");

        my @tokens = split(" ", $input);
        my @reverse_tokens = reverse(@tokens);
        my $tok;
        my $o_h;
        foreach $tok(@reverse_tokens) {
                if(-d $tok) {
                        $o_h = $tok;
                        last;
                } else {
                        # 11.1 db error string has a token with a
                        # dot like '/opt/OrcProds/dbhome_1.'
                        # Remove the dot and retry.
                        my $last_char = substr($tok, 0, -1);
                        if($last_char = '.') {
                        	substr($tok, -1, 1, '');
                                if(-d $tok) {
                                	$o_h = $tok; 
                                	last;
				}
                        }
                }
        }
        if(defined $o_h) {
                EMD_PERL_DEBUG(
                "oracle_home_pre112_handler: Detected oracle home $o_h");
        } else {
                EMD_PERL_DEBUG(
                "oracle_home_pre112_handler: Oracle Home not found in ".
                "error string $input");
        }
        return $o_h;
}

sub parse_pre_db112_config
{
    	my($dbname) = @_;
	my $oh;
	my $result;
	my $cmd = "$ENV{EM_CRS_HOME}/bin/srvctl config database -d $dbname";
        chomp ($result = `$cmd`);
       	if ($? == 0) {
		my @lines = split("\n", $result);
		my @toks = split(" ", $lines[0]);
		my $pos_1st_space = index($lines[0], " ");
		my $oh_tok_pos = index($lines[0], 
					" ", ($pos_1st_space + 1)) + 1;
		my $o_h = substr($lines[0], $oh_tok_pos);
		if(@toks == 3) {
			$oh = $toks[2];
		} else {
			my $err_msg = "Error parsing database config output ".
					"for oracle home.\n";
			print $err_msg;
			EMD_PERL_DEBUG("parse_pre_db112_config: $err_msg");
		}
	} else {
                my $err = "em_error=Failed to run the srvctl config database ".
			"-S 1 command $? \n";
                print $err;
                EMD_PERL_DEBUG("parse_pre_db112_config: $err");
        }

	return $oh;
}
	
# Usage: get_service_config(dbName, [sv1...svK])
# Calls: srvctl status service -f -S 1 -d dbName -s sv1,sv2...svK

sub get_service_config
{
    my ($dbName, $dbhome) = @_;

    my $config_cmd = '';
    my $result = '';

    $config_cmd = "$dbhome/bin/srvctl config service -S 1 -d ".$dbName ;

    print "Srvctl command: $config_cmd\n";
    EMD_PERL_DEBUG( "get_service_config : srvctl command $config_cmd  \n");

    my $saveOraHome = $ENV{ORACLE_HOME};
    $ENV{ORACLE_HOME} = $dbhome;
    chomp ($result = `$config_cmd`);
    if ($? != 0) {
       $ENV{ORACLE_HOME} = $saveOraHome;
       print "Failed to run the srvctl config command in get_service_config $? \n";
   EMD_PERL_DEBUG( "get_service_config : failed to run srvctl config command status $?  \n");
#            print "$result\n";
	    return undef;
        }
    $ENV{ORACLE_HOME} = $saveOraHome;

##     print "in getServiceStatus, result : $result.\n";

# check if any error code found in result string else pass on to calling function
    my $err= has_errcode($result);
    if ($err != 0)
    {
        EMD_PERL_DEBUG( "get_service_config : error codes found in the srvctl result : $result \n");
        return undef;
    }
    return $result;
}

# Usage: get_service_status(dbName, [sv1...svK])
# Calls: srvctl status service -f -S 1 -d dbName -s sv1,sv2...svK

sub get_service_status
{
    my ($dbName, $dbhome) = @_;

    my $status_cmd = '';
    my $result = '';

    $status_cmd = "$dbhome/bin/srvctl status service -f -S 1 -d ".$dbName ;

    print "Srvctl command: $status_cmd\n";
    EMD_PERL_DEBUG( "get_service_status : srvctl command $status_cmd  \n");

    my $saveOraHome = $ENV{ORACLE_HOME};
    $ENV{ORACLE_HOME} = $dbhome;
    chomp ($result = `$status_cmd`);
    if ($? != 0) {
       $ENV{ORACLE_HOME} = $saveOraHome;
       print "Failed to run the srvctl config command in get_service_status $? \n";
   EMD_PERL_DEBUG( "get_service_status : failed to run srvctl config command status $?  \n");
#            print "$result\n";
	    return undef;
        }
    $ENV{ORACLE_HOME} = $saveOraHome;

##     print "in getServiceStatus, result : $result.\n";

# check if any error code found in result string else pass on to calling function
    my $err= has_errcode($result);
    if ($err != 0)
    {
        EMD_PERL_DEBUG( "get_service_status : error codes found in the srvctl result : $result \n");
        return undef;
    }
    return $result;
}

sub parse_serviceconfig_res
{
   my ($result, $styp, $alist, $plist, $tfp, $en, $grp, $resnm, $card) = @_;

   my @lines = split("\n", $result);
   my @srv_names;
   my $line = '';

#    print "-------------\n inside parse_serviceconfig_res  \n";

   my $lineno = 0;
   foreach $line (@lines)
    {
#	print " Parsing line $lineno : $line \n";
   EMD_PERL_DEBUG( "parsing srvctl status line $lineno : $line \n");
	# replace " ," with "," before tokenizing i.e t1, t2, t3 will be replaced by t1,t2,t3 
	$line =~ s/, /,/g;
#	print " replaced line : $line \n";

	my $name="";
	my $typ="";
	my $pl="";
	my $al="";
	my $rl="";
	my $tf="";
	my $ct="";
	my $res="";

	# parse config line in format 
	#     @=service[0]: name={servicename1} enabled={true/false} pref={inst_list}
        #     avail={inst_list2} disabled_insts={inst_list3} 
        #     tafpolicy={NONE/BASIC/PRECONNECT} type={internal/user}
	# for trail blazer the format will be as follows
	#     @=result[0]: res_name={..} name={..} enabled={true/false} srvgrp={..} 
	#     cardinality={UNIFORM/SINGLETON} disconnect={false} dbRoles={PRIMARY} 
	#     mgmtPolicy={automatic} dtp={false} aqhaNatification={false} 
        #     failoverType={NONE} failoverMethod={NONE} failoverRetry={0} 
        #     failoverDelay={0} clbGoal={NONE} rlbGoal={NONE} tafPolicy={NONE} 
        #     enabledNodes={n1,n2} disabledNodes={} up={} down={n1,n2}

	if ($line =~ /^#@=service/ or $line =~ /^#@=result/)
	{
            if(isInternalService($line) == 1) 
	    {
		next;
            }
	    my @tokens = split(" ",$line);
	    my $token = '';
	    $name="";
	    my $istb = 0;
	    foreach $token (@tokens)
	    {
#		print " parsing token : $token \n";
#   EMD_PERL_DEBUG( "parsing token $token  \n");

		if ($token =~ /^name=/)
		{
		    $name = parseToken($token);
		    push (@srv_names, $name);
#		     print " parsed service name = $name ";

# res_name is first for TB so need to put it in hash using service name here
# make sure res_name appears in output, for older crs it wont
		    if ($istb == 1)
		    {
		       ${$resnm}->{$name}= $res;
#    print " service = $name, parsed resource name = ".${$resnm}->{$name}."\n";
		    }
		}
# 11.2 onwards type will not be listed so will not be internal services
# we will hard code type as user from 11.2 onwards
		if ($token =~ /^type=/)
		{
		    $typ = parseToken($token);
		    ${$styp}->{$name}= $typ;
#		     print " type = $typ ";
		}
		#parse preferrable instance list
		if ($token =~ /^pref=/)
		{
		   $pl = parseToken($token);
		   ${$plist}->{$name}= $pl;
#		     print " pref = $pl ";
		}
		# parse available instance list
		if ($token =~ /^avail=/)
		{
		   $al = parseToken($token);
		   ${$alist}->{$name}= $al;
		}
		# parse  taf policy
		if ($token =~ /^tafpolicy=/)
		{	
		   $tf = parseToken($token);
		   ${$tfp}->{$name}= $tf;
		}
		# parse  enabled
		if ($token =~ /^enabled=/)
		{
		   $tf = parseToken($token);
		   ${$en}->{$name}= $tf;
		}
		# parse  server group
		if ($token =~ /^srvpool=/)
		{
		   $tf = parseToken($token);
		   ${$grp}->{$name}= $tf;
		}
		# parse  resource Name 
		if ($token =~ /^res_name=/)
		{
		    $res = parseToken($token);
		    $istb = 1;
		}
		# parse  service cardinality
		if ($token =~ /^cardinality=/)
		{
		   $ct = parseToken($token);
		   ${$card}->{$name}= $ct;
		}
	    }
	    if ($istb == 1)
	    {
		$typ = 'user';
		${$styp}->{$name}= $typ;
	    }
        }
#	print "\n------ - ----- \n";

	$lineno++;
    }
    return @srv_names;
}

sub isInternalService
{
   my ($input) = @_;
   my $retval = 0;
   if($input =~ /usage_type={internal}/)
   {
      $retval = 1;
   }
   return $retval;
}

sub parse_servicestat_res
{
   my ($result, $rlist) = @_;

   my @lines = split("\n", $result);
   my $line = '';

#    print "-------------\n inside parse_servicestat_res  \n";

   my $lineno = 0;
   foreach $line (@lines)
    {
#	print " Parsing line $lineno : $line \n";
   EMD_PERL_DEBUG( "parsing srvctl status line $lineno : $line \n");
	# replace " ," with "," before tokenizing i.e t1, t2, t3 will be replaced by t1,t2,t3 
	$line =~ s/, /,/g;
#	print " replaced line : $line \n";

	my $rl="";

	# parse status line in format 
	# #@=result[0]: up={inst_list} down={inst_list2} disabled={inst_list3} 
        #               unknown={inst_list4}
	if ($line =~ /^#@=result/)
	{
	    my @tokens = split(" ",$line);
	    my $token = '';
	    foreach $token (@tokens)
	    {
#		print " parsing token : $token \n";
#   EMD_PERL_DEBUG( "parsing token $token  \n");

		# parse running instance list
		if ($token =~ /^up=/)
		{
		    $rl = parseToken($token);
		    push (@{$rlist}, $rl);
		}
	    }
	}

#	print "\n------ - ----- \n";

	$lineno++;
    }
    return;
}

sub parseToken
{
    my  ($token) = @_;
    my $value="";
        my $s = substr $token,  index($token, "=")+1;
#        print "parseToken : s : $s ";
        $s =~ s/[{}]//g;
#        print "parseToken : s : $s ";
	$value = $s;
    return $value;
}

# Purpose: find following error codes in input string:
#          "PRKP"
#          "PRKH"
#          "PRKO"
#          "CRS"
#          "ORA"
sub has_errcode
{
    my $in_str = $_[0];

#    print "error code detector: $in_str\n";

    if ($in_str =~ /PRKP-/ || $in_str =~ /PRKH-/ || $in_str =~ /PRKO-/ || $in_str =~ /CRS-/ || $in_str =~ /ORA-/) {
        return(-1);  # error mesg
    }
    else {
        return(0);
    }

}

sub get_cluster_size
{
    my $sg_config_cmd = '';
    my $result = '';

    my $olsnodes_cmd = "$ENV{EM_CRS_HOME}/bin/olsnodes -s";

    chomp ($result = `$olsnodes_cmd`);
    if ($? != 0) {
       print "Failed to run the olsnodes command $? \n";
   EMD_PERL_DEBUG( "get_cluster_size : failed to run olsnodes command; status $?  \n");
print "$result\n";
	    return 0;
    }

# check if any error code found in result string else pass on to calling function
    my $err= has_errcode($result);
    if ($err != 0)
    {
        EMD_PERL_DEBUG( "get_cluster_size : error codes found in the olsnodes result : $result \n");
        return 0;
    }

print "get_cluster_size, result = $result \n";

     my @lines = split("\n", $result);
     my $line = '';
     my $lineno = 0;

     foreach $line (@lines)
     {
# if required to take Active servers, modify here to have condition for it
	$lineno++;
     }

     return $lineno;
}
