| 1 | XWBRW ;ISF/RWF - Read/Write for Broker TCP ;08/03/2004 15:09
|
|---|
| 2 | ;;1.1;RPC BROKER;**35**;Mar 28, 1997
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | ;XWBRBUF is global
|
|---|
| 6 | ;SE is a flag to skip error for short read. From PRSB+41^XWBBRK
|
|---|
| 7 | BREAD(L,TO,SE) ;read tcp buffer, L is length, TO is timeout
|
|---|
| 8 | N R,S,DONE,C
|
|---|
| 9 | I L'>0 Q ""
|
|---|
| 10 | I $L(XWBRBUF)'<L S R=$E(XWBRBUF,1,L),XWBRBUF=$E(XWBRBUF,L+1,999999) Q R
|
|---|
| 11 | S R="",DONE=0,L=+L,C=0
|
|---|
| 12 | S TO=$S($G(TO)>0:TO,$G(XWBTIME(1))>0:XWBTIME(1),1:60)/2+1
|
|---|
| 13 | U XWBTDEV
|
|---|
| 14 | F D Q:DONE
|
|---|
| 15 | . S S=L-$L(R),R=R_$E(XWBRBUF,1,S),XWBRBUF=$E(XWBRBUF,S+1,999999)
|
|---|
| 16 | . I ($L(R)=L)!(R[$C(4))!(C>TO) S DONE=1 Q
|
|---|
| 17 | . R XWBRBUF:2 S:'$T C=C+1 S:$L(XWBRBUF) C=0
|
|---|
| 18 | . I $G(XWBDEBUG)>2,$L(XWBRBUF) D LOG^XWBDLOG("rd: "_$E(XWBRBUF,1,252))
|
|---|
| 19 | . Q
|
|---|
| 20 | I $L(R)<L,'$G(SE) S $ECODE=",U411," ;Throw Error, Did not read full length
|
|---|
| 21 | Q R
|
|---|
| 22 | ;
|
|---|
| 23 | QSND(XWBR) ;Quick send
|
|---|
| 24 | S XWBPTYPE=1,XWBERROR="",XWBSEC="" D SND
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | ESND(XWBR) ;Send from ETRAP
|
|---|
| 28 | S XWBPTYPE=1 D SND
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | SND ; Send a responce
|
|---|
| 32 | N XWBSBUF S XWBSBUF=""
|
|---|
| 33 | U XWBTDEV
|
|---|
| 34 | ;
|
|---|
| 35 | D SNDERR ;Send any error info
|
|---|
| 36 | D SNDDATA ;Send the data
|
|---|
| 37 | ;D WRITE($C(4)) ;EOT
|
|---|
| 38 | D WRITE($C(4)),WBF
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | SNDDATA ;Send the data part
|
|---|
| 42 | N I,D
|
|---|
| 43 | ; -- single value
|
|---|
| 44 | I XWBPTYPE=1 D WRITE($G(XWBR)) Q
|
|---|
| 45 | ; -- table delimited by CR+LF
|
|---|
| 46 | I XWBPTYPE=2 D Q
|
|---|
| 47 | . S I="" F S I=$O(XWBR(I)) Q:I="" D WRITE(XWBR(I)),WRITE($C(13,10))
|
|---|
| 48 | ; -- word processing
|
|---|
| 49 | I XWBPTYPE=3 D Q
|
|---|
| 50 | . S I="" F S I=$O(XWBR(I)) Q:I="" D WRITE(XWBR(I)) D:XWBWRAP WRITE($C(13,10))
|
|---|
| 51 | ; -- global array
|
|---|
| 52 | I XWBPTYPE=4 D Q
|
|---|
| 53 | . I $E($G(XWBR))'="^" Q
|
|---|
| 54 | . S I=$G(XWBR) Q:I="" S T=$E(I,1,$L(I)-1)
|
|---|
| 55 | . ;Only send root node if non-null.
|
|---|
| 56 | . I $D(@I)>10 S D=@I I $L(D) D WRITE(D),WRITE($C(13,10)):XWBWRAP&(D'=$C(13,10))
|
|---|
| 57 | . F S I=$Q(@I) Q:I=""!(I'[T) S D=@I D WRITE(D),WRITE($C(13,10)):XWBWRAP&(D'=$C(13,10))
|
|---|
| 58 | . I $D(@XWBR) K @XWBR
|
|---|
| 59 | ; -- global instance
|
|---|
| 60 | I XWBPTYPE=5 D Q
|
|---|
| 61 | . I $E($G(XWBR))'="^" Q
|
|---|
| 62 | . S XWBR=$G(@XWBR) D WRITE(XWBR) Q
|
|---|
| 63 | ; -- variable length records only good upto 255 char)
|
|---|
| 64 | I XWBPTYPE=6 D
|
|---|
| 65 | . S I="" F S I=$O(XWBR(I)) Q:I="" D WRITE($C($L(XWBR(I)))),WRITE(XWBR(I))
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | SNDERR ;send error information
|
|---|
| 69 | ;XWBSEC is the security packet, XWBERROR is application packet
|
|---|
| 70 | N X
|
|---|
| 71 | S $X=0 ;Start with zero
|
|---|
| 72 | S X=$E($G(XWBSEC),1,255)
|
|---|
| 73 | D WRITE($C($L(X))_X)
|
|---|
| 74 | S X=$E($G(XWBERROR),1,255)
|
|---|
| 75 | D WRITE($C($L(X))_X)
|
|---|
| 76 | S XWBERROR="",XWBSEC="" ;clears parameters
|
|---|
| 77 | Q
|
|---|
| 78 | ;
|
|---|
| 79 | WRITE(STR) ;Write a data string
|
|---|
| 80 | ; send data for DSM (requires buffer flush (!) every 511 chars)
|
|---|
| 81 | ;IF XWBOS="DSM"!(XWBOS="UNIX")!(XWBOS="OpenM) next line
|
|---|
| 82 | F Q:'$L(STR) D
|
|---|
| 83 | . I $L(XWBSBUF)+$L(STR)>240 D WBF
|
|---|
| 84 | . S XWBSBUF=XWBSBUF_$E(STR,1,255),STR=$E(STR,256,99999)
|
|---|
| 85 | Q
|
|---|
| 86 | WBF ;Write Buffer Flush
|
|---|
| 87 | Q:'$L(XWBSBUF)
|
|---|
| 88 | I $G(XWBDEBUG)>2,$L(XWBSBUF) D LOG^XWBDLOG("wrt ("_$L(XWBSBUF)_"): "_$E(XWBSBUF,1,247))
|
|---|
| 89 | W XWBSBUF,@XWBT("BF")
|
|---|
| 90 | S XWBSBUF=""
|
|---|
| 91 | Q
|
|---|
