Winzipper/Winzipper_ISO.iso/programming/oracle7 7.2/DB/UTIL72/PRVTOTPT.SQL

Text File | 1995-05-09 | 5.1 KB | 199 lines

rem
rem $Header: prvtotpt.sql 7020100.1 94/09/23 22:13:40 cli Generic<base> $
rem
Rem    NAME
Rem      prvtotpt.sql - used by sql*dba 'set serveroutput on' cmd
Rem    DESCRIPTION
Rem    NOTES
Rem      Private functions to be put into PL/SQL binary form.
Rem      SQL*DBA and SQL*PLUS depend on this package.
Rem    RETURNS
Rem
Rem    MODIFIED   (MM/DD/YY)
Rem     adowning   03/29/94 -  merge changes from branch 1.1.710.1
Rem     adowning   02/04/94 -  Creation
Rem     adowning   02/02/94 -  split file into public / private binary files
Rem     rkooi      04/20/93 -  merge changes from branch 1.8.312.1
Rem     rkooi      01/20/93 -  up default to 20000
Rem     rkooi      11/27/92 -  change error handling overflow case
Rem     rkooi      10/09/92 -  add some comments
Rem     rkooi      10/08/92 -  change newline to new_line
Rem     rkooi      09/29/92 -  more comments
Rem     rkooi      09/28/92 -  change some comments
Rem     rkooi      09/26/92 -  Creation

Rem This script must be run as user SYS.

create or replace package body dbms_output as
  enabled         boolean        := FALSE;
  buf_size        binary_integer;
  tmpbuf          varchar2(500)  := '';
  putidx          binary_integer := 1;
  amtleft         binary_integer := 0;
  getidx          binary_integer := 2;
  getpos          binary_integer := 1;
  get_in_progress boolean := TRUE;
  type            char_arr is table of varchar2(512) index by binary_integer;
  buf             char_arr;
  idxlimit        binary_integer;

  procedure enable (buffer_size in integer default 20000) is
    lstatus integer;
    lockid  integer;
  begin
    enabled := TRUE;
    if buffer_size < 2000 then
      buf_size := 2000;
    elsif buffer_size > 1000000 then
      buf_size := 1000000;
    else
      buf_size := buffer_size;
    end if;
    idxlimit := trunc((buf_size+499) / 500);
  end;

  procedure disable is
  begin
    enabled := FALSE;
  end;

  procedure put(a varchar2) is
  begin
    if enabled then
      tmpbuf := tmpbuf || a;
    end if;
  end;

  procedure put(a number) is
  begin
    if enabled then
      tmpbuf := tmpbuf || to_char(a);
    end if;
  end;

  procedure put(a date) is
  begin
    if enabled then
      tmpbuf := tmpbuf || to_char(a);
    end if;
  end;

  procedure put_line(a varchar2) is
  begin
    if enabled then
      tmpbuf := tmpbuf || a;
      new_line;
    end if;
  end;

  procedure put_line(a number) is
  begin
    if enabled then
      tmpbuf := tmpbuf || to_char(a);
      new_line;
    end if;
  end;

  procedure put_line(a date) is
  begin
    if enabled then
      tmpbuf := tmpbuf || to_char(a);
      new_line;
    end if;
  end;

  procedure new_line is
    strlen  binary_integer;
  begin
    if enabled then
      if get_in_progress then
        get_in_progress := FALSE;
        putidx := 1;
        amtleft := 500;
        buf(putidx) := '';
      end if;

      strlen := lengthb(tmpbuf);
      if strlen > 255 then
        tmpbuf := '';
        raise_application_error(-20000, 'ORU-10028: line length overflow, ' ||
          'limit of 255 bytes per line');
      end if;

      if strlen > amtleft then
        if putidx >= idxlimit then
          tmpbuf := '';
          raise_application_error(-20000, 'ORU-10027: buffer overflow, ' ||
            'limit of ' || to_char(buf_size) || ' bytes');
        end if;

        buf(putidx) := buf(putidx) || '  -1';
        putidx := putidx + 1;
        amtleft := 500;
        buf(putidx) := '';
      end if;

      buf(putidx) := buf(putidx) || to_char(strlen,'999') || tmpbuf;
      amtleft := amtleft - strlen - 4;
      tmpbuf := '';
    end if;
  end;

  procedure get_line(line out varchar2, status out integer) is
    strlen   binary_integer;
  begin
    if not enabled then
      status := 1;
      return;
    end if;

    if not get_in_progress then
      -- terminate last line
      buf(putidx) := buf(putidx) || '  -1';
      putidx := putidx + 1;
      get_in_progress := TRUE;
      -- initialize for reading
      getidx := 1;
      getpos := 1;
      tmpbuf := '';  -- don't leave any leftovers
    end if;

    while getidx < putidx loop
      strlen := to_number(substrb(buf(getidx),getpos,4)); --**--
      if strlen >= 0 then
        line := substrb(buf(getidx), getpos+4, strlen);
        getpos := getpos + strlen + 4;
        status := 0;
        return;
      else
        getidx := getidx + 1;
        getpos := 1;
      end if;
    end loop;
    status := 1;
    return;
  end;

  procedure get_lines(lines out chararr, numlines in out integer) is
    linecnt integer := 1;
    s       integer;
  begin
    if not enabled then
      numlines := 0;
      return;
    end if;
    while linecnt <= numlines loop
      get_line(lines(linecnt), s);
      if s = 1 then            -- no more data
        numlines := linecnt - 1;
        return;
      end if;
      linecnt := linecnt + 1;        -- successfully got a line
    end loop;
    numlines := linecnt - 1;
    return;
  end;

end;
/