.CM  SCRIPT , Version - 1.1 , last edited by M.Rathmann
.ad 8
.bm 8
.fm 4
.bt $Copyright (c) 1998-2004 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.TT 1 $SQL$Project Distributed Database System$VSP49$
.tt 2 $$$
.TT 3 $$Patterns$1998-06-17$
***********************************************************
.nf

.nf


    ========== licence begin  GPL
    Copyright (c) 1998-2004 SAP AG

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end

.fo


.fo
.nf
.sp
MODULE  :  Patterns
=========
.sp
Purpose :  Pattern match
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              s49build_pattern (
                    VAR pat_buffer : tsp00_MoveObj;
                    is_ascii    : boolean;
                    start       : tsp00_Int4;
                    stop        : tsp00_Int4;
                    escape_char : char;
                    escape      : boolean;
                    string      : boolean;
                    sqlmode     : tsp00_SqlMode;
                    VAR ok      : boolean);
 
        PROCEDURE
              s49uni_build_pattern (
                    VAR pat_buffer : tsp00_MoveObj;
                    start       : tsp00_Int4;
                    stop        : tsp00_Int4;
                    escape_char : tsp00_C2 (*ptocSynonym char**);
                    escape      : boolean;
                    sqlmode     : tsp00_SqlMode;
                    VAR ok      : boolean);
 
        FUNCTION
              s49onecmatch (
                    VAR pat         : tsp00_MoveObj;
                    s_pos           : tsp00_Int4;
                    comp_ch         : char;
                    VAR pat_incr    : tsp00_Int4) : boolean;
 
        FUNCTION
              s49patmatch (
                    VAR val        : tsp00_MoveObj;
                    val_offset     : tsp00_Int4;
                    val_len        : tsp00_Int4;
                    VAR pat        : tsp00_MoveObj;
                    pat_offset     : tsp00_Int4;
                    pat_len        : tsp00_Int4;
                    pat_defbyte    : char) : boolean;
 
        FUNCTION
              s49upatmatch (
                    VAR val     : tsp00_MoveObj;
                    val_offset  : tsp00_Int4;
                    val_len     : tsp00_Int4;
                    VAR pat     : tsp00_MoveObj;
                    pat_offset  : tsp00_Int4;
                    pat_len     : tsp00_Int4) : boolean;
 
        PROCEDURE
              s49xtdbuild_pattern (
                    VAR pat_buffer : tsp00_MoveObj;
                    is_ascii    : boolean;
                    start       : tsp00_Int4;
                    stop        : tsp00_Int4;
                    escape_char : char;
                    pad_char    : char;
                    escape      : boolean;
                    string      : boolean;
                    sqlmode     : tsp00_SqlMode;
                    VAR ok      : boolean);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : 
.sp
.cp 3
Created : 1991-05-24
.sp
.cp 3
Version : 1998-06-17
.sp
.cp 3
Release :      Date : 1998-06-17
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
VSP49 requires the following type and constant definitions:
.sp;.nf
.sp 2
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
(*------------------------------*) 
 
PROCEDURE
      s49build_pattern (
            VAR pat_buffer : tsp00_MoveObj;
            is_ascii    : boolean;
            start       : tsp00_Int4;
            stop        : tsp00_Int4;
            escape_char : char;
            escape      : boolean;
            string      : boolean;
            sqlmode     : tsp00_SqlMode;
            VAR ok      : boolean);
 
VAR
      pad_ch : char;
 
BEGIN
IF  string
THEN
    pad_ch := chr (0)
ELSE
    pad_ch := pat_buffer [ start - 1 ];
(*ENDIF*) 
s49xtdbuild_pattern (pat_buffer, is_ascii, start, stop,
      escape_char, pad_ch, escape, string, sqlmode, ok);
END;
 
(*------------------------------*) 
 
FUNCTION
      s49onecmatch  (
            VAR pat         : tsp00_MoveObj;
            s_pos           : tsp00_Int4;
            comp_ch      : char;
            VAR pat_incr : tsp00_Int4 ) : boolean;
 
VAR
      found         : boolean;
      is_end        : boolean;
      is_error      : boolean;
      negated_class : boolean;
      state         : tsp00_Int4;
      pos           : tsp00_Int4;
      left_pos      : tsp00_Int4;
      cl_start      : tsp00_Int4;
 
