source: FOIAVistA/trunk/r/VISTALINK-XOBV/XOBVSKT.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1XOBVSKT ;; mjk/alb - VistaLink Socket Methods ; 07/27/2002 13:00
2 ;;1.5;VistALink;;Sep 09, 2005
3 ;;Foundations Toolbox Release v1.5 [Build: 1.5.0.026]
4 ;
5 QUIT
6 ;
7 ; ------------------------------------------------------------------------------------
8 ; Methods for Read fromto TCP/IP Socket
9 ; ------------------------------------------------------------------------------------
10READ(XOBROOT,XOBREAD,XOBTO,XOBFIRST,XOBSTOP,XOBDATA,XOBHDLR) ;
11 NEW X,EOT,OUT,STR,LINE,PIECES,DONE,TOFLAG,XOBCNT,XOBLEN,XOBBH,XOBEH,BS,ES,XOBOK,XOBX
12 ;
13 SET STR="",EOT=$CHAR(4),DONE=0,LINE=0,XOBOK=1
14 ;
15 ; -- READ tcp stream to global buffer | main calling tag NXTCALL^XOBVLL
16 FOR READ XOBX#XOBREAD:XOBTO SET TOFLAG=$TEST DO:XOBFIRST CHK DO:'XOBSTOP!('DONE) QUIT:DONE
17 . ;
18 . ; -- if length of (new intake + current) is too large for buffer then store current
19 . IF $LENGTH(STR)+$LENGTH(XOBX)>400 DO ADD(STR) SET STR=""
20 . SET STR=STR_XOBX
21 . ;
22 . ; -- add node at each line-feed character
23 . ; COMMENTED OUT: Not needed anymore, and has side effect of stripping out line feeds in input
24 . ; array-type parameter values (in XML mode)
25 . ; FOR QUIT:STR'[$CHAR(10) DO ADD($PIECE(STR,$CHAR(10))) SET STR=$PIECE(STR,$CHAR(10),2,999)
26 . ;
27 . ; -- if end-of-text marker found then wrap up and quit
28 . IF STR[EOT SET STR=$PIECE(STR,EOT) DO ADD(STR) SET DONE=1 QUIT
29 . ;
30 . ; -- M XML parser cannot handle an element name split across nodes
31 . SET PIECES=$LENGTH(STR,">")
32 . IF PIECES>1 DO ADD($PIECE(STR,">",1,PIECES-1)_">") SET STR=$PIECE(STR,">",PIECES,999)
33 ;
34 QUIT XOBOK
35 ;
36ADD(TXT) ; -- add new intake line
37 SET LINE=LINE+1
38 SET @XOBROOT@(LINE)=TXT
39 QUIT
40 ;
41CHK ; -- check if first read and change timeout and chars to read
42 SET XOBFIRST=0
43 ;
44 ; -- abort if time out occurred and nothing was read
45 IF 'TOFLAG,$GET(XOBX)="" SET XOBSTOP=1,DONE=1,XOBOK=0 QUIT
46 ;
47 ; -- intercept for transport sinks
48 IF $EXTRACT(XOBX)'="<" DO SINK
49 ;
50 ; -- set up for subsequent reads
51 SET XOBREAD=200,XOBTO=1
52 QUIT
53 ;
54 ; ------------------------------------------------------------------------------------
55 ; Execute Proprietary Format Reader
56 ; ------------------------------------------------------------------------------------
57SINK ;
58 ; -- get size of sink indicator >> then get sink indicator >> load req handler
59 SET XOBHDLR=$$MSGSINK^XOBVRH($$GETSTR(+$$GETSTR(2,.XOBX),.XOBX),.XOBHDLR)
60 ;
61 ; -- execute proprietary stream reader
62 IF $GET(XOBHDLR(XOBHDLR)) XECUTE $GET(XOBHDLR(XOBHDLR,"READER"))
63 ;
64 SET DONE=1
65 QUIT
66 ;
67 ; -- get string of length LEN from stream buffer
68GETSTR(LEN,XOBUF) ;
69 NEW X
70 FOR QUIT:($LENGTH(XOBUF)'<LEN) DO RMORE(LEN-$LENGTH(XOBUF),.XOBUF)
71 SET X=$EXTRACT(XOBUF,1,LEN)
72 SET XOBUF=$EXTRACT(XOBUF,LEN+1,999)
73 QUIT X
74 ;
75 ; -- read more from stream buffer but only needed amount
76RMORE(LEN,XOBUF) ;
77 NEW X
78 READ X#LEN:1 SET XOBUF=XOBUF_X
79 QUIT
80 ;
81 ; ------------------------------------------------------------------------------------
82 ; Methods for Openning and Closing Socket
83 ; ------------------------------------------------------------------------------------
84OPEN(XOBPARMS) ; -- Open tcp/ip socket
85 NEW I,POP
86 SET POP=1
87 ;
88 ; -- set up os var
89 DO OS
90 ;
91 ; -- preserve client io
92 DO SAVDEV^%ZISUTL("XOB CLIENT")
93 ;
94 FOR I=1:1:XOBPARMS("RETRIES") DO CALL^%ZISTCP(XOBPARMS("ADDRESS"),XOBPARMS("PORT")) QUIT:'POP
95 ; -- device open
96 IF 'POP USE IO QUIT 1
97 ; -- device not open
98 QUIT 0
99 ;
100CLOSE(XOBPARMS) ; -- close tcp/ip socket
101 ; -- tell server to Stop() connection if close message is needed to close
102 IF $GET(XOBPARMS("CLOSE MESSAGE"))]"" DO
103 . DO PRE
104 . DO WRITE($$XMLHDR^XOBVLIB()_XOBPARMS("CLOSE MESSAGE"))
105 . DO POST
106 ;
107 DO FINAL
108 DO CLOSE^%ZISTCP
109 DO USE^%ZISUTL("XOB CLIENT")
110 DO RMDEV^%ZISUTL("XOB CLIENT")
111 QUIT
112 ;
113INIT ; -- set up variables needed in tcp/ip processing
114 KILL XOBNULL
115 ;
116 ; -- setup os var
117 DO OS
118 ;
119 ; -- set RPC Broker os variable (so $$BROKER^XWBLIB returns true)
120 SET XWBOS=XOBOS
121 ;
122 ; -- setup null device called "NULL"
123 SET %ZIS="0H",IOP="NULL" DO ^%ZIS
124 IF 'POP DO
125 . SET XOBNULL=IO
126 . DO SAVDEV^%ZISUTL("XOBNULL")
127 QUIT
128 ;
129OS ; -- os var
130 SET XOBOS=$SELECT(^%ZOSF("OS")["OpenM":"OpenM",^("OS")["DSM":"DSM",^("OS")["UNIX":"UNIX",^("OS")["MSM":"MSM",1:"")
131 QUIT
132 ;
133FINAL ; -- kill variables used in tcp/ip processing
134 ;
135 ; -- close null device
136 IF $DATA(XOBNULL) DO
137 . DO USE^%ZISUTL("XOBNULL")
138 . DO CLOSE^%ZISUTL("XOBNULL")
139 . KILL XOBNULL
140 ;
141 KILL XOBOS,XWBOS
142 ;
143 QUIT
144 ;
145 ; ------------------------------------------------------------------------------------
146 ; Methods for Writing to TCP/IP Socket
147 ; ------------------------------------------------------------------------------------
148PRE ; -- prepare socket for writing
149 SET $X=0
150 QUIT
151 ;
152WRITE(STR) ; -- Write a data string to socket
153 IF XOBOS="MSM" WRITE STR QUIT
154 ;
155 ; -- handle a short string
156 IF $LENGTH(STR)<511 DO:($X+$LENGTH(STR))>511 FLUSH WRITE STR QUIT
157 ;
158 ; -- handle a long string
159 DO FLUSH
160 FOR QUIT:'$LENGTH(STR) WRITE $EXTRACT(STR,1,511) DO FLUSH SET STR=$EXTRACT(STR,512,99999)
161 ;
162 QUIT
163 ;
164POST ; -- send eot and flush socket buffer
165 DO WRITE($CHAR(4))
166 DO FLUSH
167 QUIT
168 ;
169FLUSH ; flush buffer
170 IF XOBOS="OpenM" WRITE ! QUIT
171 IF XOBOS="DSM" WRITE:$X>0 ! QUIT
172 ;IF XOBOS="GTM" WRITE # QUIT
173 QUIT
174 ;
Note: See TracBrowser for help on using the repository browser.