rem
rem
Rem  Copyright (c) 1995, 1996, 1997 by Oracle Corporation. All rights reserved.
Rem    NAME
Rem      privpat.sql
Rem    DESCRIPTION
Rem      This file contains one package:
Rem         owa_pattern - Utitility procedures/functions for matching 
Rem                       and changing values in text strings.
Rem
Rem    NOTES
Rem      This packages is dependent on the package OWA_TEXT.
Rem
Rem    MODIFIED   (MM/DD/YY)
Rem     rdasarat   03/04/98 -  Fix bug# 611104
Rem     mpal       03/19/97 -  Fix bug# 466482 - changed char(1) to varchar2(5)
Rem                                              5 is chosen because the max number of
Rem                                              bytes per Oracle's NLS charset is 5
Rem     mbookman   11/29/95 -  Creation

create or replace package body OWA_PATTERN is

   subtype substitution is pattern;

   -- MAX_VC_LEN constant number := 32767;
   -- PL/SQL doesn't allow one to use constant values in variable declarations,
   -- like 'vc varchar2(MAX_VC_LEN), so this is really just here as a reminder
   -- to always use value(MAX_VC_LEN) for declarations.

   BOL         constant varchar2(1) := '^';
   EOL         constant varchar2(1) := '$';
   CCL         constant varchar2(1) := '[';
   CCLEND      constant varchar2(1) := ']';
   QUANT       constant varchar2(1) := '{';
   QUANTEND    constant varchar2(1) := '}';
   BR          constant varchar2(1) := '(';
   BREND       constant varchar2(1) := ')';
   ANY_CHAR    constant varchar2(1) := '.';
   ESCAPE      constant varchar2(1) := '\';
   DASH        constant varchar2(1) := '-';
   NOT_CHAR    constant varchar2(1) := '^';
   CLOSURE     constant varchar2(1) := '*';
   ONE_OR_MORE constant varchar2(1) := '+';
   ZERO_OR_ONE constant varchar2(1) := '?';

   AMP       constant varchar2(1) := '&';

   /* The following line should be broken to represent a NEWLINE */
   NEWLINE constant varchar2(1) := '