BEGIN
is_end   := false;
is_error := false;
found    := false;
state    := 1;
pos      := s_pos;
IF  pat [ pos ] = csp_cclass
THEN
    BEGIN
    cl_start := pos;
    negated_class := false;
    IF  pat [ pos + 1 ] = csp_cnot
    THEN
        BEGIN
        negated_class := true;
        pos := pos + 1
        END;
    (*ENDIF*) 
    pos      := pos + 1;
    WHILE NOT (found OR is_end) AND NOT is_error DO
        CASE state OF
            1 :
                BEGIN
                IF  pat [ pos ] = comp_ch
                THEN
                    found := true
                ELSE
                    IF  pat [ pos ] = csp_cclass
                    THEN
                        is_end := true
                    ELSE
                        IF  pat [ pos ] = csp_crange
                        THEN
                            is_error := true
                        ELSE
                            BEGIN
                            left_pos := pos;
                            pos := pos + 1;
                            IF  pat [ pos ] = csp_crange
                            THEN
                                state := 2
                            ELSE
                                IF  pat [ pos ] = csp_cclass
                                THEN
                                    is_end := true;
                                (*ENDIF*) 
                            (*ENDIF*) 
                            END
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            2 :
                BEGIN
                pos := pos + 1;
                IF  NOT (pat [ pos ] in [ csp_cclass, csp_crange ])
                THEN
                    state := 3
                ELSE
                    is_error := true;
                (*ENDIF*) 
                END;
            3 :
                BEGIN
                IF  pat [ left_pos ] <= pat [ pos ]
                THEN
                    found := (pat [ left_pos ] <= comp_ch)
                          AND
                          (pat [ pos ] >= comp_ch)
                ELSE
                    found := (pat [ left_pos ] >= comp_ch)
                          AND
                          (pat [ pos ] <= comp_ch);
                (*ENDIF*) 
                IF  NOT found
                THEN
                    pos := pos + 1;
                (*ENDIF*) 
                state := 1
                END;
            END;
        (*ENDCASE*) 
    (*ENDWHILE*) 
    IF  found
    THEN
        BEGIN
        IF  negated_class
        THEN
            found := false
        (*ENDIF*) 
        END
    ELSE (* not found *)
        IF  negated_class
        THEN
            found := true;
        (*ENDIF*) 
    (*ENDIF*) 
    IF  found
    THEN
        BEGIN
        WHILE pat[ pos ] <> csp_cclass DO
            pos := pos + 1;
        (*ENDWHILE*) 
        pat_incr := pos - cl_start + 1
        END
    ELSE
        pat_incr := 0;
    (*ENDIF*) 
    END;
(*ENDIF*) 
s49onecmatch := found;
END;
 
(*------------------------------*) 
 
FUNCTION
      s49patmatch (
            VAR val     : tsp00_MoveObj;
            val_offset  : tsp00_Int4;
            val_len     : tsp00_Int4;
            VAR pat     : tsp00_MoveObj;
            pat_offset  : tsp00_Int4;
            pat_len     : tsp00_Int4;
            pat_defbyte : char) : boolean;
      (* not recursive *)
 
VAR
      found           : boolean;
      match           : boolean;
      ok              : boolean;
      shift           : boolean;
      star_occurred   : boolean;
      act_pat_ch      : char;
      val_pos         : tsp00_Int4;
      pat_pos         : tsp00_Int4;
      closure_val_pos : tsp00_Int4;
      closure_pat_pos : tsp00_Int4;
      pat_incr        : tsp00_Int4;
 
BEGIN
(* prerequisite: val_len > 0 AND pat_len > 0 *)
found         := false;
ok            := true;
shift         := false;
star_occurred := false;
pat_pos       := 1;
val_pos       := 1;
act_pat_ch    := pat [ pat_offset + 1 ];
IF  (pat_len = 1) AND ((act_pat_ch = csp_star1) OR (act_pat_ch =
    csp_any1))
THEN
    BEGIN
    found := true;
    IF  (act_pat_ch = csp_any1) AND (val_len > 1)
    THEN
        found := false
    (*ENDIF*) 
    END
ELSE
    BEGIN
    REPEAT
        IF  pat [ pat_offset + pat_pos ] = csp_star1
        THEN
            BEGIN
            pat_pos         := pat_pos + 1;
            shift           := true;
            star_occurred   := true;
            closure_pat_pos := pat_pos;
            closure_val_pos := 0;
            IF  pat_pos > pat_len
            THEN
                found := true
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  pat_pos <= pat_len
        THEN
            BEGIN
            match := false;
            IF  (pat[ pat_offset + pat_pos ] = val[ val_offset+val_pos ])
                OR (pat[ pat_offset + pat_pos ] = csp_any1)
            THEN
                BEGIN
                pat_incr := 1;
                match    := true
                END
            ELSE
                IF  pat [ pat_offset + pat_pos ] = csp_cclass
                THEN
                    match := s49onecmatch (pat, pat_offset + pat_pos,
                          val [ val_offset + val_pos ], pat_incr);
                (*ENDIF*) 
            (*ENDIF*) 
            IF  match
            THEN
                BEGIN
                pat_pos := pat_pos + pat_incr;
                val_pos := val_pos + 1;
                IF  shift
                THEN
                    BEGIN
                    closure_val_pos := val_pos;
                    shift := false
                    END;
                (*ENDIF*) 
                IF  (pat_pos > pat_len) AND (val_pos <= val_len)
                THEN
                    IF  NOT star_occurred
                    THEN
                        ok := false
                    ELSE
                        BEGIN
                        pat_pos := closure_pat_pos;
                        val_pos := closure_val_pos;
                        shift   := true
                        END
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            ELSE
                IF  shift
                THEN
                    BEGIN
                    IF  pat [ pat_offset + pat_pos ] <> csp_star1
                    THEN
                        val_pos := val_pos + 1
                    (*ENDIF*) 
                    END
                ELSE
                    IF  NOT star_occurred
                    THEN
                        ok := false
                    ELSE
                        BEGIN
                        val_pos := closure_val_pos;
                        pat_pos := closure_pat_pos;
                        shift   := true
                        END
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
            END
        (*ENDIF*) 
    UNTIL
        (pat_pos > pat_len) OR (val_pos > val_len ) OR NOT ok;
    (*ENDREPEAT*) 
    IF  (pat_pos > pat_len) AND (val_pos > val_len) AND ok
    THEN
        found := true;
    (*ENDIF*) 
    IF  (pat_pos <= pat_len) AND (val_pos > val_len) AND ok
    THEN
        BEGIN
        (* test trailing star1 *)
        found := true;
        REPEAT
            IF  (pat [ pat_offset + pat_pos ] <> csp_star1) AND
                (pat [ pat_offset + pat_pos ] <> pat_defbyte)
            THEN
                found := false
            ELSE
                pat_pos := pat_pos + 1
            (*ENDIF*) 
        UNTIL
            (pat_pos > pat_len) OR NOT found
        (*ENDREPEAT*) 
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
s49patmatch := found
END;
 
