home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 6 / IOPROG_06.ISO / trial / pb / server / pbor7cat.sql < prev    next >
Encoding:
Text File  |  1993-11-30  |  4.5 KB  |  171 lines
  1. create or replace package pbdbms as
  2.   procedure disable;
  3.   procedure put(a varchar2);
  4.   procedure put(a number);
  5.   procedure put(a date);
  6.   procedure put_line(a varchar2);
  7.   procedure put_line(a number);
  8.   procedure put_line(a date);
  9.   procedure new_line;
  10.   procedure get_line(line out varchar2, status out integer);
  11.   type chararr is table of varchar2(255) index by binary_integer;
  12.   procedure get_lines(lines out chararr, numlines in out integer);
  13. end; 
  14.  `
  15. create or replace package body pbdbms as
  16.   enabled         boolean        := TRUE;
  17.   buf_size        binary_integer;
  18.   tmpbuf          varchar2(500)  := '';
  19.   putidx          binary_integer := 1;
  20.   amtleft         binary_integer := 0;
  21.   getidx          binary_integer := 2;
  22.   getpos          binary_integer := 1;
  23.   get_in_progress boolean := TRUE;
  24.   type            char_arr is table of varchar2(512) index by binary_integer;
  25.   buf             char_arr;
  26.   idxlimit        binary_integer;
  27.   procedure enable (buffer_size in integer default 20000) is
  28.     lstatus integer;
  29.     lockid  integer;
  30.   begin
  31.     enabled := TRUE;
  32.     if buffer_size < 2000 then
  33.       buf_size := 2000;
  34.     elsif buffer_size > 1000000 then
  35.       buf_size := 1000000;
  36.     else
  37.       buf_size := buffer_size;
  38.     end if;
  39.     idxlimit := trunc((buf_size+499) / 500);
  40.   end;
  41.   procedure disable is
  42.   begin
  43.     enabled := FALSE;
  44.   end;
  45.   procedure put(a varchar2) is
  46.   begin
  47.     if enabled then
  48.       tmpbuf := tmpbuf || a;
  49.     end if;
  50.   end;
  51.   procedure put(a number) is
  52.   begin
  53.     if enabled then
  54.       tmpbuf := tmpbuf || to_char(a);
  55.     end if;
  56.   end;
  57.   procedure put(a date) is
  58.   begin
  59.     if enabled then
  60.       tmpbuf := tmpbuf || to_char(a);
  61.     end if;
  62.   end;
  63.   procedure put_line(a varchar2) is
  64.   begin
  65.     if enabled then
  66.       tmpbuf := tmpbuf || a;
  67.       new_line;
  68.     end if;
  69.   end;
  70.   procedure put_line(a number) is
  71.   begin
  72.     if enabled then
  73.       tmpbuf := tmpbuf || to_char(a);
  74.       new_line;
  75.     end if;
  76.   end;
  77.   procedure put_line(a date) is
  78.   begin
  79.     if enabled then
  80.       tmpbuf := tmpbuf || to_char(a);
  81.       new_line;
  82.     end if;
  83.   end;
  84.   procedure new_line is
  85.     strlen  binary_integer;
  86.   begin
  87.     if enabled then
  88.       if get_in_progress then
  89.         get_in_progress := FALSE;
  90.         putidx := 1;
  91.         amtleft := 500;
  92.         buf(putidx) := '';
  93.       end if;
  94.       strlen := lengthb(tmpbuf);
  95.       if strlen > 255 then
  96.         tmpbuf := '';
  97.         raise_application_error(-20000, 'ORU-10028: line length overflow, ' ||
  98.           'limit of 255 bytes per line');
  99.       end if;
  100.       if strlen > amtleft then
  101.         if putidx >= idxlimit then
  102.           tmpbuf := '';
  103.           raise_application_error(-20000, 'ORU-10027: buffer overflow, ' ||
  104.             'limit of ' || to_char(buf_size) || ' bytes');
  105.         end if;
  106.         buf(putidx) := buf(putidx) || '  -1';
  107.         putidx := putidx + 1;
  108.         amtleft := 500;
  109.         buf(putidx) := '';
  110.       end if;
  111.       
  112.       buf(putidx) := buf(putidx) || to_char(strlen,'999') || tmpbuf;
  113.       amtleft := amtleft - strlen - 4;
  114.       tmpbuf := '';
  115.     end if;
  116.   end;
  117.   procedure get_line(line out varchar2, status out integer) is
  118.     strlen   binary_integer;
  119.   begin
  120.     if not enabled then
  121.       status := 1;
  122.       return;
  123.     end if;
  124.     if not get_in_progress then
  125.       buf(putidx) := buf(putidx) || '  -1';
  126.       putidx := putidx + 1;
  127.       get_in_progress := TRUE;
  128.       getidx := 1;
  129.       getpos := 1;
  130.       tmpbuf := '';  
  131.     end if;
  132.     while getidx < putidx loop
  133.       strlen := to_number(substrb(buf(getidx),getpos,4)); 
  134.       if strlen >= 0 then
  135.         line := substrb(buf(getidx), getpos+4, strlen);
  136.         getpos := getpos + strlen + 4;
  137.         status := 0;
  138.         return;
  139.       else
  140.         getidx := getidx + 1;
  141.         getpos := 1;
  142.       end if;
  143.     end loop;
  144.     status := 1;
  145.     return;
  146.   end;
  147.   procedure get_lines(lines out chararr, numlines in out integer) is
  148.     linecnt integer := 1;
  149.     s       integer;
  150.   begin
  151.     if not enabled then
  152.       numlines := 0;
  153.       return;
  154.     end if;
  155.     while linecnt <= numlines loop
  156.       get_line(lines(linecnt), s);
  157.       if s = 1 then                     
  158.         numlines := linecnt - 1;
  159.         return;
  160.       end if;
  161.       linecnt := linecnt + 1;           
  162.     end loop;
  163.     numlines := linecnt - 1;
  164.     return;
  165.   end;
  166. end;
  167. `
  168. drop public synonym pbdbms `
  169. create public synonym pbdbms for pbdbms `
  170. grant execute on pbdbms to public `
  171.