BMXPRS ; IHS/OIT/HMW - BMX WINDOWS UTILS ;
;;4.0;BMX;;JUN 28, 2010
;
;
PARSE(X) ;EP-Parse SQL Statement into array
;Input SQL statement as X
;Returns BMXTK() array
;Errors returned in BMXERR
;
D PRE
Q:$D(BMXERR)
D POST
Q
;
POST2 ;EP - Remove commas from BMXTK
N J,K
S J=0 F S J=$O(BMXTK(J)) Q:'+J D
. S K=$O(BMXTK(J))
. I +K,","=$G(BMXTK(K)) D
. . K BMXTK(K)
. . D PACK(J)
. . Q
. Q
Q
;
POST ;
;Combine multi-character operators
N J
S J=0 F S J=$O(BMXTK(J)) Q:'+J D
. I ">"=BMXTK(J) D Q
. . I "="[$G(BMXTK(J+1)) D Q
. . . S BMXTK(J)=BMXTK(J)_"="
. . . K BMXTK(J+1)
. . . D PACK(J)
. . I "<"[$G(BMXTK(J+1)) D Q
. . . S BMXTK(J)="<"_BMXTK(J)
. . . K BMXTK(J+1)
. . . D PACK(J)
. I "<"=BMXTK(J) D Q
. . I "=>"[$G(BMXTK(J+1)) D
. . . S BMXTK(J)=BMXTK(J)_BMXTK(J+1)
. . . K BMXTK(J+1)
. . . D PACK(J)
. I "="=BMXTK(J) D Q
. . I "<>"[$G(BMXTK(J+1)) D
. . . S BMXTK(J)=BMXTK(J+1)_BMXTK(J)
. . . K BMXTK(J+1)
. . . D PACK(J)
Q
;
PACK(J) ;
F S J=$O(BMXTK(J)) Q:'+J D
. S BMXTK(J-1)=BMXTK(J)
. K BMXTK(J)
Q
;
PRE N P,T,Q,Q1,A,B S (P,T,Q)=0,BMXTK="",A=0
START S A=A+1
S B=$E(X,A)
I B="" G B5
I 'Q G QUOTE
I B=$C(39) G QUOTE
S BMXTK=BMXTK_B G START
QUOTE I B'=$C(39) G SPACE
I Q G QUOTE2
;S Q=1,BMXTK=B G START
S Q=1,BMXTK=BMXTK_B G START
QUOTE2 S Q1=B,A=A+1,B=$E(X,A)
I B']"" G QUOTE3
I B'=$C(39) G QUOTE3
S BMXTK=BMXTK_Q1_B G START
QUOTE3 S A=A-1,B=Q1,BMXTK=BMXTK_B,Q=0 G START
SPACE I B'=" " G OP
I BMXTK]"" S T=T+1,BMXTK(T)=BMXTK,BMXTK=""
G START
OP I "=><"'[B G OPAREN
I BMXTK]"" S T=T+1,BMXTK(T)=BMXTK,BMXTK=""
S T=T+1,BMXTK(T)=B,BMXTK=""
G START
OPAREN I B'="(" G CPAREN
S P=P+1
I BMXTK]"" S T=T+1,BMXTK(T)=BMXTK,BMXTK=""
S T=T+1,BMXTK(T)=B G START
CPAREN I B'=")" G B2
I P G B1
G B0
;
B0 S BMXERR="SQL SYNTAX ERROR" D ERROR G B5
B1 S P=P-1
I BMXTK]"" S T=T+1,BMXTK(T)=BMXTK,BMXTK=""
S T=T+1,BMXTK(T)=B G START
B2 I B'="," G B3
S T=T+1,BMXTK(T)=BMXTK,T=T+1,BMXTK(T)=",",BMXTK="" G START
B3 S BMXTK=BMXTK_B
B4 G START
B5 I BMXTK]"" S T=T+1,BMXTK(T)=BMXTK
I $D(BMXERR) G B6
I P S BMXERR="SQL SYNTAX ERROR: MATCHING PARENTHESIS NOT FOUND" D ERROR
E I Q S BMXERR="SQL SYNTAX ERROR: MATCHING QUOTE NOT FOUND" D ERROR
I P>0 G START
B6 Q
;
ERROR ;W !,"ERROR=",BMXERR,! Q
Q
BMXPRS ; IHS/OIT/HMW - BMX WINDOWS UTILS ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ;
+3 ;
PARSE(X) ;EP-Parse SQL Statement into array
+1 ;Input SQL statement as X
+2 ;Returns BMXTK() array
+3 ;Errors returned in BMXERR
+4 ;
+5 DO PRE
+6 IF $DATA(BMXERR)
QUIT
+7 DO POST
+8 QUIT
+9 ;
POST2 ;EP - Remove commas from BMXTK
+1 NEW J,K
+2 SET J=0
FOR
SET J=$ORDER(BMXTK(J))
IF '+J
QUIT
Begin DoDot:1
+3 SET K=$ORDER(BMXTK(J))
+4 IF +K
IF ","=$GET(BMXTK(K))
Begin DoDot:2
+5 KILL BMXTK(K)
+6 DO PACK(J)
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
POST ;
+1 ;Combine multi-character operators
+2 NEW J
+3 SET J=0
FOR
SET J=$ORDER(BMXTK(J))
IF '+J
QUIT
Begin DoDot:1
+4 IF ">"=BMXTK(J)
Begin DoDot:2
+5 IF "="[$GET(BMXTK(J+1))
Begin DoDot:3
+6 SET BMXTK(J)=BMXTK(J)_"="
+7 KILL BMXTK(J+1)
+8 DO PACK(J)
End DoDot:3
QUIT
+9 IF "<"[$GET(BMXTK(J+1))
Begin DoDot:3
+10 SET BMXTK(J)="<"_BMXTK(J)
+11 KILL BMXTK(J+1)
+12 DO PACK(J)
End DoDot:3
QUIT
End DoDot:2
QUIT
+13 IF "<"=BMXTK(J)
Begin DoDot:2
+14 IF "=>"[$GET(BMXTK(J+1))
Begin DoDot:3
+15 SET BMXTK(J)=BMXTK(J)_BMXTK(J+1)
+16 KILL BMXTK(J+1)
+17 DO PACK(J)
End DoDot:3
End DoDot:2
QUIT
+18 IF "="=BMXTK(J)
Begin DoDot:2
+19 IF "<>"[$GET(BMXTK(J+1))
Begin DoDot:3
+20 SET BMXTK(J)=BMXTK(J+1)_BMXTK(J)
+21 KILL BMXTK(J+1)
+22 DO PACK(J)
End DoDot:3
End DoDot:2
QUIT
End DoDot:1
+23 QUIT
+24 ;
PACK(J) ;
+1 FOR
SET J=$ORDER(BMXTK(J))
IF '+J
QUIT
Begin DoDot:1
+2 SET BMXTK(J-1)=BMXTK(J)
+3 KILL BMXTK(J)
End DoDot:1
+4 QUIT
+5 ;
PRE NEW P,T,Q,Q1,A,B
SET (P,T,Q)=0
SET BMXTK=""
SET A=0
START SET A=A+1
+1 SET B=$EXTRACT(X,A)
+2 IF B=""
GOTO B5
+3 IF 'Q
GOTO QUOTE
+4 IF B=$CHAR(39)
GOTO QUOTE
+5 SET BMXTK=BMXTK_B
GOTO START
QUOTE IF B'=$CHAR(39)
GOTO SPACE
+1 IF Q
GOTO QUOTE2
+2 ;S Q=1,BMXTK=B G START
+3 SET Q=1
SET BMXTK=BMXTK_B
GOTO START
QUOTE2 SET Q1=B
SET A=A+1
SET B=$EXTRACT(X,A)
+1 IF B']""
GOTO QUOTE3
+2 IF B'=$CHAR(39)
GOTO QUOTE3
+3 SET BMXTK=BMXTK_Q1_B
GOTO START
QUOTE3 SET A=A-1
SET B=Q1
SET BMXTK=BMXTK_B
SET Q=0
GOTO START
SPACE IF B'=" "
GOTO OP
+1 IF BMXTK]""
SET T=T+1
SET BMXTK(T)=BMXTK
SET BMXTK=""
+2 GOTO START
OP IF "=><"'[B
GOTO OPAREN
+1 IF BMXTK]""
SET T=T+1
SET BMXTK(T)=BMXTK
SET BMXTK=""
+2 SET T=T+1
SET BMXTK(T)=B
SET BMXTK=""
+3 GOTO START
OPAREN IF B'="("
GOTO CPAREN
+1 SET P=P+1
+2 IF BMXTK]""
SET T=T+1
SET BMXTK(T)=BMXTK
SET BMXTK=""
+3 SET T=T+1
SET BMXTK(T)=B
GOTO START
CPAREN IF B'=")"
GOTO B2
+1 IF P
GOTO B1
+2 GOTO B0
+3 ;
B0 SET BMXERR="SQL SYNTAX ERROR"
DO ERROR
GOTO B5
B1 SET P=P-1
+1 IF BMXTK]""
SET T=T+1
SET BMXTK(T)=BMXTK
SET BMXTK=""
+2 SET T=T+1
SET BMXTK(T)=B
GOTO START
B2 IF B'=","
GOTO B3
+1 SET T=T+1
SET BMXTK(T)=BMXTK
SET T=T+1
SET BMXTK(T)=","
SET BMXTK=""
GOTO START
B3 SET BMXTK=BMXTK_B
B4 GOTO START
B5 IF BMXTK]""
SET T=T+1
SET BMXTK(T)=BMXTK
+1 IF $DATA(BMXERR)
GOTO B6
+2 IF P
SET BMXERR="SQL SYNTAX ERROR: MATCHING PARENTHESIS NOT FOUND"
DO ERROR
+3 IF '$TEST
IF Q
SET BMXERR="SQL SYNTAX ERROR: MATCHING QUOTE NOT FOUND"
DO ERROR
+4 IF P>0
GOTO START
B6 QUIT
+1 ;
ERROR ;W !,"ERROR=",BMXERR,! Q
+1 QUIT