(*------------------------------*) 
 
PROCEDURE
      s49xtdbuild_pattern (
            VAR pat_buffer : tsp00_MoveObj;
            is_ascii    : boolean;
            start       : tsp00_Int4;
            stop        : tsp00_Int4;
            escape_char : char;
            pad_char    : char;
            escape      : boolean;
            string      : boolean;
            sqlmode     : tsp00_SqlMode;
            VAR ok      : boolean);
 
VAR
      cclass_open : boolean;
      crange_open : boolean;
      crange_rgt  : boolean;
      i           : tsp00_Int4;
      j           : tsp00_Int4;
      skip        : tsp00_Int4;
 
BEGIN
ok          := true;
i           := start;
cclass_open := false;
crange_open := false;
crange_rgt  := false;
skip        := 0;
j           := i;
IF  is_ascii
THEN
    BEGIN
    WHILE (i <= stop) AND ok DO
        BEGIN
        IF  (escape AND (pat_buffer[ i ] = escape_char))
        THEN
            BEGIN
            i               := succ(i);
            IF  ((sqlmode = sqlm_ansi)
                AND
                ((i > stop)
                OR
                ((pat_buffer[ i ] <> csp_ascii_percent) AND
                ( pat_buffer[ i ] <> csp_ascii_underline) AND
                ( pat_buffer[ i ] <> escape_char))))
            THEN
                ok := false
            ELSE
                IF  i <= stop
                THEN
                    BEGIN
                    pat_buffer[ j ] := pat_buffer[ i ];
                    skip            := succ(skip)
                    END
                (*ENDIF*) 
            (*ENDIF*) 
            END
        ELSE
            CASE pat_buffer[ i ] OF
                csp_ascii_percent :
                    IF  NOT cclass_open
                    THEN
                        pat_buffer [ j ] := csp_star1
                    ELSE
                        pat_buffer [ j ] := pat_buffer [ i ];
                    (*ENDIF*) 
                csp_ascii_star :
                    IF  (NOT cclass_open) AND (sqlmode = sqlm_internal)
                    THEN
                        pat_buffer [ j ] := csp_star1
                    ELSE
                        pat_buffer [ j ] := pat_buffer [ i ];
                    (*ENDIF*) 
                csp_ascii_underline :
                    IF  NOT cclass_open
                    THEN
                        pat_buffer [ j ] := csp_any1
                    ELSE
                        pat_buffer [ j ] := pat_buffer [ i ];
                    (*ENDIF*) 
                csp_ascii_question_mark :
                    IF  (NOT cclass_open) AND (sqlmode = sqlm_internal)
                    THEN
                        pat_buffer [ j ] := csp_any1
                    ELSE
                        pat_buffer [ j ] := pat_buffer [ i ];
                    (*ENDIF*) 
                csp_ascii_open_bracket :
                    IF  (NOT cclass_open) AND (sqlmode = sqlm_internal)
                    THEN
                        BEGIN
                        cclass_open      := true;
                        pat_buffer [ j ] := csp_cclass;
                        IF  (pat_buffer [ i + 1 ] = csp_ascii_not)
                            OR (pat_buffer [ i + 1 ] = csp_ascii_tilde)
                        THEN
                            BEGIN
                            i := i + 1;
                            j := j + 1;
                            pat_buffer [ j ] := csp_cnot;
                            END;
                        (*ENDIF*) 
                        END
                    ELSE
                        pat_buffer [ j ] := pat_buffer [ i ];
                    (*ENDIF*) 
                csp_ascii_close_bracket :
                    IF  cclass_open AND (sqlmode = sqlm_internal)
                    THEN
                        BEGIN
                        cclass_open      := false;
                        pat_buffer [ j ] := csp_cclass;
                        IF  pat_buffer [ j-1 ] in [ csp_cclass, csp_cnot ]
                        THEN
                            BEGIN
                            ok := false;
                            END
                        ELSE
                            IF  (pat_buffer[ j-2 ] = csp_cclass)
                                AND NOT string
                            THEN
                                BEGIN
                                pat_buffer[ j-2 ] := pat_buffer[ i-1 ];
                                skip              := skip + 2;
                                END
                            (*ENDIF*) 
                        (*ENDIF*) 
                        END
                    ELSE
                        pat_buffer [ j ] := pat_buffer [ i ];
                    (*ENDIF*) 
                csp_ascii_hyphen :
                    IF  cclass_open AND (sqlmode = sqlm_internal)
                    THEN
                        BEGIN
                        IF  NOT crange_open AND NOT crange_rgt
                        THEN
                            BEGIN
                            IF  ((pat_buffer [ j-1 ] < csp_cnot) OR
                                (pat_buffer [ j-1 ] > csp_star1)) AND
                                (pat_buffer [ i + 1 ] <> csp_ascii_close_bracket)
                            THEN
                                BEGIN
                                crange_open      := true;
                                pat_buffer [ j ] := csp_crange;
                                END
                            (*ENDIF*) 
                            END
                        ELSE
                            IF  crange_open
                            THEN
                                crange_rgt := true;
                            (*ENDIF*) 
                        (*ENDIF*) 
                        END
                    ELSE
                        pat_buffer [ j ] := pat_buffer [ i ];
                    (*ENDIF*) 
                OTHERWISE
                    BEGIN
                    pat_buffer[ j ] := pat_buffer[ i ];
                    END;
                END;
            (*ENDCASE*) 
        (*ENDIF*) 
        IF  crange_open AND ( pat_buffer [ j ] <> csp_crange )
        THEN
            BEGIN
            crange_open := false;
            crange_rgt := true
            END
        ELSE
            IF  crange_rgt
            THEN
                crange_rgt := false;
            (*ENDIF*) 
        (*ENDIF*) 
        i := i + 1;
        j := i - skip
        END
    (*ENDWHILE*) 
    END
