rem 
rem $Header: prvtpipe.sql 7010300.2 94/04/04 02:35:36 snataraj Generic<base> $ 
rem 
Rem
Rem    NAME
Rem      prvtpipe.sql - send and receive from dbms "pipes"
Rem    DESCRIPTION
Rem      These are private functions to be released in PL/SQL binary form.
Rem      Allow sessions to pass information between them through 
Rem      named SGA memory "pipes"
Rem    RETURNS
Rem 
Rem    NOTES
Rem      The procedural option is needed to use this facility.
Rem      
Rem    MODIFIED   (MM/DD/YY)
Rem     wmaimone   02/22/94 -  use create or replace
Rem     adowning   02/04/94 -  Branch_for_patch
Rem     adowning   02/04/94 -  Creation
Rem     adowning   02/02/94 -  split file into public / private binary files
Rem     dsdaniel   07/09/93 -  dbms_defer longifaction for async rep
Rem     rkooi      10/18/92 -  better comments 
Rem     rkooi      08/20/92 -  comments and cleanup 
Rem     rkooi      05/18/92 -  change comment 
Rem     rkooi      04/28/92 -  change put to pack, etc. 
Rem     rkooi      04/25/92 -  Creation 

REM ********************************************************************
REM THIS PACKAGE MUST NOT BE MODIFIED BY THE CUSTOMER.  DOING SO
REM COULD CAUSE INTERNAL ERRORS AND SECURITY VIOLATIONS IN THE
REM RDBMS.  SPECIFICALLY, THE PSD* ROUTINES MUST NOT BE CALLED
REM DIRECTLY BY ANY CLIENT AND MUST REMAIN PRIVATE TO THE PACKAGE BODY.
REM ********************************************************************

create or replace package body dbms_pipe is
  argbuf    char(4096) := 'a';  -- must be 'char' to get preallocated space
                                -- and must be assigned something in order
                                -- to be non-null
  packpos   binary_integer := 0;
  unpackpos binary_integer := 2000000000; -- i.e., no more data

  procedure sendpipe(pipename in varchar2, pos in binary_integer,
        buffer in out char, maxpipesize in binary_integer,
        timeout in binary_integer, retval out binary_integer);
    pragma interface (C, sendpipe);                         -- 1 (see psdicd.c)
  procedure receivepipe(pipename in varchar2, buffer in out char,
      timeout in binary_integer, retval out binary_integer);
    pragma interface (C, receivepipe);                      -- 2 (see psdicd.c)
  
  procedure copyintobuf(a in varchar2, pos in out binary_integer,
      buf in out char);
    pragma interface (C, copyintobuf);                      -- 3 (see psdicd.c)
  procedure copyintobuf(a in number, pos in out binary_integer, 
      buf in out char);
    pragma interface (C, copyintobuf);                      -- 4 (see psdicd.c)
  procedure copyintobuf(a in date, pos in out binary_integer, 
      buf in out char);
    pragma interface (C, copyintobuf);                      -- 5 (see psdicd.c)

  procedure copyfrombuf(a out varchar2, pos in out binary_integer, 
      buf in char);
    pragma interface (C, copyfrombuf);                      -- 6 (see psdicd.c)
  procedure copyfrombuf(a out number, pos in out binary_integer, buf in char);
    pragma interface (C, copyfrombuf);                      -- 7 (see psdicd.c)
  procedure copyfrombuf(a out date, pos in out binary_integer, buf in char);
    pragma interface (C, copyfrombuf);                      -- 8 (see psdicd.c)

  function gettypefrombuf(pos in binary_integer, buf in char) 
      return binary_integer;
    pragma interface (C, gettypefrombuf);                   -- 9 (see psdicd.c)

  procedure copyintobufbinary(a in raw, pos in out binary_integer,
      buf in out char);
    pragma interface (C, copyintobufbinary);               -- 10 (see psdicd.c)
  procedure copyintobufrowid(a in rowid, pos in out binary_integer,
      buf in out char);
    pragma interface (C, copyintobufrowid);                -- 11 (see psdicd.c)

  procedure copyfrombufbinary(a out raw , pos in out binary_integer, 
      buf in char);
    pragma interface (C, copyfrombufbinary);                -- 12 (see psdicd.c)
  procedure copyfrombufrowid(a out rowid, pos in out binary_integer, 
      buf in char);
    pragma interface (C, copyfrombufrowid);                 -- 13 (see psdicd.c)

  procedure pack_message(item in varchar2) is 
    begin copyintobuf(item, packpos, argbuf); end;
  procedure pack_message_raw(item in raw) is 
    begin copyintobufbinary(item, packpos, argbuf); end;
  procedure pack_message_rowid(item in rowid) is 
    begin copyintobufrowid(item, packpos, argbuf); end;
  procedure pack_message(item in number) is 
    begin copyintobuf(item, packpos, argbuf); end;
  procedure pack_message(item in date) is 
    begin copyintobuf(item, packpos, argbuf); end;

  procedure unpack_message(item out varchar2) is
    begin copyfrombuf(item, unpackpos, argbuf); end;
  procedure unpack_message_raw(item out raw) is
    begin copyfrombufbinary(item, unpackpos, argbuf); end;
  procedure unpack_message_rowid(item out rowid) is
    begin copyfrombufrowid(item, unpackpos, argbuf); end;
  procedure unpack_message(item out number) is 
    begin copyfrombuf(item, unpackpos, argbuf); end;
  procedure unpack_message(item out date) is 
    begin copyfrombuf(item, unpackpos, argbuf); end;

  function next_item_type return integer is
  internal_type binary_integer;
  begin
    internal_type :=  gettypefrombuf(unpackpos, argbuf);
    /* translate internal type code to declared external type code */
    if internal_type = 1 then
      return 9;
    elsif internal_type = 2 then
      return 6;
    else return internal_type;
    end if;
  end;

  function send_message(pipename in varchar2, 
                timeout in integer default maxwait,
                maxpipesize in integer default 8192)
      return integer is
    retval binary_integer;
    mps    binary_integer := maxpipesize;
    tmo    binary_integer := timeout;
  begin
    if pipename is null then
      raise_application_error(-20000, 'ORU-10026: Pipename may not be null');
    end if;
    sendpipe(upper(pipename), packpos, argbuf, mps, tmo, retval);
    if retval = 0 then
      packpos := 0;
    end if;
    return retval;
  end;

  function receive_message(pipename in varchar2,
                timeout in integer default maxwait)
      return integer is
    retval binary_integer;
    tmo    binary_integer := timeout;
  begin
    if pipename is null then
      raise_application_error(-20000, 'ORU-10026: Pipename may not be null');
    end if;
    receivepipe(upper(pipename), argbuf, tmo, retval);
    if retval = 0 then
      unpackpos := 0;
    else
      unpackpos := 2000000000;  -- i.e., no more data in pipe
    end if;
    return retval;
  end;

  procedure reset_buffer is
  begin
    unpackpos := 0; 
    packpos := 0; 
  end;

  procedure purge(pipename in varchar2) is
  begin
    loop
      if receive_message(pipename, 0) <> 0 then
        exit;
      end if;
    end loop;
  end;

  function unique_session_name return varchar2 is
  begin
    return ('ORA$PIPE$' || dbms_session.unique_session_id);
  end;
end;
/
