source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXMBRK.m@ 832

Last change on this file since 832 was 645, checked in by Sam Habiel, 15 years ago

Initial Import of BMX.net code
File size: 6.0 KB
Line 
1BMXMBRK ; IHS/OIT/HMW - BMXNet MONITOR ;
2 ;;2.1;BMX;;Jul 26, 2009
3 ;
4 ;
5PRSP(P) ;EP -Parse Protocol
6 ;M Extrinsic Function
7 ;
8 ;Inputs
9 ;P Protocol string with the form
10 ; Protocol := Protocol Header^Message where
11 ; Protocol Header := LLLWKID;WINH;PRCH;WISH;MESG
12 ; LLL := length of protocol header (3 numeric)
13 ; WKID := Workstation ID (ALPHA)
14 ; WINH := Window handle (ALPHA)
15 ; PRCH := Process handle (ALPHA)
16 ; WISH := Window server handle (ALPHA)
17 ; MESG := Unparsed message
18 ;Outputs
19 ;ERR 0 for success, "-1^Text" if error
20 ;
21 N ERR,C,M,R,X
22 S R=0,C=";",ERR=0,M=512 ;Maximum buffer input
23 IF $E(P,1,5)="{BMX}" S P=$E(P,6,$L(P)) ;drop out prefix
24 IF '+$G(P) S ERR="-1^Required input reference is NULL"
25 IF +ERR=0 D
26 . S BMXZ(R,"LENG")=+$E(P,1,3)
27 . S X=$E(P,4,BMXZ(R,"LENG")+3)
28 . S BMXZ(R,"MESG")=$E(P,BMXZ(R,"LENG")+4,M)
29 . S BMXZ(R,"WKID")=$P(X,C)
30 . S BMXZ(R,"WINH")=$P(X,C,2)
31 . S BMXZ(R,"PRCH")=$P(X,C,3)
32 . S BMXZ(R,"WISH")=$P(X,C,4)
33 Q ERR
34 ;
35PRSM(P) ;EP - Parse message
36 ;M Extrinsic Function
37 ;
38 ;Inputs
39 ;P Message string with the form
40 ; Message := Header^Content
41 ; Header := LLL;FLAG
42 ; LLL := length of entire message (3 numeric)
43 ; FLAG := 1 indicates variables follow
44 ; Content := Contains API call information
45 ;Outputs
46 ;ERR 0 for success, "-1^Text" if error
47 N C,ERR,M,R,X,U
48 S U="^",R=1,C=";",ERR=0,M=512 ;Max buffer
49 IF '+$G(P) S ERR="-1^Required input reference is NULL"
50 IF +ERR=0 D
51 . S BMXZ(R,"LENG")=+$E(P,1,5)
52 . S BMXZ(R,"FLAG")=$E(P,6,6)
53 . S BMXZ(R,"TEXT")=$E(P,7,M)
54 Q ERR
55 ;
56PRSA(P) ;EP - Parse API information, get calling info
57 ;M Extrinsic Function
58 ;Inputs
59 ;P Content := API Name^Param string
60 ; API := .01 field of API file
61 ; Param := Parameter information
62 ;Outputs
63 ;ERR 0 for success, "-1^Text" if error
64 ;
65 N C,DR,ERR,M,R,T,X,U
66 S U="^",R=2,C=";",ERR=0,M=512 ;Max buffer
67 IF '+$L(P) S ERR="-1^Required input reference is NULL"
68 IF +ERR=0 D
69 . S BMXZ(R,"CAPI")=$P(P,U)
70 . S BMXZ(R,"PARM")=$E(P,$F(P,U),M)
71 . S T=$O(^XWB(8994,"B",BMXZ(R,"CAPI"),0))
72 . I '+T S ERR="-1^Remote Procedure '"_BMXZ(R,"CAPI")_"' doesn't exist on the server." Q ;P10 - dpc
73 . S T(0)=$G(^XWB(8994,T,0))
74 . I $P(T(0),U,6)=1!($P(T(0),U,6)=2) S ERR="-1^Remote Procedure '"_BMXZ(R,"CAPI")_"' cannot be run at this time." Q ;P10. Check INACTIVE field. - dpc.
75 . S BMXZ(R,"NAME")=$P(T(0),"^")
76 . S BMXZ(R,"RTAG")=$P(T(0),"^",2)
77 . S BMXZ(R,"RNAM")=$P(T(0),"^",3)
78 . S BMXPTYPE=$P(T(0),"^",4)
79 . S BMXWRAP=+$P(T(0),"^",8)
80 Q ERR
81 ;
82PRSB(P) ;EP - Parse Parameter information
83 ;M Extrinsic Function
84 ;Inputs
85 ;P Param := M parameter list
86 ; Param := LLL,Name,Value
87 ; LLL := length of variable name and value
88 ; Name := name of M variable
89 ; Value := a string
90 ;Outputs
91 ;ERR 0 for success, "-1^Text" if error
92 ;
93 N A,ERR,F,FL,I,K,L,M,P1,P2,P3,P4,P5,MAXP,R
94 S R=3,MAXP=+$E(P,1,5)
95 S P1=$E(P,6,MAXP+5) ;only param string
96 S ERR=0,F=3,M=512
97 IF '+$D(P) S ERR="-1^Required input reference is NULL"
98 S FL=+$G(BMXZ(1,"FLAG"))
99 S I=0
100 IF '+ERR D
101 . IF 'FL,+MAXP=0 S P1="",ERR=1 Q
102 . F D Q:P1=""
103 . . Q:P1=""
104 . . S L=+$E(P1,1,3)-1
105 . . S P3=+$E(P1,4,4)
106 . . S P1=$E(P1,5,MAXP)
107 . . S BMXZ(R,"P",I)=$S(P3'=1:$E(P1,1,L),1:$$GETV($E(P1,1,L)))
108 . . IF FL=1,P3=2 D ;XWB*1.1*2
109 . . . S A=$$OARY^BMXMBRK2,BMXARY=A
110 . . . S BMXZ(R,"P",I)=$$CREF^BMXMBRK2(A,BMXZ(R,"P",I))
111 . . S P1=$E(P1,L+1,MAXP)
112 . . S K=I,I=I+1
113 . IF 'FL Q
114 . S P3=P
115 . S L=+$E(P3,1,5)
116 . S P1=$E(P3,F+3,L+F)
117 . S P2=$E(P3,L+F+3,M)
118 . ;instantiate array
119 . F D Q:+L=0
120 . . S L=$$BREAD(3) Q:+L=0 S P3=$$BREAD(L)
121 . . S L=$$BREAD(3) IF +L'=0 S P4=$$BREAD(L)
122 . . IF +L=0 Q
123 . . IF P3=0,P4=0 S L=0 Q
124 . . IF FL=1 D LINST(A,P3,P4)
125 . . IF FL=2 D GINST
126 IF ERR Q P1
127 S P1=""
128 D Q P1
129 . F I=0:1:K D
130 . . IF FL,$E(BMXZ(R,"P",I),1,5)=".BMXS" D Q ;XWB*1.1*2
131 . . . S P1=P1_"."_$E(BMXZ(R,"P",I),2,$L(BMXZ(R,"P",I)))
132 . . . IF I'=K S P1=P1_","
133 . . S P1=P1_"BMXZ("_R_",""P"","_I_")"
134 . . IF I'=K S P1=P1_","
135 IF '+ERR Q P1
136 Q ERR
137 ;
138BREAD(L) ;read tcp buffer, L is length
139 N E,X,DONE
140 S (E,DONE)=0
141 R X#L:BMXDTIME(1)
142 S E=X
143 IF $L(E)<L F D Q:'DONE
144 . IF $L(E)=L S DONE=1 Q
145 . R X#(L-$L(E)):BMXDTIME(1)
146 . S E=E_X
147 Q E
148 ;
149CALLP(BMXP,P,DEBUG) ;EP - make API call using Protocol string
150 N ERR,S
151 S ERR=0
152 IF '$D(DEBUG) S DEBUG=0
153 S ERR=$$PRSP(P)
154 IF '+ERR S ERR=$$PRSM(BMXZ(0,"MESG"))
155 IF '+ERR S ERR=$$PRSA(BMXZ(1,"TEXT")) ;I $G(BMXZ(2,"CAPI"))="XUS SET SHARED" S XWBSHARE=1 Q
156 I +ERR S BMXSEC=$P(ERR,U,2) ;P10 -- dpc
157 IF '+ERR S S=$$PRSB(BMXZ(2,"PARM"))
158 ;IF (+S=0)!(+S>0) D
159 I '+ERR D CHKPRMIT^BMXMSEC(BMXZ(2,"CAPI")) ;checks if RPC allowed to run
160 S:$L($G(BMXSEC)) ERR="-1^"_BMXSEC
161 ;IF 'DEBUG S:$D(XRT0) XRTN="RPC BROKER READ/PARSE" D:$D(XRT0) T1^%ZOSV ;stop RTL
162 IF '+ERR,(+S=0)!(+S>0) D
163 . D CAPI^BMXMBRK2(.BMXP,BMXZ(2,"RTAG"),BMXZ(2,"RNAM"),S)
164 E D CLRBUF ;p10
165 IF 'DEBUG K BMXZ
166 IF $D(BMXARY) K @BMXARY,BMXARY
167 Q
168 ;
169LINST(A,X,BMXY) ;instantiate local array
170 IF BMXY=$C(1) S BMXY=""
171 S X=A_"("_X_")"
172 S @X=BMXY
173 Q
174GINST ;instantiate global
175 N DONE,N,T,T1
176 S (DONE,I)=0
177 ;find piece with global ref - recover $C(44)
178 S REF=$TR(REF,$C(23),$C(44))
179 F D Q:DONE
180 . S N=$NA(^TMP("BMXZ",$J,$P($H,",",2)))
181 . S BMXZ("FRM")=REF
182 . S BMXZ("TO")=N
183 . IF '$D(@N) S DONE=1 Q
184 ;loop through all and instantiate
185 S DONE=0
186 F D Q:DONE
187 . S T=$E(@REF@(I),4,M)
188 . IF T="" S DONE=1 Q
189 . S @N@("BMXZ")="" ;set naked indicator
190 . S @T
191 . S I=I+1
192 K @N@("BMXZ")
193 Q
194 ;
195GETV(V) ;get value of V - reference parameter
196 N X
197 S X=V
198 IF $E(X,1,2)="$$" Q ""
199 IF $C(34,36)[$E(V) X "S V="_$$VCHK(V)
200 E S V=@V
201 Q V
202 ;
203VCHK(S) ;Parse string for first argument
204 N C,I,P
205 F I=1:1 S C=$E(S,I) D VCHKP:C="(",VCHKQ:C=$C(34) Q:" ,"[C
206 Q $E(S,1,I-1)
207VCHKP S P=1 ;Find closing paren
208 F I=I+1:1 S C=$E(S,I) Q:P=0!(C="") I "()"""[C D VCHKQ:C=$C(34) S P=P+$S("("[C:1,")"[C:-1,1:0)
209 Q
210VCHKQ ;Find closing quote
211 F I=I+1:1 S C=$E(S,I) Q:C=""!(C=$C(34))
212 Q
213CLRBUF ;p10 Empties Input buffer
214 N %
215 F R %#1:BMXDTIME(1) Q:%=""
216 Q
Note: See TracBrowser for help on using the repository browser.