';
   /* The following character is a true "tab" */
   TAB     constant varchar2(1) := '	';
   SPACE   constant varchar2(1) := ' ';

   NCCL      constant varchar2(4) := 'NCCL';
   CHARCHAR  constant varchar2(4) := 'CHAR';
   DITTO     constant varchar2(4) := 'DTTO';
   BREF      constant varchar2(4) := 'BREF';
   EOP       constant varchar2(4) := 'EOP';

   CLOSIZE constant integer := 6;
   BRSIZE  constant integer := 4;

   DIGITS constant VARCHAR2(10) := '0123456789';
   LOWLET constant VARCHAR2(26) := 'abcdefghijklmnopqrstuvwxyz';
   UPPLET constant VARCHAR2(26) := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
   UNDERBAR constant VARCHAR2(1) := '_';

   WORD_CHARS  constant VARCHAR2(63) := DIGITS||LOWLET||UNDERBAR||UPPLET;
   SPACE_CHARS constant VARCHAR2(3)  := SPACE||TAB||NEWLINE;

   DIG_ESCAPE_CHAR       constant varchar2(1) := 'd'; -- [0-9]
   NON_DIG_ESCAPE_CHAR   constant varchar2(1) := 'D'; -- [^0-9]
   WORD_ESCAPE_CHAR      constant varchar2(1) := 'w'; -- [0-9a-z_A-Z]
   NON_WORD_ESCAPE_CHAR  constant varchar2(1) := 'W'; -- [^0-9a-z_A-Z]
   SPACE_ESCAPE_CHAR     constant varchar2(1) := 's'; -- [ \t\n]
   NON_SPACE_ESCAPE_CHAR constant varchar2(1) := 'S'; -- [^ \t\n]
   BOUND_ESCAPE_CHAR     constant varchar2(1) := 'b';
   NON_BOUND_ESCAPE_CHAR constant varchar2(1) := 'B';

   DIG_ESCAPE       constant varchar2(2) := ESCAPE||DIG_ESCAPE_CHAR;
   NON_DIG_ESCAPE   constant varchar2(2) := ESCAPE||NON_DIG_ESCAPE_CHAR;
   WORD_ESCAPE      constant varchar2(2) := ESCAPE||WORD_ESCAPE_CHAR;
   NON_WORD_ESCAPE  constant varchar2(2) := ESCAPE||NON_WORD_ESCAPE_CHAR;
   SPACE_ESCAPE     constant varchar2(2) := ESCAPE||SPACE_ESCAPE_CHAR;
   NON_SPACE_ESCAPE constant varchar2(2) := ESCAPE||NON_SPACE_ESCAPE_CHAR;
   BOUND_ESCAPE     constant varchar2(2) := ESCAPE||BOUND_ESCAPE_CHAR;
   NON_BOUND_ESCAPE constant varchar2(2) := ESCAPE||NON_BOUND_ESCAPE_CHAR;

   COUNT_IND  constant integer := 1;
   PREVCL_IND constant integer := 2;
   START_IND  constant integer := 3;
   MIN_IND    constant integer := 4;
   MAX_IND    constant integer := 5;

   PREVBR_IND  constant integer := 1;
   LOC_IND     constant integer := 2;
   BRNO_IND    constant integer := 3;
   OPENBR_IND  constant integer := 3;

   in_b boolean;

   function ind(str in varchar2, i in integer) return varchar2
      is
   begin
      return substr(str,i,1);
   end;

   function line_len(line in varchar2) return integer
      is
   begin
      if (line is null)
      then
         return 1;
      else
         return length(line);
      end if;
   end;

   function get_int(arg  in     varchar2,
                    loc  in out integer,
                    digs in     varchar2 DEFAULT DIGITS) return integer is
      start_loc integer;
   begin
      start_loc := loc;

      while (instr(digs, ind(arg,loc)) != 0)
      loop
         loc := loc + 1;
      end loop;

      return substr(arg, start_loc, loc-start_loc);
   end;

   function base_convert(str in varchar2, base in integer) return integer
     is
      acc integer;
      len integer;
   begin
      len := length(str);
      if (len is NULL)
      then
         return NULL;
      end if;

      acc := 0;
      for i in 1..len
      loop
         if (instr('abcdefABCDEF', ind(str,i)) != 0)
         then
            acc := acc*base + ascii(convert(lower(ind(str,i)), 'US7ASCII')) - 87;
         else
            acc := acc*base + ind(str,i);
	 end if;
      end loop;

      return acc;
   end;

   procedure addpat(ch in varchar2, pat in out pattern, j in out integer)
      is
   begin
      pat(j) := ch;
      j := j + 1;
   end;

   function patsize(pat in pattern, n in integer) return integer is
   begin
      if (pat(n) = CHARCHAR)
      then return 2;
      end if;
      if (pat(n) in (BOL, EOL, ANY_CHAR,
                     DIG_ESCAPE, NON_DIG_ESCAPE,
                     WORD_ESCAPE, NON_WORD_ESCAPE,
                     SPACE_ESCAPE, NON_SPACE_ESCAPE,
                     BOUND_ESCAPE, NON_BOUND_ESCAPE))
      then return 1;
      end if;
      if (pat(n) in (CCL, NCCL))
      then return pat(n+1) + 2;
      end if;
      if (pat(n) = CLOSURE)
      then return CLOSIZE;
      end if;
      if (pat(n) in (BR, BREND))
      then return BRSIZE;
      end if;

      raise_application_error(-20002,'in patsize: shouldn''t happen');
   end;

   procedure copypat(pat in out pattern,
                     j   in out integer,
                     loc in     integer) is
      pat_size integer;
      k    integer;
   begin
      pat_size := patsize(pat,loc);
      for k in loc..loc+pat_size-1
      loop
         addpat(pat(k), pat, j); 
      end loop;
   end;

   function esc(arg in varchar2, i in out integer) return varchar2
      is
      NL_ESCAPE  constant varchar2(1) := 'n';
      TAB_ESCAPE constant varchar2(1) := 't';

      arg_i varchar2(5); -- MAX NO OF BYTES FOR NLS CHARSET
   begin
      arg_i := ind(arg,i);
      if (arg_i != ESCAPE)
      then
         return arg_i;
      end if;

      if (i = length(arg))
      then
         return arg_i;
      end if;

      i := i+1;
      arg_i := ind(arg,i);
      if (arg_i = NL_ESCAPE)
      then
         return NEWLINE;
      end if;

      if (arg_i = TAB_ESCAPE)
      then
         return TAB;
      end if;

      return arg_i;
   end;

   procedure dodash(valid_chars in varchar2,
                    arg         in varchar2,
                    i           in out integer,
                    pat         in out pattern,
                    j           in out integer) is
      limit integer;
      k     integer;
   begin
      i := i + 1;
      j := j - 1;

      limit := instr(valid_chars, esc(arg,i));
      k := instr(valid_chars, pat(j));
      while (k <= limit)
      loop
         addpat(ind(valid_chars,k), pat, j);
         k := k+1;
      end loop;
   end;

   procedure filset(delim in     varchar2,
                    arg   in     varchar2,
                    i     in out integer,
                    pat   in out pattern,
                    j     in out integer) is
      arglen integer;
      ch     varchar2(5); -- MAX NO OF BYTES FOR NLS CHARSET
   begin
      arglen := length(arg);

      ch := ind(arg,i);
      while (ch != delim) AND (i <= arglen)
      loop
         if (ch = ESCAPE)
         then
            addpat(esc(arg,i), pat,j);
         else if (ch != DASH)
         then
            addpat(ch, pat, j);
         else if (j <= 1) OR (i+1 >= arglen)
         then
            addpat(DASH, pat, j);
         else if (instr(DIGITS,pat(j-1)) > 0)
         then
            dodash(DIGITS, arg, i, pat, j);
         else if (instr(LOWLET, pat(j-1)) > 0)
         then
            dodash(LOWLET, arg, i, pat, j);
         else if (instr(UPPLET, pat(j-1)) > 0)
         then
            dodash(UPPLET, arg, i, pat, j);
         else         
            addpat(DASH, pat, j);
         end if;
         end if;
         end if;
         end if;
         end if;
         end if;

         i := i + 1;
         ch := ind(arg,i);
      end loop;
   end;

   procedure getccl(arg in     varchar2,
                    i   in out integer,
                    pat in out pattern,
                    j   in out integer) is
      jstart integer;
   begin
      i := i + 1; -- Skip over the "["

      if (ind(arg,i) = NOT_CHAR)
      then
         addpat(NCCL, pat, j);
         i := i + 1;
      else
         addpat(CCL, pat, j);
      end if;

      jstart := j;
      addpat(0, pat, j);
      filset(CCLEND, arg, i, pat, j);
      pat(jstart) := j - jstart - 1;
      if (ind(arg,i) != CCLEND)
      then
         raise_application_error(-20000, 'Error in getccl');
      end if;
   end;

   -- stmin_max returns FALSE if a string beginning with a '{' is not
   -- a proper {n,m} quantifier
   function stmin_max(arg     in     varchar2,
                      i       in out integer,
                      min_val    out integer,
                      max_val    out integer) return boolean
     is
      COMMA constant varchar2(1) := ',';

      arg_i varchar2(5); -- MAX NO OF BYTES FOR NLS CHARSET
      i1    integer;
      i2    integer;

      min_v integer;
   begin
      arg_i := ind(arg,i);
      if (arg_i = CLOSURE)
      then
         min_val := 0;
         max_val := NULL;
      else if (arg_i = ONE_OR_MORE)
      then
         min_val := 1;
         max_val := NULL;
      else if (arg_i = ZERO_OR_ONE)
      then
         min_val := 0;
         max_val := 1;
      else if (arg_i = QUANT)
      then
         i1 := i + 1;
         i2 := i1;

         while (instr(DIGITS, ind(arg,i2)) != 0)
         loop
            i2 := i2 + 1;
         end loop;

         min_v := substr(arg, i1, i2-i1);
         if (min_v is null) then return FALSE; end if;

         if (ind(arg,i2) = QUANTEND)
         then
            max_val := min_v;
         else if (ind(arg,i2) = COMMA)
         then
            i1 := i2 + 1;
            i2 := i1;

            while (instr(DIGITS, ind(arg,i2)) != 0)
            loop
               i2 := i2 + 1;
            end loop;

            if (ind(arg,i2) = QUANTEND)
            then
               max_val := substr(arg, i1, i2-i1);
            else
               return FALSE;
            end if;
         else
            return FALSE;
         end if;
         end if;

         min_val := min_v;
         i := i2;
      else
         raise_application_error(-20001, 'In stmin_max: illegal pattern');
      end if;
      end if;
      end if;
      end if;

      return TRUE;
   end;

   function stclos(pat     in out pattern,
                   j       in out integer,
                   lastj   in out integer, 
                   lastcl  in     integer,
                   min_val in     integer,
                   max_val in     integer) return integer is
      jp         integer;
      jt         integer;
      return_val integer;
   begin
      for jp in REVERSE lastj..j-1 
      loop
         jt := jp + CLOSIZE;
         addpat(pat(jp), pat, jt);
      end loop;

      j := j + CLOSIZE;
      return_val := lastj;

      addpat(CLOSURE, pat, lastj);
      addpat(0,       pat, lastj);
      addpat(lastcl,  pat, lastj);
      addpat(0,       pat, lastj);
      addpat(min_val, pat, lastj);
      addpat(max_val, pat, lastj);

      return return_val;
   end;

   procedure stbr(brtype  in     varchar2,
                  pat     in out pattern,
                  j       in out integer,
                  lastbr  in out integer,
                  var     in out integer) is
      -- "var" will be either "brno" if we are on a "("
      --   or it will be "openbr" if we are on a ")"
   begin
      addpat(brtype, pat, j);
      addpat(lastbr, pat, j);
      addpat(0,      pat, j);

      -- var is "brno" increment it before inserting the value.
      if (brtype = BR)
      then
         var := var + 1;
      end if;

      addpat(var, pat, j);
      lastbr := j - BRSIZE;

      -- var is "openbr" - find the last unmatched openbr.
      if (brtype = BREND)
      then
         var := pat(var + PREVBR_IND);

         while (var > 0) AND (pat(var) != BR)
         loop
            var := pat(var + OPENBR_IND);
            var := pat(var + PREVBR_IND);
         end loop;
      end if;
   end;

   /* ESCPAT is an enhancement to Kernighan's algorithms.  It allows */
   /* more "short-cut" tags in the pattern, such as using '\d' for   */
   /* [0-9].  This is to extend the algorithms to support more of    */
   /* Perl's regular expression patterns.                            */
   procedure escpat(arg in     varchar2,
                    i   in out integer,
                    pat in out pattern,
                    j   in out integer) is
      HEXCHAR   constant varchar2(1) := 'x';
      HEXDIGITS constant varchar2(22) := DIGITS||'abcdefABCDEF';
      OCTDIGITS constant varchar2(8) := '01234567';
   begin
      if (ind(arg,i) != ESCAPE)
      then
         addpat(CHARCHAR, pat, j);
         addpat(ind(arg,i), pat, j);
      else if (ind(arg,i+1) in (DIG_ESCAPE_CHAR, NON_DIG_ESCAPE_CHAR,
                                WORD_ESCAPE_CHAR, NON_WORD_ESCAPE_CHAR,
                                SPACE_ESCAPE_CHAR, NON_SPACE_ESCAPE_CHAR,
                                BOUND_ESCAPE_CHAR, NON_BOUND_ESCAPE_CHAR))
      then
         addpat(ESCAPE||ind(arg,i+1), pat, j);
         i := i + 1;
      else if ((ind(arg,i+1) = HEXCHAR) AND
               (instr(HEXDIGITS, ind(arg,i+2)) != 0) AND
               (instr(HEXDIGITS, ind(arg,i+3)) != 0)
              )
      then
         addpat(CHARCHAR, pat, j);
         addpat(chr(base_convert(substr(arg,i+2,2), 16)), pat, j);
         i := i + 3;
      else if ((instr(OCTDIGITS, ind(arg,i+1)) != 0) AND
               (instr(OCTDIGITS, ind(arg,i+2)) != 0)
              )
      then
         if (instr(OCTDIGITS, ind(arg,i+3)) != 0)
         then
            addpat(CHARCHAR, pat, j);
            addpat(chr(base_convert(substr(arg,i+1,3), 8)), pat, j);
            i := i + 3;
         else
            addpat(CHARCHAR, pat, j);
            addpat(chr(base_convert(substr(arg,i+1,2), 8)), pat, j);
            i := i + 2;
         end if;
      else
         addpat(CHARCHAR, pat, j);
         addpat(esc(arg,i), pat, j);
      end if;
      end if;
      end if;
      end if;
   end;

   /* GETPAT is a merge of the "getpat" and "makpat" functions which */
   /* Kernighan details.  The additional level of abstraction which  */
   /* makpat provides is unnecessary in this implementation.         */
   procedure getpat(arg in varchar2, pat in out pattern) is
      arglen integer;

      i integer;
      j integer;

      lastcl integer;
      lastj  integer;
      lj     integer;

      lastbr integer;
      openbr integer;
      brno   integer;

      arg_i varchar2(5); -- MAX NO OF BYTES FOR NLS CHARSET

      min_val integer;
      max_val integer;
   begin
      arglen := length(arg);

      j := 1;
      lastj  := 1;
      lastcl := 0;
      lastbr := 0;
      openbr := 0;
      brno   := 0;

      i := 1;
      while (i <= arglen)
      loop
         lj := j;

         arg_i := ind(arg,i);
         if (arg_i = ANY_CHAR)
         then
            addpat(ANY_CHAR, pat, j);
         else if (arg_i = BOL) AND (i = 1)
         then
            addpat(BOL, pat, j);
         else if (arg_i = EOL) AND (i = arglen)
         then
            addpat(EOL, pat, j);
         else if (arg_i = CCL)
         then
            getccl(arg, i, pat, j);
         else if (arg_i in (CLOSURE, ZERO_OR_ONE,
                            ONE_OR_MORE, QUANT)) AND (i > 1)
         then
            lj := lastj;
            if (pat(lj) NOT in (BOL, EOL, CLOSURE, ZERO_OR_ONE,
                                          ONE_OR_MORE, QUANT))
            then
               if (stmin_max(arg, i, min_val, max_val))
               then
                  lastcl := stclos(pat, j, lastj, lastcl, min_val, max_val);
               else
                  escpat(arg, i, pat, j);
               end if;
            else
               raise_application_error(-20000,arg||': nested *?+ in regular expression');
            end if;
         else if (arg_i = BR)
         then
            openbr := j;
            stbr(BR, pat, j, lastbr, brno);
         else if (arg_i = BREND)
         then
            if (openbr = 0)
            then
               raise_application_error(-20000,arg||': unmatched () in regular expression');
            end if;

            stbr(BREND, pat, j, lastbr, openbr);
         else
            escpat(arg, i, pat, j);
         end if;
         end if;
         end if;
         end if;
         end if;
         end if;
         end if;

         lastj := lj;
         i := i+1;
      end loop;

      if (openbr != 0)
      then
         raise_application_error(-20000,arg||': unmatched () in regular expression');
      end if;

      addpat(EOP, pat, j);
   end;

   procedure printpat(pat in pattern) is
      i integer;
   begin
      i := 1;
      while pat(i) != EOP
      loop
         dbms_output.put_line('pat('||i||') = '||pat(i));
         i := i+1;
      end loop;
   end;

   /* LOCATE - Determine if character 'ch' is in the character class */
   /*          found at pat(offset).                                 */
   function locate(ch in varchar2, pat    in pattern,
                                   offset in integer) return boolean is
   begin
      -- Fix 611104
      --   pat(offset) has #of chars in character class
      for i in REVERSE (offset + 1)..offset+pat(offset) 
      loop
         if (ch = pat(i))
         then
            return TRUE;
         end if;
      end loop;

      return FALSE;
   end;

   function is_word_char(ch in varchar2) return boolean
     is
   begin
      return (instr (DIGITS||LOWLET||'_'||UPPLET, ch) != 0);
   end;

   function omatch(line  in     varchar2,
                   i     in out integer,
                   pat   in     pattern,
                   j     in     integer,
                   flags in     varchar2 DEFAULT NULL) return boolean is
      bump   integer;
      line_i varchar2(5); -- MAX NO OF BYTES FOR NLS CHARSET
      pat_j  varchar2(4);

      save_i integer;
   begin
      bump := -1;
      line_i := ind(line,i);
      pat_j  := pat(j);

      if (pat_j = CHARCHAR)
      then
         /* Here is a simple extension to add case-insensitive searches. */
         /* This is the easiest place to put this, although it may not   */
         /* be the most efficient location for it.                       */
         if /* (flags is not null) AND */ (instr(flags,'i') != 0)
         then
            if (lower(line_i) = lower(pat(j+1)))
            then
               bump := 1;
               in_b := FALSE;
            end if;
         else
            if (line_i = pat(j+1))
            then
               bump := 1;
               in_b := FALSE;
            end if;
         end if;
      else if (pat_j = BOL)
      then
         if ( (i = 1) OR (ind(line,i-1) = NEWLINE) )
         then
            bump := 0;
            in_b := FALSE;
         end if;
      else if (pat_j = ANY_CHAR)
      then
         if (line_i != NEWLINE)
         then
            bump := 1;
            in_b := FALSE;
         end if;
      else if (pat_j = EOL)
      then
         if (line_i = NEWLINE) OR (i > length(line))
         then
            bump := 0;
            in_b := FALSE;
         end if;
      else if (pat_j = BOUND_ESCAPE)
      then
         if ( i = 1 ) OR (i > length(line))
         then
            bump := 0;
            in_b := TRUE;
         else
         if ( ( is_word_char(line_i) AND
                NOT is_word_char(ind(line,i-1)) )
            OR
              ( is_word_char(ind(line,i-1)) AND
                NOT is_word_char(line_i) ) )
         then
            bump := 0;
            in_b := TRUE;
         end if;
         end if;
      else if (pat_j = DIG_ESCAPE)
      then
         if (instr(DIGITS, line_i) != 0)
         then
            bump := 1;
            in_b := FALSE;
         end if;
      else if (pat_j = NON_DIG_ESCAPE)
      then
         if (instr(DIGITS, line_i) = 0)
         then
            bump := 1;
            in_b := FALSE;
         end if;
      else if (pat_j = WORD_ESCAPE)
      then
         if (instr(WORD_CHARS, line_i) != 0)
         then
            bump := 1;
            in_b := FALSE;
         end if;
      else if (pat_j = NON_WORD_ESCAPE)
      then
         if (instr(WORD_CHARS, line_i) = 0)
         then
            bump := 1;
            in_b := FALSE;
         end if;
      else if (pat_j = SPACE_ESCAPE)
      then
         if (instr(SPACE_CHARS, line_i) != 0)
         then
            bump := 1;
            in_b := FALSE;
         end if;
      else if (pat_j = NON_SPACE_ESCAPE)
      then
         if (instr(SPACE_CHARS, line_i) = 0)
         then
            bump := 1;
            in_b := FALSE;
         end if;
      else if (pat_j = CCL)
      then
         if (locate(line_i, pat, j+1) = TRUE)
         then
            bump := 1;
            in_b := FALSE;
         end if;
      else if (pat_j = NCCL)
      then
         if (line_i != NEWLINE) AND (locate(line_i, pat, j+1) = FALSE)
         then
            bump :=1;
            in_b := FALSE;
         end if;
      else
         raise_application_error(-20001,'In omatch: illegal pattern found');
      end if;
      end if;
      end if;
      end if;
      end if;
      end if;
      end if;
      end if;
      end if;
      end if;
      end if;
      end if;
      end if;

      if (bump >= 0)
      then
         i := i + bump;
         return TRUE;
      else
         /* We just validated a word-boundary match the last time through. */
         /* Here we chew up as much whitespace as is necessary.            */
         if (in_b)
         then
            if (NOT is_word_char(ind(line,i)))
            then
               save_i := i;
               i := i + 1;
               if (omatch(line, i, pat, j, flags) = TRUE)
               then
                  in_b := FALSE;
                  return TRUE;
               else
                  i := save_i;
                  in_b := FALSE;
                  return FALSE;
               end if;
            end if;
            in_b := FALSE;
         end if;
      end if;

      return FALSE;
   end;

   procedure clo_backoff(pat    in out pattern,
                         j      in out integer,
                         stack  in out integer,
                         offset in out integer) is
   begin
      while (stack > 0) AND
            (pat(stack+COUNT_IND) <= pat(stack+MIN_IND))
      loop
         stack := pat(stack + PREVCL_IND);
      end loop;

      if (stack > 0)
      then
         pat(stack + COUNT_IND) := pat(stack + COUNT_IND) - 1;
         j := stack + CLOSIZE;
         offset := pat(stack + START_IND) + pat(stack + COUNT_IND);
      end if;
   end;

   procedure br_backoff(pat    in out pattern,
                        j      in     integer,
                        lastbr in out integer) is
   begin
      while (lastbr > j)
      loop
         pat(lastbr + LOC_IND) := 0;
         lastbr := pat(lastbr + PREVBR_IND);
      end loop;
   end;

   function amatch(line     in     varchar2,
                   from_loc in     integer,
                   pat      in out pattern,
                   backrefs    out owa_text.vc_arr,
                   flags    in     varchar2 DEFAULT NULL) return integer is
      i      integer;
      j      integer;
      offset integer;
      stack  integer;

      openbr integer;
      lastbr integer;
   begin
      lastbr := 0;
      stack := 0;
      offset := from_loc;

      j := 1;
      while (pat(j) != EOP)
      loop
         if (pat(j) = CLOSURE)
         then
            stack := j;
            j := j + CLOSIZE;

            i := offset;
            if (pat(stack + MAX_IND) is NULL)
            then
               while (i <= length(line)) AND
                     (omatch(line, i, pat, j, flags) = TRUE)
               loop null;
               end loop;
            else
               while (i <= length(line)) AND
                     (i - offset < pat(stack + MAX_IND)) AND
                     (omatch(line, i, pat, j, flags) = TRUE)
               loop null;
               end loop;
            end if;

            -- Check if we matched enough values.  If not, then back off.
            if ((i - offset) >= pat(stack + MIN_IND))
            then
               pat(stack + COUNT_IND) := i - offset;
               pat(stack + START_IND) := offset;
               offset := i;
            else
               j := stack;
               stack := pat(stack + PREVCL_IND);

               clo_backoff(pat, j, stack, offset); 
               br_backoff(pat, j, lastbr);
               if (stack <= 0) then return 0; end if;
           end if;
         else if (pat(j) in (BR, BREND))
         then
            pat(j + LOC_IND) := offset;
            lastbr := j;
         else if (omatch(line, offset, pat, j, flags) = FALSE)
         then
            clo_backoff(pat, j, stack, offset);
            br_backoff(pat, j, lastbr);
            if (stack <= 0) then return 0; end if;
         end if;
         end if;
         end if;

         j := j + patsize(pat,j);
      end loop;

      while (lastbr > 0)
      loop
         if (pat(lastbr) = BREND)
         then
            openbr := pat(lastbr + OPENBR_IND);

            backrefs(pat(openbr+BRNO_IND)) := 
               substr(line, pat(openbr+LOC_IND),
                            to_number(pat(lastbr+LOC_IND)) 
	                    - to_number(pat(openbr+LOC_IND)));
         end if;

         lastbr := pat(lastbr+PREVBR_IND);
      end loop;

      return offset;
   end;

   function amatch(line     in     varchar2,
                   from_loc in     integer,
                   pat      in     varchar2,
                   backrefs    out owa_text.vc_arr,
                   flags    in     varchar2 DEFAULT NULL) return integer is
      p pattern;
   begin
      getpat(pat, p);     
      return amatch(line, from_loc, p, backrefs, flags);
   end;

   function amatch(line     in     varchar2,
                   from_loc in     integer,
                   pat      in out pattern,
                   flags    in     varchar2 DEFAULT NULL) return integer is
      backrefs owa_text.vc_arr;
   begin
      return amatch(line, from_loc, pat, backrefs, flags);
   end;

   function amatch(line     in varchar2,
                   from_loc in integer,
                   pat      in varchar2,
                   flags    in varchar2 DEFAULT NULL) return integer is
      p pattern;
   begin
      getpat(pat, p);     
      return amatch(line, from_loc, p, flags);
   end;

   function match(line     in     varchar2,
                  pat      in out pattern,
                  backrefs    out owa_text.vc_arr,
                  flags    in     varchar2 DEFAULT NULL) return boolean is
   begin
      for i in 1..line_len(line)
      loop
         if (amatch(line, i, pat, backrefs, flags) > 0)
         then return TRUE;
         end if;
      end loop;

      return FALSE;
   end;

   function match(line     in     varchar2,
                  pat      in     varchar2,
                  backrefs    out owa_text.vc_arr,
                  flags    in     varchar2 DEFAULT NULL) return boolean is
      p pattern;
   begin
      getpat(pat, p);     
      return match(line, p, backrefs, flags);
   end;

   function match(line  in     varchar2,
                  pat   in out pattern,
                  flags in     varchar2 DEFAULT NULL) return boolean is
      backrefs owa_text.vc_arr;
   begin
      return match(line, pat, backrefs, flags);
   end;

   function match(line  in varchar2,
                  pat   in varchar2,
                  flags in varchar2 DEFAULT NULL) return boolean is
      p pattern;
   begin
      getpat(pat, p);     
      return match(line, p, flags);
   end;

   function match(mline  in     owa_text.multi_line, 
                  pat    in out pattern,
                  rlist     out owa_text.row_list,
                  flags  in     varchar2 DEFAULT NULL) return boolean is
      temp_rlist owa_text.row_list;
   begin
      temp_rlist := owa_text.new_row_list;

      for i in 1..mline.num_rows
      loop
         if match(mline.rows(i), pat, flags)
         then
            temp_rlist.num_rows := temp_rlist.num_rows + 1;
            temp_rlist.rows(temp_rlist.num_rows) := i;
         end if;
      end loop;

      rlist := temp_rlist;

      return temp_rlist.num_rows > 0;
   end;

   function match(mline in     owa_text.multi_line,
                  pat   in     varchar2,
                  rlist    out owa_text.row_list,
                  flags in     varchar2 DEFAULT NULL) return boolean is
      p pattern;
   begin
      getpat(pat,p);
      return match(mline, p, rlist, flags);
   end;


   procedure catsub(line     in     varchar2,
                    from_loc in     integer,
                    to_loc   in     integer,
                    sub      in     substitution,
                    backrefs in     owa_text.vc_arr,
                    new      in out varchar2) is
      i integer;
      j integer;
   begin
      i := 1;
      while (sub(i) != EOP)
      loop
         if (sub(i) = DITTO)
         then
            new := new||substr(line,from_loc,to_loc - from_loc);
         else if (sub(i) = BREF)
         then
            i := i + 1;
            new := new||backrefs(sub(i));
         else
            new := new||sub(i);
         end if;
         end if;

         i := i + 1;
      end loop;
   end;

   procedure escsub(arg in     varchar2,
                    i   in out integer,
                    sub in out substitution,
                    j   in out integer) is
   begin
      if (ind(arg,i) != ESCAPE)
      then
         addpat(ind(arg,i), sub, j);
      else if (instr(DIGITS, ind(arg,i+1)) != 0)
      then
         addpat(BREF, sub, j);
         i := i + 1;
         addpat(get_int(arg, i), sub, j);
         i := i - 1; -- get_int puts i up past the last digit.
      else
         addpat(esc(arg,i), sub, j);
      end if;
      end if;
   end;

   procedure getsub(arg in varchar2, sub out substitution)  is
      i integer;
      j integer;
      s substitution;
   begin
      j := 1;
      i := 1;
      while (i <= length(arg))
      loop
         if ind(arg,i) = AMP
         then
            addpat(DITTO, s, j);
         else
            escsub(arg, i, s, j);
         end if;

         i := i + 1;
      end loop;

      addpat(EOP, s, j);
      sub := s;
   end;

   function change(line     in out varchar2,
                   from_str in     varchar2,
                   to_str   in     varchar2,
                   flags    in     varchar2 DEFAULT NULL) return integer is
      p     pattern;
      s     substitution;
      i     integer;
      m     integer;
      lastm integer;
      new   varchar2(32767); -- MAX_VC_LEN

      backrefs owa_text.vc_arr;

      num_matches integer;
   begin
      getpat(from_str,p);
      getsub(to_str,s);

      num_matches := 0;
      lastm := 0;
      i := 1;
      while (i <= line_len(line))
      loop
         m := amatch(line, i , p, backrefs, flags);
         if (m > 0) AND (lastm != m)
         then
            num_matches := num_matches + 1;
            catsub(line, i, m, s, backrefs, new);

            /* New code make the default behavior to be change 1st match. */
            /* Enhancement to Kernighan's code.                           */
            if (flags IS NULL) OR (instr(flags,'g') = 0)
            then
               new := new||substr(line,m);
               exit;
            end if;
            /* End enhancement code */

            lastm := m;
         end if;

         if (m in (0,i))
         then
            new := new||ind(line,i);
            i := i + 1;
         else
            i := m;
         end if;
      end loop;

      line := new;
      return num_matches;
   end;

   procedure change(line     in out varchar2,
                    from_str in     varchar2,
                    to_str   in     varchar2,
                    flags    in     varchar2 DEFAULT NULL) is
      ignore integer;
   begin
      ignore := change(line, from_str, to_str, flags);
   end;

   function change(mline    in out owa_text.multi_line,
                   from_str in     varchar2,
                   to_str   in     varchar2,
                   flags    in     varchar2 DEFAULT NULL) return integer is
      num_matches integer;
   begin
      num_matches := 0;

      for i in 1..mline.num_rows
      loop
         num_matches := num_matches + 
                          change(mline.rows(i), from_str, to_str, flags);
      end loop;

      return num_matches;
   end;

   procedure change(mline     in out owa_text.multi_line,
                    from_str in     varchar2,
                    to_str   in     varchar2,
                    flags    in     varchar2 DEFAULT NULL) is
      ignore integer;
   begin
      ignore := change(mline, from_str, to_str, flags);
   end;

end;
/
show errors
