1 package body OWA_PATTERN is
2
3 subtype substitution is pattern;
4
5 -- MAX_VC_LEN constant number := 32767;
6 -- PL/SQL doesn't allow one to use constant values in variable declarations,
7 -- like 'vc varchar2(MAX_VC_LEN), so this is really just here as a reminder
8 -- to always use value(MAX_VC_LEN) for declarations.
9
10 BOL constant varchar2(1) := '^';
11 EOL constant varchar2(1) := '$';
12 CCL constant varchar2(1) := '[';
13 CCLEND constant varchar2(1) := ']';
14 QUANT constant varchar2(1) := '{';
15 QUANTEND constant varchar2(1) := '}';
16 BR constant varchar2(1) := '(';
17 BREND constant varchar2(1) := ')';
18 ANY_CHAR constant varchar2(1) := '.';
19 ESCAPE constant varchar2(1) := '\';
20 DASH constant varchar2(1) := '-';
21 NOT_CHAR constant varchar2(1) := '^';
22 CLOSURE constant varchar2(1) := '*';
23 ONE_OR_MORE constant varchar2(1) := '+';
24 ZERO_OR_ONE constant varchar2(1) := '?';
25
26 AMP constant varchar2(1) := '&';
27
28 /* The following line should be broken to represent a NEWLINE */
29 NEWLINE constant varchar2(1) := '
30 ';
31 /* The following character is a true "tab" */
32 TAB constant varchar2(1) := ' ';
33 SPACE constant varchar2(1) := ' ';
34
35 NCCL constant varchar2(4) := 'NCCL';
36 CHARCHAR constant varchar2(4) := 'CHAR';
37 DITTO constant varchar2(4) := 'DTTO';
38 BREF constant varchar2(4) := 'BREF';
39 EOP constant varchar2(4) := 'EOP';
40
41 CLOSIZE constant integer := 6;
42 BRSIZE constant integer := 4;
43
44 DIGITS constant VARCHAR2(10) := '0123456789';
45 LOWLET constant VARCHAR2(26) := 'abcdefghijklmnopqrstuvwxyz';
46 UPPLET constant VARCHAR2(26) := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
47 UNDERBAR constant VARCHAR2(1) := '_';
48
49 WORD_CHARS constant VARCHAR2(63) := DIGITS||LOWLET||UNDERBAR||UPPLET;
50 SPACE_CHARS constant VARCHAR2(3) := SPACE||TAB||NEWLINE;
51
52 DIG_ESCAPE_CHAR constant varchar2(1) := 'd'; -- [0-9]
53 NON_DIG_ESCAPE_CHAR constant varchar2(1) := 'D'; -- [^0-9]
54 WORD_ESCAPE_CHAR constant varchar2(1) := 'w'; -- [0-9a-z_A-Z]
55 NON_WORD_ESCAPE_CHAR constant varchar2(1) := 'W'; -- [^0-9a-z_A-Z]
56 SPACE_ESCAPE_CHAR constant varchar2(1) := 's'; -- [ \t\n]
57 NON_SPACE_ESCAPE_CHAR constant varchar2(1) := 'S'; -- [^ \t\n]
58 BOUND_ESCAPE_CHAR constant varchar2(1) := 'b';
59 NON_BOUND_ESCAPE_CHAR constant varchar2(1) := 'B';
60
61 DIG_ESCAPE constant varchar2(2) := ESCAPE||DIG_ESCAPE_CHAR;
62 NON_DIG_ESCAPE constant varchar2(2) := ESCAPE||NON_DIG_ESCAPE_CHAR;
63 WORD_ESCAPE constant varchar2(2) := ESCAPE||WORD_ESCAPE_CHAR;
64 NON_WORD_ESCAPE constant varchar2(2) := ESCAPE||NON_WORD_ESCAPE_CHAR;
65 SPACE_ESCAPE constant varchar2(2) := ESCAPE||SPACE_ESCAPE_CHAR;
66 NON_SPACE_ESCAPE constant varchar2(2) := ESCAPE||NON_SPACE_ESCAPE_CHAR;
67 BOUND_ESCAPE constant varchar2(2) := ESCAPE||BOUND_ESCAPE_CHAR;
68 NON_BOUND_ESCAPE constant varchar2(2) := ESCAPE||NON_BOUND_ESCAPE_CHAR;
69
70 COUNT_IND constant integer := 1;
71 PREVCL_IND constant integer := 2;
72 START_IND constant integer := 3;
73 MIN_IND constant integer := 4;
74 MAX_IND constant integer := 5;
75
76 PREVBR_IND constant integer := 1;
77 LOC_IND constant integer := 2;
78 BRNO_IND constant integer := 3;
79 OPENBR_IND constant integer := 3;
80
81 in_b boolean;
82
83 function ind(str in varchar2, i in integer) return varchar2
84 is
85 begin
86 return substr(str,i,1);
87 end;
88
89 function line_len(line in varchar2) return integer
90 is
91 begin
92 if (line is null)
93 then
94 return 1;
95 else
96 return length(line);
97 end if;
98 end;
99
100 function get_int(arg in varchar2,
101 loc in out integer,
102 digs in varchar2 DEFAULT DIGITS) return integer is
103 start_loc integer;
104 begin
105 start_loc := loc;
106
107 while (instr(digs, ind(arg,loc)) != 0)
108 loop
109 loc := loc + 1;
110 end loop;
111
112 return substr(arg, start_loc, loc-start_loc);
113 end;
114
115 function base_convert(str in varchar2, base in integer) return integer
116 is
117 acc integer;
118 len integer;
119 begin
120 len := length(str);
121 if (len is NULL)
122 then
123 return NULL;
124 end if;
125
126 acc := 0;
127 for i in 1..len
128 loop
129 if (instr('abcdefABCDEF', ind(str,i)) != 0)
130 then
131 acc := acc*base + ascii(convert(lower(ind(str,i)), 'US7ASCII')) - 87;
132 else
133 acc := acc*base + ind(str,i);
134 end if;
135 end loop;
136
137 return acc;
138 end;
139
140 procedure addpat(ch in varchar2, pat in out pattern, j in out integer)
141 is
142 begin
143 pat(j) := ch;
144 j := j + 1;
145 end;
146
147 function patsize(pat in pattern, n in integer) return integer is
148 begin
149 if (pat(n) = CHARCHAR)
150 then return 2;
151 end if;
152 if (pat(n) in (BOL, EOL, ANY_CHAR,
153 DIG_ESCAPE, NON_DIG_ESCAPE,
154 WORD_ESCAPE, NON_WORD_ESCAPE,
155 SPACE_ESCAPE, NON_SPACE_ESCAPE,
156 BOUND_ESCAPE, NON_BOUND_ESCAPE))
157 then return 1;
158 end if;
159 if (pat(n) in (CCL, NCCL))
160 then return pat(n+1) + 2;
161 end if;
162 if (pat(n) = CLOSURE)
163 then return CLOSIZE;
164 end if;
165 if (pat(n) in (BR, BREND))
166 then return BRSIZE;
167 end if;
168
169 raise_application_error(-20002,'in patsize: shouldn''t happen');
170 end;
171
172 procedure copypat(pat in out pattern,
173 j in out integer,
174 loc in integer) is
175 pat_size integer;
176 k integer;
177 begin
178 pat_size := patsize(pat,loc);
179 for k in loc..loc+pat_size-1
180 loop
181 addpat(pat(k), pat, j);
182 end loop;
183 end;
184
185 function esc(arg in varchar2, i in out integer) return varchar2
186 is
187 NL_ESCAPE constant varchar2(1) := 'n';
188 TAB_ESCAPE constant varchar2(1) := 't';
189
190 arg_i varchar2(5); -- MAX NO OF BYTES FOR NLS CHARSET
191 begin
192 arg_i := ind(arg,i);
193 if (arg_i != ESCAPE)
194 then
195 return arg_i;
196 end if;
197
198 if (i = length(arg))
199 then
200 return arg_i;
201 end if;
202
203 i := i+1;
204 arg_i := ind(arg,i);
205 if (arg_i = NL_ESCAPE)
206 then
207 return NEWLINE;
208 end if;
209
210 if (arg_i = TAB_ESCAPE)
211 then
212 return TAB;
213 end if;
214
215 return arg_i;
216 end;
217
218 procedure dodash(valid_chars in varchar2,
219 arg in varchar2,
220 i in out integer,
221 pat in out pattern,
222 j in out integer) is
223 limit integer;
224 k integer;
225 begin
226 i := i + 1;
227 j := j - 1;
228
229 limit := instr(valid_chars, esc(arg,i));
230 k := instr(valid_chars, pat(j));
231 while (k <= limit)
232 loop
233 addpat(ind(valid_chars,k), pat, j);
234 k := k+1;
235 end loop;
236 end;
237
238 procedure filset(delim in varchar2,
239 arg in varchar2,
240 i in out integer,
241 pat in out pattern,
242 j in out integer) is
243 arglen integer;
244 ch varchar2(5); -- MAX NO OF BYTES FOR NLS CHARSET
245 begin
246 arglen := length(arg);
247
248 ch := ind(arg,i);
249 while (ch != delim) AND (i <= arglen)
250 loop
251 if (ch = ESCAPE)
252 then
253 addpat(esc(arg,i), pat,j);
254 else if (ch != DASH)
255 then
256 addpat(ch, pat, j);
257 else if (j <= 1) OR (i+1 >= arglen)
258 then
259 addpat(DASH, pat, j);
260 else if (instr(DIGITS,pat(j-1)) > 0)
261 then
262 dodash(DIGITS, arg, i, pat, j);
263 else if (instr(LOWLET, pat(j-1)) > 0)
264 then
265 dodash(LOWLET, arg, i, pat, j);
266 else if (instr(UPPLET, pat(j-1)) > 0)
267 then
268 dodash(UPPLET, arg, i, pat, j);
269 else
270 addpat(DASH, pat, j);
271 end if;
272 end if;
273 end if;
274 end if;
275 end if;
276 end if;
277
278 i := i + 1;
279 ch := ind(arg,i);
280 end loop;
281 end;
282
283 procedure getccl(arg in varchar2,
284 i in out integer,
285 pat in out pattern,
286 j in out integer) is
287 jstart integer;
288 begin
289 i := i + 1; -- Skip over the "["
290
291 if (ind(arg,i) = NOT_CHAR)
292 then
293 addpat(NCCL, pat, j);
294 i := i + 1;
295 else
296 addpat(CCL, pat, j);
297 end if;
298
299 jstart := j;
300 addpat(0, pat, j);
301 filset(CCLEND, arg, i, pat, j);
302 pat(jstart) := j - jstart - 1;
303 if (ind(arg,i) != CCLEND)
304 then
305 raise_application_error(-20000, 'Error in getccl');
306 end if;
307 end;
308
309 -- stmin_max returns FALSE if a string beginning with a '{' is not
310 -- a proper {n,m} quantifier
311 function stmin_max(arg in varchar2,
312 i in out integer,
313 min_val out integer,
314 max_val out integer) return boolean
315 is
316 COMMA constant varchar2(1) := ',';
317
318 arg_i varchar2(5); -- MAX NO OF BYTES FOR NLS CHARSET
319 i1 integer;
320 i2 integer;
321
322 min_v integer;
323 begin
324 arg_i := ind(arg,i);
325 if (arg_i = CLOSURE)
326 then
327 min_val := 0;
328 max_val := NULL;
329 else if (arg_i = ONE_OR_MORE)
330 then
331 min_val := 1;
332 max_val := NULL;
333 else if (arg_i = ZERO_OR_ONE)
334 then
335 min_val := 0;
336 max_val := 1;
337 else if (arg_i = QUANT)
338 then
339 i1 := i + 1;
340 i2 := i1;
341
342 while (instr(DIGITS, ind(arg,i2)) != 0)
343 loop
344 i2 := i2 + 1;
345 end loop;
346
347 min_v := substr(arg, i1, i2-i1);
348 if (min_v is null) then return FALSE; end if;
349
350 if (ind(arg,i2) = QUANTEND)
351 then
352 max_val := min_v;
353 else if (ind(arg,i2) = COMMA)
354 then
355 i1 := i2 + 1;
356 i2 := i1;
357
358 while (instr(DIGITS, ind(arg,i2)) != 0)
359 loop
360 i2 := i2 + 1;
361 end loop;
362
363 if (ind(arg,i2) = QUANTEND)
364 then
365 max_val := substr(arg, i1, i2-i1);
366 else
367 return FALSE;
368 end if;
369 else
370 return FALSE;
371 end if;
372 end if;
373
374 min_val := min_v;
375 i := i2;
376 else
377 raise_application_error(-20001, 'In stmin_max: illegal pattern');
378 end if;
379 end if;
380 end if;
381 end if;
382
383 return TRUE;
384 end;
385
386 function stclos(pat in out pattern,
387 j in out integer,
388 lastj in out integer,
389 lastcl in integer,
390 min_val in integer,
391 max_val in integer) return integer is
392 jp integer;
393 jt integer;
394 return_val integer;
395 begin
396 for jp in REVERSE lastj..j-1
397 loop
398 jt := jp + CLOSIZE;
399 addpat(pat(jp), pat, jt);
400 end loop;
401
402 j := j + CLOSIZE;
403 return_val := lastj;
404
405 addpat(CLOSURE, pat, lastj);
406 addpat(0, pat, lastj);
407 addpat(lastcl, pat, lastj);
408 addpat(0, pat, lastj);
409 addpat(min_val, pat, lastj);
410 addpat(max_val, pat, lastj);
411
412 return return_val;
413 end;
414
415 procedure stbr(brtype in varchar2,
416 pat in out pattern,
417 j in out integer,
418 lastbr in out integer,
419 var in out integer) is
420 -- "var" will be either "brno" if we are on a "("
421 -- or it will be "openbr" if we are on a ")"
422 begin
423 addpat(brtype, pat, j);
424 addpat(lastbr, pat, j);
425 addpat(0, pat, j);
426
427 -- var is "brno" increment it before inserting the value.
428 if (brtype = BR)
429 then
430 var := var + 1;
431 end if;
432
433 addpat(var, pat, j);
434 lastbr := j - BRSIZE;
435
436 -- var is "openbr" - find the last unmatched openbr.
437 if (brtype = BREND)
438 then
439 var := pat(var + PREVBR_IND);
440
441 while (var > 0) AND (pat(var) != BR)
442 loop
443 var := pat(var + OPENBR_IND);
444 var := pat(var + PREVBR_IND);
445 end loop;
446 end if;
447 end;
448
449 /* ESCPAT is an enhancement to Kernighan's algorithms. It allows */
450 /* more "short-cut" tags in the pattern, such as using '\d' for */
451 /* [0-9]. This is to extend the algorithms to support more of */
452 /* Perl's regular expression patterns. */
453 procedure escpat(arg in varchar2,
454 i in out integer,
455 pat in out pattern,
456 j in out integer) is
457 HEXCHAR constant varchar2(1) := 'x';
458 HEXDIGITS constant varchar2(22) := DIGITS||'abcdefABCDEF';
459 OCTDIGITS constant varchar2(8) := '01234567';
460 begin
461 if (ind(arg,i) != ESCAPE)
462 then
463 addpat(CHARCHAR, pat, j);
464 addpat(ind(arg,i), pat, j);
465 else if (ind(arg,i+1) in (DIG_ESCAPE_CHAR, NON_DIG_ESCAPE_CHAR,
466 WORD_ESCAPE_CHAR, NON_WORD_ESCAPE_CHAR,
467 SPACE_ESCAPE_CHAR, NON_SPACE_ESCAPE_CHAR,
468 BOUND_ESCAPE_CHAR, NON_BOUND_ESCAPE_CHAR))
469 then
470 addpat(ESCAPE||ind(arg,i+1), pat, j);
471 i := i + 1;
472 else if ((ind(arg,i+1) = HEXCHAR) AND
473 (instr(HEXDIGITS, ind(arg,i+2)) != 0) AND
474 (instr(HEXDIGITS, ind(arg,i+3)) != 0)
475 )
476 then
477 addpat(CHARCHAR, pat, j);
478 addpat(chr(base_convert(substr(arg,i+2,2), 16)), pat, j);
479 i := i + 3;
480 else if ((instr(OCTDIGITS, ind(arg,i+1)) != 0) AND
481 (instr(OCTDIGITS, ind(arg,i+2)) != 0)
482 )
483 then
484 if (instr(OCTDIGITS, ind(arg,i+3)) != 0)
485 then
486 addpat(CHARCHAR, pat, j);
487 addpat(chr(base_convert(substr(arg,i+1,3), 8)), pat, j);
488 i := i + 3;
489 else
490 addpat(CHARCHAR, pat, j);
491 addpat(chr(base_convert(substr(arg,i+1,2), 8)), pat, j);
492 i := i + 2;
493 end if;
494 else
495 addpat(CHARCHAR, pat, j);
496 addpat(esc(arg,i), pat, j);
497 end if;
498 end if;
499 end if;
500 end if;
501 end;
502
503 /* GETPAT is a merge of the "getpat" and "makpat" functions which */
504 /* Kernighan details. The additional level of abstraction which */
505 /* makpat provides is unnecessary in this implementation. */
506 procedure getpat(arg in varchar2, pat in out pattern) is
507 arglen integer;
508
509 i integer;
510 j integer;
511
512 lastcl integer;
513 lastj integer;
514 lj integer;
515
516 lastbr integer;
517 openbr integer;
518 brno integer;
519
520 arg_i varchar2(5); -- MAX NO OF BYTES FOR NLS CHARSET
521
522 min_val integer;
523 max_val integer;
524 begin
525 arglen := length(arg);
526
527 j := 1;
528 lastj := 1;
529 lastcl := 0;
530 lastbr := 0;
531 openbr := 0;
532 brno := 0;
533
534 i := 1;
535 while (i <= arglen)
536 loop
537 lj := j;
538
539 arg_i := ind(arg,i);
540 if (arg_i = ANY_CHAR)
541 then
542 addpat(ANY_CHAR, pat, j);
543 else if (arg_i = BOL) AND (i = 1)
544 then
545 addpat(BOL, pat, j);
546 else if (arg_i = EOL) AND (i = arglen)
547 then
548 addpat(EOL, pat, j);
549 else if (arg_i = CCL)
550 then
551 getccl(arg, i, pat, j);
552 else if (arg_i in (CLOSURE, ZERO_OR_ONE,
553 ONE_OR_MORE, QUANT)) AND (i > 1)
554 then
555 lj := lastj;
556 if (pat(lj) NOT in (BOL, EOL, CLOSURE, ZERO_OR_ONE,
557 ONE_OR_MORE, QUANT))
558 then
559 if (stmin_max(arg, i, min_val, max_val))
560 then
561 lastcl := stclos(pat, j, lastj, lastcl, min_val, max_val);
562 else
563 escpat(arg, i, pat, j);
564 end if;
565 else
566 raise_application_error(-20000,arg||': nested *?+ in regular expression');
567 end if;
568 else if (arg_i = BR)
569 then
570 openbr := j;
571 stbr(BR, pat, j, lastbr, brno);
572 else if (arg_i = BREND)
573 then
574 if (openbr = 0)
575 then
576 raise_application_error(-20000,arg||': unmatched () in regular expression');
577 end if;
578
579 stbr(BREND, pat, j, lastbr, openbr);
580 else
581 escpat(arg, i, pat, j);
582 end if;
583 end if;
584 end if;
585 end if;
586 end if;
587 end if;
588 end if;
589
590 lastj := lj;
591 i := i+1;
592 end loop;
593
594 if (openbr != 0)
595 then
596 raise_application_error(-20000,arg||': unmatched () in regular expression');
597 end if;
598
599 addpat(EOP, pat, j);
600 end;
601
602 procedure printpat(pat in pattern) is
603 i integer;
604 begin
605 i := 1;
606 while pat(i) != EOP
607 loop
608 dbms_output.put_line('pat('||i||') = '||pat(i));
609 i := i+1;
610 end loop;
611 end;
612
613 /* LOCATE - Determine if character 'ch' is in the character class */
614 /* found at pat(offset). */
615 function locate(ch in varchar2, pat in pattern,
616 offset in integer) return boolean is
617 begin
618 -- Fix 611104
619 -- pat(offset) has #of chars in character class
620 for i in REVERSE (offset + 1)..offset+pat(offset)
621 loop
622 if (ch = pat(i))
623 then
624 return TRUE;
625 end if;
626 end loop;
627
628 return FALSE;
629 end;
630
631 function is_word_char(ch in varchar2) return boolean
632 is
633 begin
634 return (instr (DIGITS||LOWLET||'_'||UPPLET, ch) != 0);
635 end;
636
637 function omatch(line in varchar2,
638 i in out integer,
639 pat in pattern,
640 j in integer,
641 flags in varchar2 DEFAULT NULL) return boolean is
642 bump integer;
643 line_i varchar2(5); -- MAX NO OF BYTES FOR NLS CHARSET
644 pat_j varchar2(4);
645
646 save_i integer;
647 begin
648 bump := -1;
649 line_i := ind(line,i);
650 pat_j := pat(j);
651
652 if (pat_j = CHARCHAR)
653 then
654 /* Here is a simple extension to add case-insensitive searches. */
655 /* This is the easiest place to put this, although it may not */
656 /* be the most efficient location for it. */
657 if /* (flags is not null) AND */ (instr(flags,'i') != 0)
658 then
659 if (lower(line_i) = lower(pat(j+1)))
660 then
661 bump := 1;
662 in_b := FALSE;
663 end if;
664 else
665 if (line_i = pat(j+1))
666 then
667 bump := 1;
668 in_b := FALSE;
669 end if;
670 end if;
671 else if (pat_j = BOL)
672 then
673 if ( (i = 1) OR (ind(line,i-1) = NEWLINE) )
674 then
675 bump := 0;
676 in_b := FALSE;
677 end if;
678 else if (pat_j = ANY_CHAR)
679 then
680 if (line_i != NEWLINE)
681 then
682 bump := 1;
683 in_b := FALSE;
684 end if;
685 else if (pat_j = EOL)
686 then
687 if (line_i = NEWLINE) OR (i > length(line))
688 then
689 bump := 0;
690 in_b := FALSE;
691 end if;
692 else if (pat_j = BOUND_ESCAPE)
693 then
694 if ( i = 1 ) OR (i > length(line))
695 then
696 bump := 0;
697 in_b := TRUE;
698 else
699 if ( ( is_word_char(line_i) AND
700 NOT is_word_char(ind(line,i-1)) )
701 OR
702 ( is_word_char(ind(line,i-1)) AND
703 NOT is_word_char(line_i) ) )
704 then
705 bump := 0;
706 in_b := TRUE;
707 end if;
708 end if;
709 else if (pat_j = DIG_ESCAPE)
710 then
711 if (instr(DIGITS, line_i) != 0)
712 then
713 bump := 1;
714 in_b := FALSE;
715 end if;
716 else if (pat_j = NON_DIG_ESCAPE)
717 then
718 if (instr(DIGITS, line_i) = 0)
719 then
720 bump := 1;
721 in_b := FALSE;
722 end if;
723 else if (pat_j = WORD_ESCAPE)
724 then
725 if (instr(WORD_CHARS, line_i) != 0)
726 then
727 bump := 1;
728 in_b := FALSE;
729 end if;
730 else if (pat_j = NON_WORD_ESCAPE)
731 then
732 if (instr(WORD_CHARS, line_i) = 0)
733 then
734 bump := 1;
735 in_b := FALSE;
736 end if;
737 else if (pat_j = SPACE_ESCAPE)
738 then
739 if (instr(SPACE_CHARS, line_i) != 0)
740 then
741 bump := 1;
742 in_b := FALSE;
743 end if;
744 else if (pat_j = NON_SPACE_ESCAPE)
745 then
746 if (instr(SPACE_CHARS, line_i) = 0)
747 then
748 bump := 1;
749 in_b := FALSE;
750 end if;
751 else if (pat_j = CCL)
752 then
753 if (locate(line_i, pat, j+1) = TRUE)
754 then
755 bump := 1;
756 in_b := FALSE;
757 end if;
758 else if (pat_j = NCCL)
759 then
760 if (line_i != NEWLINE) AND (locate(line_i, pat, j+1) = FALSE)
761 then
762 bump :=1;
763 in_b := FALSE;
764 end if;
765 else
766 raise_application_error(-20001,'In omatch: illegal pattern found');
767 end if;
768 end if;
769 end if;
770 end if;
771 end if;
772 end if;
773 end if;
774 end if;
775 end if;
776 end if;
777 end if;
778 end if;
779 end if;
780
781 if (bump >= 0)
782 then
783 i := i + bump;
784 return TRUE;
785 else
786 /* We just validated a word-boundary match the last time through. */
787 /* Here we chew up as much whitespace as is necessary. */
788 if (in_b)
789 then
790 if (NOT is_word_char(ind(line,i)))
791 then
792 save_i := i;
793 i := i + 1;
794 if (omatch(line, i, pat, j, flags) = TRUE)
795 then
796 in_b := FALSE;
797 return TRUE;
798 else
799 i := save_i;
800 in_b := FALSE;
801 return FALSE;
802 end if;
803 end if;
804 in_b := FALSE;
805 end if;
806 end if;
807
808 return FALSE;
809 end;
810
811 procedure clo_backoff(pat in out pattern,
812 j in out integer,
813 stack in out integer,
814 offset in out integer) is
815 begin
816 while (stack > 0) AND
817 (pat(stack+COUNT_IND) <= pat(stack+MIN_IND))
818 loop
819 stack := pat(stack + PREVCL_IND);
820 end loop;
821
822 if (stack > 0)
823 then
824 pat(stack + COUNT_IND) := pat(stack + COUNT_IND) - 1;
825 j := stack + CLOSIZE;
826 offset := pat(stack + START_IND) + pat(stack + COUNT_IND);
827 end if;
828 end;
829
830 procedure br_backoff(pat in out pattern,
831 j in integer,
832 lastbr in out integer) is
833 begin
834 while (lastbr > j)
835 loop
836 pat(lastbr + LOC_IND) := 0;
837 lastbr := pat(lastbr + PREVBR_IND);
838 end loop;
839 end;
840
841 function amatch(line in varchar2,
842 from_loc in integer,
843 pat in out pattern,
844 backrefs out owa_text.vc_arr,
845 flags in varchar2 DEFAULT NULL) return integer is
846 i integer;
847 j integer;
848 offset integer;
849 stack integer;
850
851 openbr integer;
852 lastbr integer;
853 begin
854 lastbr := 0;
855 stack := 0;
856 offset := from_loc;
857
858 j := 1;
859 while (pat(j) != EOP)
860 loop
861 if (pat(j) = CLOSURE)
862 then
863 stack := j;
864 j := j + CLOSIZE;
865
866 i := offset;
867 if (pat(stack + MAX_IND) is NULL)
868 then
869 while (i <= length(line)) AND
870 (omatch(line, i, pat, j, flags) = TRUE)
871 loop null;
872 end loop;
873 else
874 while (i <= length(line)) AND
875 (i - offset < pat(stack + MAX_IND)) AND
876 (omatch(line, i, pat, j, flags) = TRUE)
877 loop null;
878 end loop;
879 end if;
880
881 -- Check if we matched enough values. If not, then back off.
882 if ((i - offset) >= pat(stack + MIN_IND))
883 then
884 pat(stack + COUNT_IND) := i - offset;
885 pat(stack + START_IND) := offset;
886 offset := i;
887 else
888 j := stack;
889 stack := pat(stack + PREVCL_IND);
890
891 clo_backoff(pat, j, stack, offset);
892 br_backoff(pat, j, lastbr);
893 if (stack <= 0) then return 0; end if;
894 end if;
895 else if (pat(j) in (BR, BREND))
896 then
897 pat(j + LOC_IND) := offset;
898 lastbr := j;
899 else if (omatch(line, offset, pat, j, flags) = FALSE)
900 then
901 clo_backoff(pat, j, stack, offset);
902 br_backoff(pat, j, lastbr);
903 if (stack <= 0) then return 0; end if;
904 end if;
905 end if;
906 end if;
907
908 j := j + patsize(pat,j);
909 end loop;
910
911 while (lastbr > 0)
912 loop
913 if (pat(lastbr) = BREND)
914 then
915 openbr := pat(lastbr + OPENBR_IND);
916
917 backrefs(pat(openbr+BRNO_IND)) :=
918 substr(line, to_number(pat(openbr+LOC_IND)),
919 to_number(pat(lastbr+LOC_IND))
920 - to_number(pat(openbr+LOC_IND)));
921 end if;
922
923 lastbr := pat(lastbr+PREVBR_IND);
924 end loop;
925
926 return offset;
927 end;
928
929 function amatch(line in varchar2,
930 from_loc in integer,
931 pat in varchar2,
932 backrefs out owa_text.vc_arr,
933 flags in varchar2 DEFAULT NULL) return integer is
934 p pattern;
935 begin
936 getpat(pat, p);
937 return amatch(line, from_loc, p, backrefs, flags);
938 end;
939
940 function amatch(line in varchar2,
941 from_loc in integer,
942 pat in out pattern,
943 flags in varchar2 DEFAULT NULL) return integer is
944 backrefs owa_text.vc_arr;
945 begin
946 return amatch(line, from_loc, pat, backrefs, flags);
947 end;
948
949 function amatch(line in varchar2,
950 from_loc in integer,
951 pat in varchar2,
952 flags in varchar2 DEFAULT NULL) return integer is
953 p pattern;
954 begin
955 getpat(pat, p);
956 return amatch(line, from_loc, p, flags);
957 end;
958
959 function match(line in varchar2,
960 pat in out pattern,
961 backrefs out owa_text.vc_arr,
962 flags in varchar2 DEFAULT NULL) return boolean is
963 begin
964 for i in 1..line_len(line)
965 loop
966 if (amatch(line, i, pat, backrefs, flags) > 0)
967 then return TRUE;
968 end if;
969 end loop;
970
971 return FALSE;
972 end;
973
974 function match(line in varchar2,
975 pat in varchar2,
976 backrefs out owa_text.vc_arr,
977 flags in varchar2 DEFAULT NULL) return boolean is
978 p pattern;
979 begin
980 getpat(pat, p);
981 return match(line, p, backrefs, flags);
982 end;
983
984 function match(line in varchar2,
985 pat in out pattern,
986 flags in varchar2 DEFAULT NULL) return boolean is
987 backrefs owa_text.vc_arr;
988 begin
989 return match(line, pat, backrefs, flags);
990 end;
991
992 function match(line in varchar2,
993 pat in varchar2,
994 flags in varchar2 DEFAULT NULL) return boolean is
995 p pattern;
996 begin
997 getpat(pat, p);
998 return match(line, p, flags);
999 end;
1000
1001 function match(mline in owa_text.multi_line,
1002 pat in out pattern,
1003 rlist out owa_text.row_list,
1004 flags in varchar2 DEFAULT NULL) return boolean is
1005 temp_rlist owa_text.row_list;
1006 begin
1007 temp_rlist := owa_text.new_row_list;
1008
1009 for i in 1..mline.num_rows
1010 loop
1011 if match(mline.rows(i), pat, flags)
1012 then
1013 temp_rlist.num_rows := temp_rlist.num_rows + 1;
1014 temp_rlist.rows(temp_rlist.num_rows) := i;
1015 end if;
1016 end loop;
1017
1018 rlist := temp_rlist;
1019
1020 return temp_rlist.num_rows > 0;
1021 end;
1022
1023 function match(mline in owa_text.multi_line,
1024 pat in varchar2,
1025 rlist out owa_text.row_list,
1026 flags in varchar2 DEFAULT NULL) return boolean is
1027 p pattern;
1028 begin
1029 getpat(pat,p);
1030 return match(mline, p, rlist, flags);
1031 end;
1032
1033
1034 procedure catsub(line in varchar2,
1035 from_loc in integer,
1036 to_loc in integer,
1037 sub in substitution,
1038 backrefs in owa_text.vc_arr,
1039 new in out varchar2) is
1040 i integer;
1041 j integer;
1042 begin
1043 i := 1;
1044 while (sub(i) != EOP)
1045 loop
1046 if (sub(i) = DITTO)
1047 then
1048 new := new||substr(line,from_loc,to_loc - from_loc);
1049 else if (sub(i) = BREF)
1050 then
1051 i := i + 1;
1052 new := new||backrefs(sub(i));
1053 else
1054 new := new||sub(i);
1055 end if;
1056 end if;
1057
1058 i := i + 1;
1059 end loop;
1060 end;
1061
1062 procedure escsub(arg in varchar2,
1063 i in out integer,
1064 sub in out substitution,
1065 j in out integer) is
1066 begin
1067 if (ind(arg,i) != ESCAPE)
1068 then
1069 addpat(ind(arg,i), sub, j);
1070 else if (instr(DIGITS, ind(arg,i+1)) != 0)
1071 then
1072 addpat(BREF, sub, j);
1073 i := i + 1;
1074 addpat(get_int(arg, i), sub, j);
1075 i := i - 1; -- get_int puts i up past the last digit.
1076 else
1077 addpat(esc(arg,i), sub, j);
1078 end if;
1079 end if;
1080 end;
1081
1082 procedure getsub(arg in varchar2, sub out substitution) is
1083 i integer;
1084 j integer;
1085 s substitution;
1086 begin
1087 j := 1;
1088 i := 1;
1089 while (i <= length(arg))
1090 loop
1091 if ind(arg,i) = AMP
1092 then
1093 addpat(DITTO, s, j);
1094 else
1095 escsub(arg, i, s, j);
1096 end if;
1097
1098 i := i + 1;
1099 end loop;
1100
1101 addpat(EOP, s, j);
1102 sub := s;
1103 end;
1104
1105 function change(line in out varchar2,
1106 from_str in varchar2,
1107 to_str in varchar2,
1108 flags in varchar2 DEFAULT NULL) return integer is
1109 p pattern;
1110 s substitution;
1111 i integer;
1112 m integer;
1113 lastm integer;
1114 new varchar2(32767); -- MAX_VC_LEN
1115
1116 backrefs owa_text.vc_arr;
1117
1118 num_matches integer;
1119 begin
1120 getpat(from_str,p);
1121 getsub(to_str,s);
1122
1123 num_matches := 0;
1124 lastm := 0;
1125 i := 1;
1126 while (i <= line_len(line))
1127 loop
1128 m := amatch(line, i , p, backrefs, flags);
1129 if (m > 0) AND (lastm != m)
1130 then
1131 num_matches := num_matches + 1;
1132 catsub(line, i, m, s, backrefs, new);
1133
1134 /* New code make the default behavior to be change 1st match. */
1135 /* Enhancement to Kernighan's code. */
1136 if (flags IS NULL) OR (instr(flags,'g') = 0)
1137 then
1138 new := new||substr(line,m);
1139 exit;
1140 end if;
1141 /* End enhancement code */
1142
1143 lastm := m;
1144 end if;
1145
1146 if (m in (0,i))
1147 then
1148 new := new||ind(line,i);
1149 i := i + 1;
1150 else
1151 i := m;
1152 end if;
1153 end loop;
1154
1155 line := new;
1156 return num_matches;
1157 end;
1158
1159 procedure change(line in out varchar2,
1160 from_str in varchar2,
1161 to_str in varchar2,
1162 flags in varchar2 DEFAULT NULL) is
1163 ignore integer;
1164 begin
1165 ignore := change(line, from_str, to_str, flags);
1166 end;
1167
1168 function change(mline in out owa_text.multi_line,
1169 from_str in varchar2,
1170 to_str in varchar2,
1171 flags in varchar2 DEFAULT NULL) return integer is
1172 num_matches integer;
1173 begin
1174 num_matches := 0;
1175
1176 for i in 1..mline.num_rows
1177 loop
1178 num_matches := num_matches +
1179 change(mline.rows(i), from_str, to_str, flags);
1180 end loop;
1181
1182 return num_matches;
1183 end;
1184
1185 procedure change(mline in out owa_text.multi_line,
1186 from_str in varchar2,
1187 to_str in varchar2,
1188 flags in varchar2 DEFAULT NULL) is
1189 ignore integer;
1190 begin
1191 ignore := change(mline, from_str, to_str, flags);
1192 end;
1193
1194 end;
[Home] [Help]