home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1996 February / PCWK0296.iso / po7_win / db / rdbms71 / prvtotpt.sql < prev    next >
Text File  |  1994-08-07  |  5KB  |  199 lines
  1. rem 
  2. rem $Header: prvtotpt.sql 7010300.1 94/02/24 18:23:39 snataraj Generic<base> $ 
  3. rem 
  4. Rem    NAME
  5. Rem      prvtotpt.sql - used by sql*dba 'set serveroutput on' cmd
  6. Rem    DESCRIPTION
  7. Rem    NOTES
  8. Rem      Private functions to be put into PL/SQL binary form.
  9. Rem      SQL*DBA and SQL*PLUS depend on this package.
  10. Rem    RETURNS
  11. Rem 
  12. Rem    MODIFIED   (MM/DD/YY)
  13. Rem     adowning   02/04/94 -  Branch_for_patch
  14. Rem     adowning   02/04/94 -  Creation
  15. Rem     adowning   02/02/94 -  split file into public / private binary files
  16. Rem     rkooi      04/20/93 -  merge changes from branch 1.8.312.1 
  17. Rem     rkooi      01/20/93 -  up default to 20000 
  18. Rem     rkooi      11/27/92 -  change error handling overflow case 
  19. Rem     rkooi      10/09/92 -  add some comments 
  20. Rem     rkooi      10/08/92 -  change newline to new_line 
  21. Rem     rkooi      09/29/92 -  more comments 
  22. Rem     rkooi      09/28/92 -  change some comments 
  23. Rem     rkooi      09/26/92 -  Creation 
  24.  
  25. Rem This script must be run as user SYS.
  26.  
  27. create or replace package body dbms_output as
  28.   enabled         boolean        := FALSE;
  29.   buf_size        binary_integer;
  30.   tmpbuf          varchar2(500)  := '';
  31.   putidx          binary_integer := 1;
  32.   amtleft         binary_integer := 0;
  33.   getidx          binary_integer := 2;
  34.   getpos          binary_integer := 1;
  35.   get_in_progress boolean := TRUE;
  36.   type            char_arr is table of varchar2(512) index by binary_integer;
  37.   buf             char_arr;
  38.   idxlimit        binary_integer;
  39.  
  40.   procedure enable (buffer_size in integer default 20000) is
  41.     lstatus integer;
  42.     lockid  integer;
  43.   begin
  44.     enabled := TRUE;
  45.     if buffer_size < 2000 then
  46.       buf_size := 2000;
  47.     elsif buffer_size > 1000000 then
  48.       buf_size := 1000000;
  49.     else
  50.       buf_size := buffer_size;
  51.     end if;
  52.     idxlimit := trunc((buf_size+499) / 500);
  53.   end;
  54.  
  55.   procedure disable is
  56.   begin
  57.     enabled := FALSE;
  58.   end;
  59.  
  60.   procedure put(a varchar2) is
  61.   begin
  62.     if enabled then
  63.       tmpbuf := tmpbuf || a;
  64.     end if;
  65.   end;
  66.  
  67.   procedure put(a number) is
  68.   begin
  69.     if enabled then
  70.       tmpbuf := tmpbuf || to_char(a);
  71.     end if;
  72.   end;
  73.  
  74.   procedure put(a date) is
  75.   begin
  76.     if enabled then
  77.       tmpbuf := tmpbuf || to_char(a);
  78.     end if;
  79.   end;
  80.  
  81.   procedure put_line(a varchar2) is
  82.   begin
  83.     if enabled then
  84.       tmpbuf := tmpbuf || a;
  85.       new_line;
  86.     end if;
  87.   end;
  88.  
  89.   procedure put_line(a number) is
  90.   begin
  91.     if enabled then
  92.       tmpbuf := tmpbuf || to_char(a);
  93.       new_line;
  94.     end if;
  95.   end;
  96.  
  97.   procedure put_line(a date) is
  98.   begin
  99.     if enabled then
  100.       tmpbuf := tmpbuf || to_char(a);
  101.       new_line;
  102.     end if;
  103.   end;
  104.  
  105.   procedure new_line is
  106.     strlen  binary_integer;
  107.   begin
  108.     if enabled then
  109.       if get_in_progress then
  110.         get_in_progress := FALSE;
  111.         putidx := 1;
  112.         amtleft := 500;
  113.         buf(putidx) := '';
  114.       end if;
  115.  
  116.       strlen := lengthb(tmpbuf);
  117.       if strlen > 255 then
  118.         tmpbuf := '';
  119.         raise_application_error(-20000, 'ORU-10028: line length overflow, ' ||
  120.           'limit of 255 bytes per line');
  121.       end if;
  122.  
  123.       if strlen > amtleft then
  124.         if putidx >= idxlimit then
  125.           tmpbuf := '';
  126.           raise_application_error(-20000, 'ORU-10027: buffer overflow, ' ||
  127.             'limit of ' || to_char(buf_size) || ' bytes');
  128.         end if;
  129.  
  130.         buf(putidx) := buf(putidx) || '  -1';
  131.         putidx := putidx + 1;
  132.         amtleft := 500;
  133.         buf(putidx) := '';
  134.       end if;
  135.       
  136.       buf(putidx) := buf(putidx) || to_char(strlen,'999') || tmpbuf;
  137.       amtleft := amtleft - strlen - 4;
  138.       tmpbuf := '';
  139.     end if;
  140.   end;
  141.  
  142.   procedure get_line(line out varchar2, status out integer) is
  143.     strlen   binary_integer;
  144.   begin
  145.     if not enabled then
  146.       status := 1;
  147.       return;
  148.     end if;
  149.  
  150.     if not get_in_progress then
  151.       -- terminate last line
  152.       buf(putidx) := buf(putidx) || '  -1';
  153.       putidx := putidx + 1;
  154.       get_in_progress := TRUE;
  155.       -- initialize for reading
  156.       getidx := 1;
  157.       getpos := 1;
  158.       tmpbuf := '';  -- don't leave any leftovers
  159.     end if;
  160.  
  161.     while getidx < putidx loop
  162.       strlen := to_number(substrb(buf(getidx),getpos,4)); --**--
  163.       if strlen >= 0 then
  164.         line := substrb(buf(getidx), getpos+4, strlen);
  165.         getpos := getpos + strlen + 4;
  166.         status := 0;
  167.         return;
  168.       else
  169.         getidx := getidx + 1;
  170.         getpos := 1;
  171.       end if;
  172.     end loop;
  173.     status := 1;
  174.     return;
  175.   end;
  176.  
  177.   procedure get_lines(lines out chararr, numlines in out integer) is
  178.     linecnt integer := 1;
  179.     s       integer;
  180.   begin
  181.     if not enabled then
  182.       numlines := 0;
  183.       return;
  184.     end if;
  185.     while linecnt <= numlines loop
  186.       get_line(lines(linecnt), s);
  187.       if s = 1 then            -- no more data
  188.         numlines := linecnt - 1;
  189.         return;
  190.       end if;
  191.       linecnt := linecnt + 1;        -- successfully got a line
  192.     end loop;
  193.     numlines := linecnt - 1;
  194.     return;
  195.   end;
  196.  
  197. end;
  198. /
  199.