#!/usr/bin/env perl
#
# curref.pl          - by Geoffrey Young
#
# for this example, we create a package that contains
# two procedures:
#   emp_cursor       - returns a specific cursor reference
#   ref_cursor_close - closes any cursor reference
#
# to actually run this example as is, you will need the
# oracle demo tables.  otherwise, it's just sample code...

use DBI;
use DBD::Oracle qw(:ora_types);

use strict;

# Set trace level if '-# trace_level' option is given
DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;

die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV;
my ( $inst, $user, $pass ) = @ARGV;

# Connect to database
my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass,
    { AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
    or die $DBI::errstr;

my $sql = qq(
  CREATE OR REPLACE PACKAGE curref_test
  IS
    TYPE cursor_ref IS REF CURSOR;
    PROCEDURE emp_cursor (job_in  IN VARCHAR2, curref IN OUT cursor_ref);
    PROCEDURE ref_cursor_close (curref IN cursor_ref);
  END;
);
my $rv = $dbh->do($sql);
print "The package has been created...\n";

$sql = qq(
  CREATE OR REPLACE PACKAGE BODY curref_test
  IS 
    PROCEDURE emp_cursor (job_in IN VARCHAR2, curref IN OUT cursor_ref)
    IS
    BEGIN
      OPEN curref FOR select ename, job from emp where job = job_in;
    END;

    PROCEDURE ref_cursor_close (curref IN cursor_ref)
    IS
    BEGIN
      close curref;
    END;
  END;
);
$rv = $dbh->do($sql);
print "The package body has been created...\n";

print "These are the results from the ref cursor:\n";
$sql = qq(
   BEGIN
     curref_test.emp_cursor(:job_in, :curref);
   END;
);
my $curref;
my $sth = $dbh->prepare($sql);
$sth->bind_param(":job_in", "CLERK");
$sth->bind_param_inout(":curref", \$curref, 0, {ora_type => ORA_RSET});
$sth->execute;
$curref->dump_results;
open_cursors();

$sql = qq(
   BEGIN
     curref_test.ref_cursor_close(:curref);
   END;
);
$sth = $dbh->prepare($sql);
$sth->bind_param(":curref", $curref, {ora_type => ORA_RSET});
$sth->execute;

print "The cursor is now closed\n";
print "just to prove it...\n";
open_cursors();

$sql = "DROP PACKAGE curref_test"; # Also drops PACKAGE BODY
$rv = $dbh->do($sql);
print "The package has been dropped...\n";

$dbh->disconnect;

sub open_cursors {
  eval {
    $sth = $dbh->prepare(
      'SELECT user, sql_text FROM sys.v_$open_cursor ORDER BY user, sql_text');
    $sth->execute;
    print "Here are the open cursors:\n";
    $sth->dump_results;
  };
  if ( $@ ) {
      print "Unable to SELECT from SYS.V_\$OPEN_CURSOR:\n";
      if ( 942 == $DBI::err ) {
         print "   User $user needs SELECT permission.\n";
      }
      else { print "$@\n"; }
  }
}