- 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
