home *** CD-ROM | disk | FTP | other *** search
/ Winzipper / Winzipper_ISO.iso / programming / oracle7 7.2 / DB / UTIL72 / PRVTPIPE.SQL < prev    next >
Encoding:
Text File  |  1995-05-09  |  9.1 KB  |  233 lines
  1. rem 
  2. rem $Header: prvtpipe.sql 7020100.1 94/09/23 22:13:37 cli Generic<base> $ 
  3. rem 
  4. Rem
  5. Rem    NAME
  6. Rem      prvtpipe.sql - send and receive from dbms "pipes"
  7. Rem    DESCRIPTION
  8. Rem      These are private functions to be released in PL/SQL binary form.
  9. Rem      Allow sessions to pass information between them through 
  10. Rem      named SGA memory "pipes"
  11. Rem    RETURNS
  12. Rem 
  13. Rem    NOTES
  14. Rem      The procedural option is needed to use this facility.
  15. Rem      
  16. Rem    MODIFIED   (MM/DD/YY)
  17. Rem     ajasuja    06/21/94 -  change purge back to procedure
  18. Rem     ajasuja    06/09/94 -  secure pipes
  19. Rem     wmaimone   04/08/94 -  merge changes from branch 1.1.710.2
  20. Rem     adowning   03/29/94 -  merge changes from branch 1.1.710.1
  21. Rem     wmaimone   02/22/94 -  use create or replace
  22. Rem     adowning   02/04/94 -  Branch_for_patch
  23. Rem     adowning   02/04/94 -  Creation
  24. Rem     adowning   02/02/94 -  split file into public / private binary files
  25. Rem     dsdaniel   07/09/93 -  dbms_defer longifaction for async rep
  26. Rem     rkooi      10/18/92 -  better comments 
  27. Rem     rkooi      08/20/92 -  comments and cleanup 
  28. Rem     rkooi      05/18/92 -  change comment 
  29. Rem     rkooi      04/28/92 -  change put to pack, etc. 
  30. Rem     rkooi      04/25/92 -  Creation 
  31.  
  32. REM ********************************************************************
  33. REM THIS PACKAGE MUST NOT BE MODIFIED BY THE CUSTOMER.  DOING SO
  34. REM COULD CAUSE INTERNAL ERRORS AND SECURITY VIOLATIONS IN THE
  35. REM RDBMS.  SPECIFICALLY, THE PSD IN KKXP ROUTINES MUST NOT BE CALLED
  36. REM DIRECTLY BY ANY CLIENT AND MUST REMAIN PRIVATE TO THE PACKAGE BODY.
  37. REM ********************************************************************
  38.  
  39. create or replace package body dbms_pipe is
  40.   argbuf    char(4096) := 'a';  -- must be 'char' to get preallocated space
  41.                                 -- and must be assigned something in order
  42.                                 -- to be non-null
  43.   packpos   binary_integer := 0;
  44.   unpackpos binary_integer := 2000000000; -- i.e., no more data
  45.  
  46.   procedure sendpipe(pipename in varchar2, pos in binary_integer,
  47.         buffer in out char, maxpipesize in binary_integer,
  48.         timeout in binary_integer, retval out binary_integer);
  49.     pragma interface (C, sendpipe);                         -- 1   (see kkxp.c)
  50.   procedure receivepipe(pipename in varchar2, buffer in out char,
  51.       timeout in binary_integer, retval out binary_integer);
  52.     pragma interface (C, receivepipe);                      -- 2   (see kkxp.c)
  53.   
  54.   procedure copyintobuf(a in varchar2, pos in out binary_integer,
  55.       buf in out char);
  56.     pragma interface (C, copyintobuf);                      -- 3   (see kkxp.c)
  57.   procedure copyintobuf(a in number, pos in out binary_integer, 
  58.       buf in out char);
  59.     pragma interface (C, copyintobuf);                      -- 4   (see kkxp.c)
  60.   procedure copyintobuf(a in date, pos in out binary_integer, 
  61.       buf in out char);
  62.     pragma interface (C, copyintobuf);                      -- 5   (see kkxp.c)
  63.  
  64.   procedure copyfrombuf(a out varchar2, pos in out binary_integer, 
  65.       buf in char);
  66.     pragma interface (C, copyfrombuf);                      -- 6   (see kkxp.c)
  67.   procedure copyfrombuf(a out number, pos in out binary_integer, buf in char);
  68.     pragma interface (C, copyfrombuf);                      -- 7   (see kkxp.c)
  69.   procedure copyfrombuf(a out date, pos in out binary_integer, buf in char);
  70.     pragma interface (C, copyfrombuf);                      -- 8   (see kkxp.c)
  71.  
  72.   function gettypefrombuf(pos in binary_integer, buf in char) 
  73.       return binary_integer;
  74.     pragma interface (C, gettypefrombuf);                   -- 9   (see kkxp.c)
  75.  
  76.   procedure copyintobufbinary(a in raw, pos in out binary_integer,
  77.       buf in out char);
  78.     pragma interface (C, copyintobufbinary);               -- 10   (see kkxp.c)
  79.   procedure copyintobufrowid(a in rowid, pos in out binary_integer,
  80.       buf in out char);
  81.     pragma interface (C, copyintobufrowid);                -- 11   (see kkxp.c)
  82.  
  83.   procedure copyfrombufbinary(a out raw , pos in out binary_integer, 
  84.       buf in char);
  85.     pragma interface (C, copyfrombufbinary);               -- 12   (see kkxp.c)
  86.   procedure copyfrombufrowid(a out rowid, pos in out binary_integer, 
  87.       buf in char);
  88.     pragma interface (C, copyfrombufrowid);                -- 13   (see kkxp.c)
  89.  
  90.   procedure createpipe(pipename in varchar2, maxpipesize in binary_integer,
  91.       private in boolean, retval out binary_integer);
  92.     pragma interface (C, createpipe);                      -- 14   (see kkxp.c)
  93.   procedure removepipe(pipename in varchar2, retval out binary_integer);
  94.     pragma interface (C, removepipe);                      -- 15   (see kkxp.c)
  95.  
  96.  
  97.   procedure pack_message(item in varchar2) is 
  98.     begin copyintobuf(item, packpos, argbuf); end;
  99.   procedure pack_message_raw(item in raw) is 
  100.     begin copyintobufbinary(item, packpos, argbuf); end;
  101.   procedure pack_message_rowid(item in rowid) is 
  102.     begin copyintobufrowid(item, packpos, argbuf); end;
  103.   procedure pack_message(item in number) is 
  104.     begin copyintobuf(item, packpos, argbuf); end;
  105.   procedure pack_message(item in date) is 
  106.     begin copyintobuf(item, packpos, argbuf); end;
  107.  
  108.   procedure unpack_message(item out varchar2) is
  109.     begin copyfrombuf(item, unpackpos, argbuf); end;
  110.   procedure unpack_message_raw(item out raw) is
  111.     begin copyfrombufbinary(item, unpackpos, argbuf); end;
  112.   procedure unpack_message_rowid(item out rowid) is
  113.     begin copyfrombufrowid(item, unpackpos, argbuf); end;
  114.   procedure unpack_message(item out number) is 
  115.     begin copyfrombuf(item, unpackpos, argbuf); end;
  116.   procedure unpack_message(item out date) is 
  117.     begin copyfrombuf(item, unpackpos, argbuf); end;
  118.  
  119.   function next_item_type return integer is
  120.   internal_type binary_integer;
  121.   begin
  122.     internal_type :=  gettypefrombuf(unpackpos, argbuf);
  123.     /* translate internal type code to declared external type code */
  124.     if internal_type = 1 then
  125.       return 9;
  126.     elsif internal_type = 2 then
  127.       return 6;
  128.     else return internal_type;
  129.     end if;
  130.   end;
  131.  
  132.   function create_pipe(pipename in varchar2,
  133.                 maxpipesize in integer default 8192,
  134.                 private in boolean default TRUE)
  135.       return integer is
  136.     retval binary_integer;
  137.     mps    binary_integer := maxpipesize;
  138.     pvt    boolean := private;
  139.   begin
  140.     if pipename is null then
  141.       dbms_sys_error.raise_system_error(-23321, 'Pipename may not be null');
  142.     end if;
  143.     createpipe(upper(pipename), mps, pvt, retval);
  144.     if retval = 4 then                                         -- private pipe
  145.       dbms_sys_error.raise_system_error(-23322,
  146.         'Insufficient privilege to access pipe');
  147.     end if;
  148.     return retval;
  149.   end;
  150.  
  151.   function remove_pipe(pipename in varchar2)
  152.       return integer is
  153.     retval binary_integer;
  154.   begin
  155.     if pipename is null then
  156.       dbms_sys_error.raise_system_error(-23321, 'Pipename may not be null');
  157.     end if;
  158.     removepipe(upper(pipename), retval);
  159.     if retval = 4 then                                         -- private pipe
  160.       dbms_sys_error.raise_system_error(-23322,
  161.         'Insufficient privilege to access pipe');
  162.     end if;
  163.     return retval;
  164.   end;
  165.  
  166.   function send_message(pipename in varchar2, 
  167.                 timeout in integer default maxwait,
  168.                 maxpipesize in integer default 8192)
  169.       return integer is
  170.     retval binary_integer;
  171.     mps    binary_integer := maxpipesize;
  172.     tmo    binary_integer := timeout;
  173.   begin
  174.     if pipename is null then
  175.       dbms_sys_error.raise_system_error(-23321, 'Pipename may not be null');
  176.     end if;
  177.     sendpipe(upper(pipename), packpos, argbuf, mps, tmo, retval);
  178.     if retval = 0 then
  179.       packpos := 0;
  180.     end if;
  181.     if retval = 4 then                                         -- private pipe
  182.       dbms_sys_error.raise_system_error(-23322,
  183.         'Insufficient privilege to access pipe');
  184.     end if;
  185.     return retval;
  186.   end;
  187.  
  188.   function receive_message(pipename in varchar2,
  189.                 timeout in integer default maxwait)
  190.       return integer is
  191.     retval binary_integer;
  192.     tmo    binary_integer := timeout;
  193.   begin
  194.     if pipename is null then
  195.       dbms_sys_error.raise_system_error(-23321, 'Pipename may not be null');
  196.     end if;
  197.     receivepipe(upper(pipename), argbuf, tmo, retval);
  198.     if retval = 0 then
  199.       unpackpos := 0;
  200.     else
  201.       unpackpos := 2000000000;  -- i.e., no more data in pipe
  202.     end if;
  203.     if retval = 4 then                                         -- private pipe
  204.       dbms_sys_error.raise_system_error(-23322,
  205.         'Insufficient privilege to access pipe');
  206.     end if;
  207.     return retval;
  208.   end;
  209.  
  210.   procedure reset_buffer is
  211.   begin
  212.     unpackpos := 0; 
  213.     packpos := 0; 
  214.   end;
  215.  
  216.   procedure purge(pipename in varchar2) is
  217.     retval binary_integer;
  218.   begin
  219.     loop
  220.       retval := receive_message(pipename, 0);
  221.       if retval <> 0 then
  222.         exit;
  223.       end if;
  224.     end loop;
  225.   end;
  226.  
  227.   function unique_session_name return varchar2 is
  228.   begin
  229.     return ('ORA$PIPE$' || dbms_session.unique_session_id);
  230.   end;
  231. end;
  232. /
  233.