#!E:\perl\bin\perl.exe 

#--------------------------------------------------------------------------
#
#    orapipe.pl --help|usage|info|?    - For usage info.
#    orapipe.pl --man                  - For man page.
#    orapipe.pl [options...] --debug   - Will run the script in debug mode.
#    pod2text|pod2html orapipe.pl      - Convert pod to text or html.
#
#           Copyright (c) 2004 Joshua Meiri (ibexX.com)

#--------------------------------------------------------------------------

use DBI;
use Getopt::Long;
use Pod::Usage;

select(STDERR);
$| = 1;    # make STDERR unbuffered... you can use: print STDERR "ERR MSG...\n";
select(STDOUT);
$| = 1;    # make STDOUT unbuffered

# GetOptions() will return a true value if the command line could be processed successfully.
$debug = '';    # Option variable with default value (false)
$help  = '';    # Option variable with default value (false)
$man   = '';    # Option variable with default value (false)

# Pipe related Options.
$action   = '';    # Send or Receive pipe
$pipename = '';    # Name of pipe to use
$payload  = '';    # Actual O/S command

# Interface constants for pipe_send and pipe_receive
%pipe_rv =
  ( 0 => 'OK', 1 => 'TIMEOUT', 2 => 'TOO BIG', 3 => 'INTERRUPT' )
  ;                # DBMS_PIPE codes
$bufsize = 8192;   # Message buffer size

GetOptions(
            'action=s'          => \$action,
            'pipename=s'        => \$pipename,
            'payload=s'         => \$payload,
            'debug'             => \$debug,
            'help|usage|info|?' => \$help,
            'man'               => \$man
  )
  || pod2usage(2);    #exit 2

print "$action\t $pipename\t $payload\n" if $debug;

$dbname = 'SID';        # dbi:Oracle: added at 'prepare'
$user   = 'USR';        # User must have Execute on sys.dbms_pipe directly.
$passwd = 'PASSWD';

pod2usage(1) if $help;
pod2usage( -verbose => 2 ) if $man;

# Pipename?
if ( !$pipename )
  {
    print STDERR "err- You must provide a pipename.\n";
    pod2usage(2);         #exit 2
  }

# What action to take?
if ( $action =~ /\bsend\b/i )
  {
    print "Send!\n" if $debug;
    &sendpipe;
  }
elsif ( $action =~ /\breceive\b/i )
  {
    print "Receive!\n" if $debug;
    &receivepipe;
  }
else
  {
    print STDERR "err- Unknown Action: $action\n";
    pod2usage(2);    #exit 2
  }

print "Done!\n" if $debug;
exit 0;

#------------------------------------------
# subs

### SEND ########################################
# This will send a pipe to Oracle.
sub sendpipe
  {
    my $sendrc;    # hold the return code from dbms_pipe.send_message.
    print "\tsendpipe\n" if $debug;
    eval {
        &connectdb;
        $sth = $dbh->prepare( "
                                                        declare
                                                                  rc integer;
                                                        begin
                                                                  dbms_pipe.pack_message(:payload);
                                                                  :rc := dbms_pipe.send_message(:pipename);
                                                        end;
                                                        " )
          or die "err- Can't prepare SEND statement: $DBI::errstr\n";
        $sth->bind_param( ":payload",  $payload );
        $sth->bind_param( ":pipename", $pipename );
        $sth->bind_param_inout( ":rc", \$sendrc, $bufsize );
        $sth->execute;
        &disconnectdb;
    };    # eval
          # Issues with eval...
    if ($@)
      {
        print STDERR "err- Error with DBI: $@ !\n";
      }    # $@ error
    print "DBMS_PIPE.SEND_MESSAGE status: $pipe_rv{$sendrc} ($sendrc).\n";
    exit $sendrc;    # exit w/the oracle dbms_pipe.send message return value.
                     # on win use %ERRORLEVEL% on unix $? for exit code.
  }    # send

### RECEIVE #####################################
# This will receive a pipe from Oracle.
sub receivepipe
  {
    print "\treceivepipe\n" if $debug;
    my $receiverc;    # hold the return code from dbms_pipe.receive_message.
    $when = localtime(time);    # time stamp
    print "$when\nmsg- orapipe daemon started, pipename: $pipename.\n";
    &connectdb;
    eval {
        while (1)
          {
            $sth = $dbh->prepare( "
                                                                declare
                                                                          rc      integer;
                                                                          payload varchar2($bufsize);
                                                                begin
                                                                          :rc := dbms_pipe.receive_message('$pipename');
                                                                          dbms_pipe.unpack_message(payload);
                                                                          :payload := payload;
                                                                end;
                                                                " )
              or die "err- Can't prepare RECEIVE statement: $DBI::errstr\n";

            #$sth->bind_param(":pipename", $pipename);
            $sth->bind_param_inout( ":rc",      \$receiverc, $bufsize );
            $sth->bind_param_inout( ":payload", \$payload,   $bufsize );
            $sth->execute;
            $when = localtime(time);    # time stamp
            print $when . "\n";
            print
"DBMS_PIPE.RECEIVE_MESSAGE status: $pipe_rv{$receiverc} ($receiverc).\n";
            print "debug- Payload: $payload \n" if $debug;

            if ( $payload =~ /\bstop\b/i )
              {

                print "msg- I was asked to stop!\n";
                &disconnectdb;          # disconnect from database before exit.
                exit 0;

              }
            elsif ($payload)
              {

                print "msg- Payload: $payload\n";
                $osrc = system($payload);

                print $osrc . "\n" if $debug;

                if ( $osrc != 0 )
                  {
                    print STDERR
"err- O/S error ($osrc) occurred while executing: $payload\n";
                  }
              }
          }
    };    # eval
          # Issues with eval...
    if ($@)
      {
        print STDERR "err- Error with DBI: $@ !\n";
      }    # $@ error
    &disconnectdb;
  }    # recevie

###########################################
# Make a connection to the Oracle database.
sub connectdb
  {
    print "\tconnectdb\n" if $debug;
    $dbh = DBI->connect( "dbi:Oracle:$dbname", $user, $passwd )
      or die "err- Can't connect to $dbname: $DBI::errstr\n";
  }
###########################################
# Disconnect from the Oracle database.
sub disconnectdb
  {
    print "\tdisconnectdb\n" if $debug;
    $dbh->disconnect or warn "err- Error disconnect: $DBI::errstr\n";
  }

__END__

=head1 NAME

orapipe.pl - A Perl interface to Oracle DBMS_PIPE PL/SQL Package.

This script provides an B<O/S independed> interface for applications.
It also enables Oracle client application to perform B<"host"> operations on the database machine.


=head1 SYNOPSIS

 --- Syntax ----------------------------------------------------------------
 orapipe.pl -action send|receive -pipename name [-payload "cmd1 p;..."|stop]
 --- Examples --------------------------------------------------------------
 orapipe.pl -action send -pipename this -payload "echo this"    = one off
 orapipe.pl -action receive -pipename this                      = loop
 orapipe.pl -action send -pipename this -payload stop           = stop loop

=head1 DESCRIPTION

DISCLAIMER - This package is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.