ELSE (* not is_ascii *)
    BEGIN
    WHILE (i <= stop) AND ok DO
        BEGIN
        IF  (escape AND (pat_buffer[ i ] = escape_char))
        THEN
            BEGIN
            i := succ(i);
            IF  ((sqlmode = sqlm_ansi)
                AND
                ((i > stop)
                OR
                ((pat_buffer[ i ] <> csp_ebcdic_percent) AND
                ( pat_buffer[ i ] <> csp_ebcdic_underline) AND
                ( pat_buffer[ i ] <> escape_char))))
            THEN
                ok := false
            ELSE
                IF  i <= stop
                THEN
                    BEGIN
                    pat_buffer[ j ] := pat_buffer[ i ];
                    skip            := succ(skip)
                    END
                (*ENDIF*) 
            (*ENDIF*) 
            END
        ELSE
            CASE pat_buffer [ i ] OF
                csp_ebcdic_percent :
                    IF  NOT cclass_open
                    THEN
                        pat_buffer [ j ] := csp_star1
                    ELSE
                        pat_buffer [ j ] := pat_buffer [ i ];
                    (*ENDIF*) 
                csp_ebcdic_star :
                    IF  (NOT cclass_open) AND (sqlmode = sqlm_internal)
                    THEN
                        pat_buffer [ j ] := csp_star1
                    ELSE
                        pat_buffer [ j ] := pat_buffer [ i ];
                    (*ENDIF*) 
                csp_ebcdic_underline :
                    IF  NOT cclass_open
                    THEN
                        pat_buffer [ j ] := csp_any1
                    ELSE
                        pat_buffer [ j ] := pat_buffer [ i ];
                    (*ENDIF*) 
                csp_ebcdic_question_mark :
                    IF  (NOT cclass_open) AND (sqlmode = sqlm_internal)
                    THEN
                        pat_buffer [ j ] := csp_any1
                    ELSE
                        pat_buffer [ j ] := pat_buffer [ i ];
                    (*ENDIF*) 
                csp_ebcdic_open_bracket :
                    IF  (NOT cclass_open) AND (sqlmode = sqlm_internal)
                    THEN
                        BEGIN
                        cclass_open      := true;
                        pat_buffer [ j ] := csp_cclass;
                        IF  (pat_buffer [ i + 1 ] = csp_ebcdic_not)
                            OR (pat_buffer [ i + 1 ] = csp_ebcdic_tilde)
                        THEN
                            BEGIN
                            i := i + 1;
                            j := j + 1;
                            pat_buffer [ j ] := csp_cnot;
                            END;
                        (*ENDIF*) 
                        END
                    ELSE
                        pat_buffer [ j ] := pat_buffer [ i ];
                    (*ENDIF*) 
                csp_ebcdic_close_bracket :
                    IF  cclass_open AND (sqlmode = sqlm_internal)
                    THEN
                        BEGIN
                        cclass_open      := false;
                        pat_buffer [ j ] := csp_cclass;
                        IF  pat_buffer [ j-1 ] in [ csp_cclass, csp_cnot ]
                        THEN
                            BEGIN
                            ok := false
                            END
                        ELSE
                            IF  (pat_buffer[ j-2 ] = csp_cclass)
                                AND NOT string
                            THEN
                                BEGIN
                                pat_buffer[ j-2 ] :=
                                      pat_buffer[ i-1 ];
                                skip := skip + 2;
                                END
                            (*ENDIF*) 
                        (*ENDIF*) 
                        END
                    ELSE
                        pat_buffer [ j ] := pat_buffer [ i ];
                    (*ENDIF*) 
                csp_ebcdic_hyphen :
                    IF  cclass_open AND (sqlmode = sqlm_internal)
                    THEN
                        BEGIN
                        IF  NOT crange_open AND NOT crange_rgt
                        THEN
                            BEGIN
                            IF  ((pat_buffer [ j-1 ] < csp_cnot) OR
                                (pat_buffer [ j-1 ] > csp_star1)) AND
                                (pat_buffer [ i + 1 ]
                                <> csp_ebcdic_close_bracket)
                            THEN
                                BEGIN
                                crange_open      := true;
                                pat_buffer [ j ] := csp_crange;
                                END
                            (*ENDIF*) 
                            END
                        ELSE
                            IF  crange_open
                            THEN
                                crange_rgt := true;
                            (*ENDIF*) 
                        (*ENDIF*) 
                        END
                    ELSE
                        pat_buffer [ j ] := pat_buffer [ i ];
                    (*ENDIF*) 
                OTHERWISE
                    BEGIN
                    pat_buffer[ j ] := pat_buffer[ i ];
                    END;
                END;
            (*ENDCASE*) 
        (*ENDIF*) 
        IF  crange_open AND ( pat_buffer [ j ] <> csp_crange )
        THEN
            BEGIN
            crange_open := false;
            crange_rgt  := true
            END
        ELSE
            IF  crange_rgt
            THEN
                crange_rgt := false;
            (*ENDIF*) 
        (*ENDIF*) 
        i := i + 1;
        j := i - skip
        END
    (*ENDWHILE*) 
    END;
