##############################################################################
#
# $Author: lems1 $
# $Date: 1998/11/12 07:07:20 $
# $Revision: 2.6 $
# $Name:  $
#
##############################################################################

package Svrmgrl;

#use strict;
use vars qw($VERSION @ISA @EXPORT);

require Exporter;

@ISA = qw( Exporter Substandard );

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

@EXPORT = qw();

@EXPORT_OK = qw();

$VERSION = '0.01';


use lib '/dbi-processing/lib/site-perl';

use Muchoruno;			# parallel execution and logging.
use Substandard;		# sub process management.

##############################################################################

use Carp;

# Preloaded methods go here.

# create a new svrmgrl object as Svrmgrl->new( ORACLE_SID, connect_string );
# Substandard takes care of the fork and communication.

# dealing with subprocesses and popen requries handling 
# SIGPIPE's.  this goes here rather than Substandard because
# we know how we are logging the data, Substandard doesn't.

$SIG{PIPE} = sub { postlog( 'notice', 'DOA process detected via SIGPIPE' ); exit 0; };

sub new
{
	# set up environment so that the sub-process created via
	# substandard will be run properly.  the first argument 
	# from the caller.  perl puts the package id on the stack.

	my $package = shift;

	my $sid = shift;

	fubar "bogus Svrmgrl create: no ORACLE_SID", 0
		unless $sid;

	my $connect = @_ ? shift : 'internal';

	# set up the oracle environment.

	# now find the ORACLE_HOME from the /etc/oratab for the
	# ORACLE_SID we are using.  grep the first entry from 
	# /etc/oratab with the ORACLE_SID, split it apart on 
	# colons and take the second entry.

	fubar "failed to open oratab: $!"
		unless open ORATAB, "< /etc/oratab";
	my $home = ( split m/:/, (grep m/^$sid/, <ORATAB>)[0] )[1] ;
	close ORATAB;

	fubar "no ORACLE_HOME entry for $ENV{ORACLE_SID} found in /etc/oratab"
		unless $home;

	# set up shell environment

	$ENV{ORACLE_SID}  = $sid;
	$ENV{ORACLE_HOME} = $home;

	# TWO_TASK shouldn't be set for internal connects should be set
	# to the ORACLE_SID for others.

	if( $connect eq 'internal' )
	{
		delete $ENV{TWO_TASK} if exists $ENV{TWO_TASK};
	}
	else
	{
		$ENV{TWO_TASK} = $ENV{ORACLE_SID};
	}

	postlog( 'debug', 'Svrmgrl', qx(echo "TWO_TASK == '\$TWO_TASK'") );

	# the server manager command will come from $ORACLE_HOME/bin, 
	# and must be adjusted for users running this as superuser.

	my $svrmgrl = "$ENV{ORACLE_HOME}/bin/svrmgrl";
	my $command = $> ? $svrmgrl : "/usr/local/bin/su -p oracle --command $svrmgrl"; 

	# at this point it seems reasonable to try and fork off the
	# svrmgrl process.

	postlog(
		'info', 'Svrmgrl',
		"oracle_sid  = $ENV{ORACLE_SID}",
		"oracle_home = $ENV{ORACLE_HOME}",
		"connect id  = $connect",
		"command     = $command",
	);

	# create new Substandard object.
	# which is then blessed into this package.
	# this means we have to clean up after the function.
	# could also use Substandard::new $package, $command;

	my $self = Substandard->new( $command );
	bless $self, $package;

	# make logging prettier with multiple sessions open.
	# pid is used in various places for tracking things.

	$self->{sid} = $sid;

	# default select timeout

	$self->{timeout} = 60;

	# make tracking syslog entrys for multiple-connect
	# chat's manageable.

	$self->{logid} = $connect eq 'internal' ? $sid : "$sid:$connect" ;

	# show off the rest of our object

	postlog(
		'info', 'Svrmgrl',
		"process id  = $self->{pid}",
		"logging id  = $self->{logid}",
		"timeout     = $self->{timeout}",
	);

	# make the connection.  uses Svrmgrl->chat which logs
	# the send and recv to debug and chat to info.

	$self->chat( "connect $connect" );

	# no reply from oracle, may be a sync issue on the
	# recv.  try it again one time to be sure...

	$self->recv
		unless( @{$self->{reply}} );

	# warn about connect failures.

	postlog( 'notice', 'Svrmgrl', 'may have failed on local connect', @{$self->{reply}} )
		unless( @{$self->{reply}} && grep m/Connect/, @{$self->{reply}} );

## used for testing only...
##
##	# this has caused us more problems than anything else...
##	# just to be sure, have svrmgrl show what it sees the 
##	# TWO_TASK environment variable set to via echoing it 
##	# from a shell escape w/in svrmgrl.
##
##	postlog( 'debug', 'Svrmgrl', $self->chat( q(!echo "TWO_TASK is set to '$TWO_TASK'") );

	# hand back the popluated hash reference to our caller.

	$self
}

# automatic quit for out-of-scope variables.

sub DESTROY
{
	my $self = shift;

	$self->quit;

	postlog( 'debug', 'final words', Substandard->recv( $self ) );

	Substandard->DESTROY( $self );

	0
}

# quit svrmgrl and save last words in $self->{reply}.
# when the variable goes out of scope then DESTROY
# will handle cleaning it up and any required cleanups

sub quit
{
	my $self = shift;

	$self->send( "quit\n" );

	$self->{usable} = 0;

	@{ $self->{reply} }
}

##############################################################################
# send, recv & chat simply log what passes through them and then call
# the Substandard versions.
##############################################################################

sub send
{
	my $self = shift;

	postlog( 'debug', "Svrmgrl ($self->{logid}) : send", @_ );

	Substandard->send( $self, @_ )
}

sub recv
{
	my $self = shift;

	postlog( 'debug', "Svrmgrl ($self->{logid}) : recv", Substandard->recv($self, @_) );

	@{$self->{reply}}
}

sub chat
{
	my $self = shift;

	postlog( 'info', "Svrmgrl ($self->{logid}) : chat >", @_ );

	Substandard->chat( $self, @_ );

	postlog( 'info',  "Svrmgrl ($self->{logid}) : chat <", @{$self->{reply}} );

	@{ $self->{reply} }
}

# make use happy

1
__END__

# Below is the stub of documentation for your module. You better edit it!

=head1 NAME

Svrmgrl - KwikHak perl extension to control a svrmgrl process.

=head1 Synopsis

  use Svrmgrl;
  
  new		create new object

  quit		explicit close, saves reply in object and sets usable
  			flag to zero.

  DESTROY	automatically calls quit when object goes out of scope.

  send
  recv
  chat
  			call Substandard->blah with logging using the 
			$self->{logid} text..

=head1 DESCRIPTION

Connection to Svrmgrl.

=head1 AUTHOR

Steven Lembark <lembark@wrkhors.com>

=head1 SEE ALSO

perl(1).

=cut