(*ENDIF*) 
IF  (skip > 0) AND NOT string
THEN
    FOR j := i - skip TO stop DO
        (* pat_buffer[ j ] := pat_buffer[ start-1 ]; --old version--*)
        pat_buffer[ j ] := pad_char;
    (*ENDFOR*) 
(*ENDIF*) 
IF  cclass_open
THEN
    ok := false
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      s49uni_build_pattern (
            VAR pat_buffer : tsp00_MoveObj;
            start       : tsp00_Int4;
            stop        : tsp00_Int4;
            escape_char : tsp00_C2;
            escape      : boolean;
            sqlmode     : tsp00_SqlMode;
            VAR ok      : boolean);
 
VAR
      cclass_open : boolean;
      crange_open : boolean;
      crange_rgt  : boolean;
      i           : tsp00_Int4;
      j           : tsp00_Int4;
      skip        : tsp00_Int4;
 
BEGIN
ok          := true;
i           := start;
cclass_open := false;
crange_open := false;
crange_rgt  := false;
skip        := 0;
j           := i;
WHILE (i < stop) AND ok DO
    BEGIN
    IF  (escape AND
        (pat_buffer[ i   ] = escape_char[ 1 ]) AND
        (pat_buffer[ i+1 ] = escape_char[ 2 ]))
    THEN
        BEGIN
        i               := i + 2;
        IF  ((sqlmode = sqlm_ansi)
            AND
            ((i > stop)
            OR
            (
            (pat_buffer[ i ] <> csp_unicode_mark)
            OR
            ((pat_buffer[ i+1 ] <> csp_ascii_percent) AND
            ( pat_buffer[ i+1 ] <> csp_ascii_underline)))
            AND
            ((pat_buffer[ i   ] <> escape_char[ 1 ]) OR
            ( pat_buffer[ i+1 ] <> escape_char[ 2 ]))))
        THEN
            ok := false
        ELSE
            IF  i <= stop
            THEN
                BEGIN
                pat_buffer[ j   ] := pat_buffer[ i   ];
                pat_buffer[ j+1 ] := pat_buffer[ i+1 ];
                skip              := skip + 2
                END
            (*ENDIF*) 
        (*ENDIF*) 
        END
    ELSE
        IF  pat_buffer[ i ] = csp_unicode_mark
        THEN
            BEGIN
            pat_buffer[ j   ] := pat_buffer[ i   ];
            CASE pat_buffer[ i+1 ] OF
                csp_ascii_percent :
                    IF  NOT cclass_open
                    THEN
                        pat_buffer [ j+1 ] := csp_star1
                    ELSE
                        pat_buffer [ j+1 ] := pat_buffer [ i+1 ];
                    (*ENDIF*) 
                csp_ascii_star :
                    IF  (NOT cclass_open) AND (sqlmode = sqlm_internal)
                    THEN
                        pat_buffer [ j+1 ] := csp_star1
                    ELSE
                        pat_buffer [ j+1 ] := pat_buffer [ i+1 ];
                    (*ENDIF*) 
                csp_ascii_underline :
                    IF  NOT cclass_open
                    THEN
                        pat_buffer [ j+1 ] := csp_any1
                    ELSE
                        pat_buffer [ j+1 ] := pat_buffer [ i+1 ];
                    (*ENDIF*) 
                csp_ascii_question_mark :
                    IF  (NOT cclass_open) AND (sqlmode = sqlm_internal)
                    THEN
                        pat_buffer [ j+1 ] := csp_any1
                    ELSE
                        pat_buffer [ j+1 ] := pat_buffer [ i+1 ];
                    (*ENDIF*) 
                csp_ascii_open_bracket :
                    IF  (NOT cclass_open) AND (sqlmode = sqlm_internal)
                    THEN
                        BEGIN
                        cclass_open      := true;
                        pat_buffer [ j+1 ] := csp_cclass;
                        IF  (pat_buffer [ i + 2 ] = csp_unicode_mark)
                            AND
                            ((pat_buffer [ i + 3 ] = csp_ascii_not)
                            OR (pat_buffer [ i + 3 ] = csp_ascii_tilde))
                        THEN
                            BEGIN
                            i := i + 2;
                            j := j + 2;
                            pat_buffer [ j   ] := csp_unicode_mark;
                            pat_buffer [ j+1 ] := csp_cnot;
                            END;
                        (*ENDIF*) 
                        END
                    ELSE
                        pat_buffer [ j+1 ] := pat_buffer [ i+1 ];
                    (*ENDIF*) 
                csp_ascii_close_bracket :
                    IF  cclass_open AND (sqlmode = sqlm_internal)
                    THEN
                        BEGIN
                        cclass_open      := false;
                        pat_buffer [ j+1 ] := csp_cclass;
                        IF  (pat_buffer [ j-2 ] = csp_unicode_mark) AND
                            (pat_buffer [ j-1 ] in [ csp_cclass, csp_cnot ])
                        THEN
                            BEGIN
                            ok := false;
                            END
                        ELSE
                            IF  (pat_buffer[ j-4 ] = csp_unicode_mark) AND
                                (pat_buffer[ j-3 ] = csp_cclass)
                            THEN
                                BEGIN
                                pat_buffer[ j-4 ] := pat_buffer[ i-2 ];
                                pat_buffer[ j-3 ] := pat_buffer[ i-1 ];
                                skip              := skip + 4;
                                END
                            (*ENDIF*) 
                        (*ENDIF*) 
                        END
                    ELSE
                        pat_buffer [ j+1 ] := pat_buffer [ i+1 ];
                    (*ENDIF*) 
                csp_ascii_hyphen :
                    IF  cclass_open AND (sqlmode = sqlm_internal)
                    THEN
                        BEGIN
                        IF  NOT crange_open AND NOT crange_rgt
                        THEN
                            BEGIN
                            IF  ((pat_buffer [ j-2 ] <> csp_unicode_mark) OR
                                ((pat_buffer [ j-2 ] = csp_unicode_mark) AND
                                ((pat_buffer [ j-1 ] < csp_cnot) OR
                                (pat_buffer [ j-1 ] > csp_star1)))) AND
                                ((pat_buffer [ i + 2 ] <> csp_unicode_mark) OR
                                (pat_buffer [ i + 3 ] <> csp_ascii_close_bracket))
                            THEN
                                BEGIN
                                crange_open        := true;
                                pat_buffer [ j+1 ] := csp_crange;
                                END
                            (*ENDIF*) 
                            END
                        ELSE
                            IF  crange_open
                            THEN
                                crange_rgt := true;
                            (*ENDIF*) 
                        (*ENDIF*) 
                        END
                    ELSE
                        pat_buffer [ j+1 ] := pat_buffer [ i+1 ];
                    (*ENDIF*) 
                OTHERWISE
                    BEGIN
                    pat_buffer[ j   ] := pat_buffer[ i   ];
                    pat_buffer[ j+1 ] := pat_buffer[ i+1 ];
                    END;
                END
            (*ENDCASE*) 
            END
        ELSE
            BEGIN
            pat_buffer[ j   ] := pat_buffer[ i   ];
            pat_buffer[ j+1 ] := pat_buffer[ i+1 ];
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    IF  crange_open AND
        ((pat_buffer [ j   ] <> csp_unicode_mark) OR
        ( pat_buffer [ j+1 ] <> csp_crange ))
    THEN
        BEGIN
        crange_open := false;
        crange_rgt := true
        END
    ELSE
        IF  crange_rgt
        THEN
            crange_rgt := false;
        (*ENDIF*) 
    (*ENDIF*) 
    i := i + 2;
    j := i - skip
    END;
(*ENDWHILE*) 
IF  skip > 0
THEN
    BEGIN
    j := i - skip;
    WHILE j < stop DO
        BEGIN
        pat_buffer[ j   ] := csp_unicode_mark;
        pat_buffer[ j+1 ] := bsp_c1;
        j := j + 2
        END;
    (*ENDWHILE*) 
    END;
(*ENDIF*) 
IF  cclass_open
THEN
    ok := false
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      s49upatmatch (
            VAR val     : tsp00_MoveObj;
            val_offset  : tsp00_Int4;
            val_len     : tsp00_Int4;
            VAR pat     : tsp00_MoveObj;
            pat_offset  : tsp00_Int4;
            pat_len     : tsp00_Int4) : boolean;
      (* not recursive *)
 
VAR
      found           : boolean;
      match           : boolean;
      ok              : boolean;
      shift           : boolean;
      star_occurred   : boolean;
      act_pat_ch      : tsp00_C2;
      val_pos         : tsp00_Int4;
      pat_pos         : tsp00_Int4;
      closure_val_pos : tsp00_Int4;
      closure_pat_pos : tsp00_Int4;
      pat_incr        : tsp00_Int4;
 
BEGIN
(* prerequisite: val_len > 0 AND pat_len > 0 *)
found         := false;
ok            := true;
shift         := false;
star_occurred := false;
pat_pos       := 1;
val_pos       := 1;
act_pat_ch[1] := pat [ pat_offset + 1 ];
act_pat_ch[2] := pat [ pat_offset + 2 ];
IF  (pat_len = 2) AND
    ( act_pat_ch[ 1 ] = csp_unicode_mark) AND
    ((act_pat_ch[ 2 ] = csp_star1) OR (act_pat_ch[ 2 ] = csp_any1))
THEN
    BEGIN
    found := true;
    IF  (act_pat_ch[ 2 ] = csp_any1) AND (val_len > 2)
    THEN
        found := false
    (*ENDIF*) 
    END
ELSE
    BEGIN
    REPEAT
        IF  (pat [ pat_offset + pat_pos     ] = csp_unicode_mark) AND
            (pat [ pat_offset + pat_pos + 1 ] = csp_star1)
        THEN
            BEGIN
            pat_pos         := pat_pos + 2;
            shift           := true;
            star_occurred   := true;
            closure_pat_pos := pat_pos;
            closure_val_pos := 0;
            IF  pat_pos > pat_len
            THEN
                found := true
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  pat_pos <= pat_len
        THEN
            BEGIN
            match := false;
            IF  ((pat[ pat_offset+pat_pos   ] = val[ val_offset+val_pos  ]) AND
                ( pat[ pat_offset+pat_pos+1 ] = val[ val_offset+val_pos+1]))
                OR
                ((pat[ pat_offset + pat_pos   ] = csp_unicode_mark) AND
                (pat[ pat_offset + pat_pos+1 ] = csp_any1))
            THEN
                BEGIN
                pat_incr := 2;
                match    := true
                END
            ELSE
                IF  ((pat[ pat_offset + pat_pos   ] = csp_unicode_mark) AND
                    (pat[ pat_offset + pat_pos+1 ] = csp_cclass))
                THEN
                    match := sp49uonecmatch (pat, pat_offset + pat_pos,
                          val, val_offset + val_pos, pat_incr);
                (*ENDIF*) 
            (*ENDIF*) 
            IF  match
            THEN
                BEGIN
                pat_pos := pat_pos + pat_incr;
                val_pos := val_pos + 2;
                IF  shift
                THEN
                    BEGIN
                    closure_val_pos := val_pos;
                    shift := false
                    END;
                (*ENDIF*) 
                IF  (pat_pos > pat_len) AND (val_pos <= val_len)
                THEN
                    IF  NOT star_occurred
                    THEN
                        ok := false
                    ELSE
                        BEGIN
                        pat_pos := closure_pat_pos;
                        val_pos := closure_val_pos;
                        shift   := true
                        END
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            ELSE
                IF  shift
                THEN
                    BEGIN
                    IF  (pat [ pat_offset + pat_pos     ] <> csp_unicode_mark) OR
                        (pat [ pat_offset + pat_pos + 1 ] <> csp_star1)
                    THEN
                        val_pos := val_pos + 2
                    (*ENDIF*) 
                    END
                ELSE
                    IF  NOT star_occurred
                    THEN
                        ok := false
                    ELSE
                        BEGIN
                        val_pos := closure_val_pos;
                        pat_pos := closure_pat_pos;
                        shift   := true
                        END
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
            END
        (*ENDIF*) 
    UNTIL
        (pat_pos > pat_len) OR (val_pos > val_len ) OR NOT ok;
    (*ENDREPEAT*) 
    IF  (pat_pos > pat_len) AND (val_pos > val_len) AND ok
    THEN
        found := true;
    (*ENDIF*) 
    IF  (pat_pos <= pat_len) AND (val_pos > val_len) AND ok
    THEN
        BEGIN
        (* test trailing star1 *)
        found := true;
        REPEAT
            IF  (pat [ pat_offset + pat_pos     ] <> csp_unicode_mark) OR
                ((pat [ pat_offset + pat_pos + 1 ] <> csp_star1) AND
                ( pat [ pat_offset + pat_pos + 1 ] <> csp_ascii_blank))
            THEN
                found := false
            ELSE
                pat_pos := pat_pos + 2
            (*ENDIF*) 
        UNTIL
            (pat_pos > pat_len) OR NOT found
        (*ENDREPEAT*) 
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
s49upatmatch := found
END;
 
(*------------------------------*) 
 
FUNCTION
      sp49uonecmatch  (
            VAR pat      : tsp00_MoveObj;
            s_pos        : tsp00_Int4;
            VAR val      : tsp00_MoveObj;
            comp_ch_pos  : tsp00_Int4;
            VAR pat_incr : tsp00_Int4 ) : boolean;
 
VAR
      found         : boolean;
      is_end        : boolean;
      is_error      : boolean;
      negated_class : boolean;
      state         : tsp00_Int4;
      pos           : tsp00_Int4;
      left_pos      : tsp00_Int4;
      cl_start      : tsp00_Int4;
      comp_ch       : tsp00_C2;
 
BEGIN
comp_ch[ 1 ] := val[ comp_ch_pos   ];
comp_ch[ 2 ] := val[ comp_ch_pos+1 ];
is_end   := false;
is_error := false;
found    := false;
state    := 1;
pos      := s_pos;
IF  (pat [ pos   ] = csp_unicode_mark) AND
    (pat [ pos+1 ] = csp_cclass)
THEN
    BEGIN
    cl_start := pos;
    negated_class := false;
    IF  (pat [ pos + 2 ] = csp_unicode_mark) AND
        (pat [ pos + 3 ] = csp_cnot)
    THEN
        BEGIN
        negated_class := true;
        pos := pos + 2
        END;
    (*ENDIF*) 
    pos      := pos + 2;
    WHILE NOT (found OR is_end) AND NOT is_error DO
        CASE state OF
            1 :
                BEGIN
                IF  (pat [ pos   ] = comp_ch[ 1 ]) AND
                    (pat [ pos+1 ] = comp_ch[ 2 ])
                THEN
                    found := true
                ELSE
                    IF  (pat [ pos   ] = csp_unicode_mark) AND
                        (pat [ pos+1 ] = csp_cclass)
                    THEN
                        is_end := true
                    ELSE
                        IF  (pat [ pos   ] = csp_unicode_mark) AND
                            (pat [ pos+1 ] = csp_crange)
                        THEN
                            is_error := true
                        ELSE
                            BEGIN
                            left_pos := pos;
                            pos := pos + 2;
                            IF  (pat [ pos   ] = csp_unicode_mark) AND
                                (pat [ pos+1 ] = csp_crange)
                            THEN
                                state := 2
                            ELSE
                                IF  (pat [ pos   ] = csp_unicode_mark) AND
                                    (pat [ pos+1 ] = csp_cclass)
                                THEN
                                    is_end := true;
                                (*ENDIF*) 
                            (*ENDIF*) 
                            END
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            2 :
                BEGIN
                pos := pos + 2;
                IF  (    pat [ pos   ] <> csp_unicode_mark) OR
                    NOT (pat [ pos+1 ] in [ csp_cclass, csp_crange ])
                THEN
                    state := 3
                ELSE
                    is_error := true;
                (*ENDIF*) 
                END;
            3 :
                BEGIN
                IF  ((pat [ left_pos   ] =  pat [ pos   ]) AND
                    ( pat [ left_pos+1 ] <= pat [ pos+1 ]))
                    OR
                    ( pat [ left_pos   ] <  pat [ pos   ])
                THEN
                    found :=
                          (
                          ((pat [ left_pos   ] =  comp_ch [ 1 ]) AND
                          ( pat [ left_pos+1 ] <= comp_ch [ 2 ]))
                          OR
                          ( pat [ left_pos   ] <  comp_ch [ 1 ])
                          )
                          AND
                          (
                          ((pat [ pos   ] =  comp_ch [ 1 ]) AND
                          ( pat [ pos+1 ] >= comp_ch [ 2 ]))
                          OR
                          ( pat [ pos   ] >  comp_ch [ 1 ])
                          )
                ELSE
                    found :=
                          (
                          ((pat [ left_pos   ] =  comp_ch [ 1 ]) AND
                          ( pat [ left_pos+1 ] >= comp_ch [ 2 ]))
                          OR
                          ( pat [ left_pos   ] >  comp_ch [ 1 ])
                          )
                          AND
                          (
                          ((pat [ pos   ] =  comp_ch [ 1 ]) AND
                          ( pat [ pos+1 ] <= comp_ch [ 2 ]))
                          OR
                          ( pat [ pos   ] <  comp_ch [ 1 ])
                          );
                (*ENDIF*) 
                IF  NOT found
                THEN
                    pos := pos + 2;
                (*ENDIF*) 
                state := 1
                END;
            END;
        (*ENDCASE*) 
    (*ENDWHILE*) 
    IF  found
    THEN
        BEGIN
        IF  negated_class
        THEN
            found := false
        (*ENDIF*) 
        END
    ELSE (* not found *)
        IF  negated_class
        THEN
            found := true;
        (*ENDIF*) 
    (*ENDIF*) 
    IF  found
    THEN
        BEGIN
        WHILE (pat[ pos   ] <> csp_unicode_mark) OR
              (pat[ pos+1 ] <> csp_cclass) DO
            pos := pos + 2;
        (*ENDWHILE*) 
        pat_incr := pos - cl_start + 2
        END
    ELSE
        pat_incr := 0;
    (*ENDIF*) 
    END;
(*ENDIF*) 
sp49uonecmatch := found;
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :        411
*-PRETTY-*  lines of code :       1228        PRETTYX 3.10 
*-PRETTY-*  lines in file :       1374         1997-12-10 
.PA 
