142 lines
5.3 KiB
Mathematica
142 lines
5.3 KiB
Mathematica
|
XOBVRPCI ;; ld,mjk/alb - VistaLink Interface Implementation for RPCs; 07/27/2002 13:00
|
||
|
|
;;1.5;VistALink;;Sep 09, 2005
|
||
|
|
;;Foundations Toolbox Release v1.5 [Build: 1.5.0.026]
|
||
|
|
;
|
||
|
|
CALLBACK(CB) ; -- init callbacks implementation
|
||
|
|
SET CB("STARTELEMENT")="ELEST^XOBVRPCI"
|
||
|
|
SET CB("ENDELEMENT")="ELEND^XOBVRPCI"
|
||
|
|
SET CB("CHARACTERS")="CHR^XOBVRPCI"
|
||
|
|
QUIT
|
||
|
|
;
|
||
|
|
READER(XOBUF,XOBDATA) ; -- propriatary format reader implementation
|
||
|
|
DO START^XOBVRPCX(.XOBUF,.XOBDATA)
|
||
|
|
QUIT
|
||
|
|
;
|
||
|
|
REQHDLR(XOBDATA) ; -- request handler implementation
|
||
|
|
DO EN^XOBVRPC(.XOBDATA)
|
||
|
|
QUIT
|
||
|
|
;
|
||
|
|
; ------------------------------------------------------------------------
|
||
|
|
; RPC Server: Request Message XML SAX Parser Callbacks
|
||
|
|
; ------------------------------------------------------------------------
|
||
|
|
ELEST(ELE,ATR) ; -- element start event handler
|
||
|
|
IF ELE="VistaLink" DO QUIT
|
||
|
|
. KILL XOBPARAM,XOBCTXT,XOBPN,XOBPTYPE
|
||
|
|
. ; -- if called from VL v1.0 client then set up J2SE defaults
|
||
|
|
. IF $GET(XOBDATA("VL VERSION"))="1.0" DO V1^XOBVRPCX
|
||
|
|
;
|
||
|
|
IF ELE="RpcHandler" SET XOBDATA("XOB RPC","RPC HANDLER VERSION")=$GET(ATR("version")) QUIT
|
||
|
|
;
|
||
|
|
IF ELE="Request" DO QUIT
|
||
|
|
. SET XOBDATA("XOB RPC","RPC NAME")=$$ESC^XOBVRMX($GET(ATR("rpcName"),"##Unkown RPC##"))
|
||
|
|
. NEW X
|
||
|
|
. SET X=$$SETTO^XOBVLIB($GET(ATR("rpcClientTimeOut"),9000))
|
||
|
|
. SET X=$$SETVER^XOBVRPCX($GET(ATR("rpcVersion"),0))
|
||
|
|
;
|
||
|
|
IF ELE="RpcContext" SET XOBCTXT="" QUIT
|
||
|
|
;
|
||
|
|
; -------------------- Param Node Start Event Processing ---------------------------
|
||
|
|
;
|
||
|
|
IF ELE="Param" DO QUIT
|
||
|
|
. SET XOBPARAM=""
|
||
|
|
. SET XOBPN="XOBP"_ATR("position")
|
||
|
|
. SET XOBDATA("XOB RPC","PARAMS",ATR("position"))=XOBPN
|
||
|
|
. SET XOBPTYPE=ATR("type")
|
||
|
|
. SET:XOBPTYPE="array" @XOBPN=""
|
||
|
|
;
|
||
|
|
IF ELE="Index" DO QUIT
|
||
|
|
. KILL XOBPARAM
|
||
|
|
. IF $DATA(ATR("name"))&$DATA(ATR("value")) DO
|
||
|
|
. . SET @XOBPN@($$ESC^XOBVRMX(ATR("name")))=$$ESC^XOBVRMX(ATR("value"))
|
||
|
|
;
|
||
|
|
IF ELE="Name" DO QUIT
|
||
|
|
. SET XOBPARNM=""
|
||
|
|
;
|
||
|
|
IF ELE="Value" DO QUIT
|
||
|
|
. SET XOBPARVL=""
|
||
|
|
;
|
||
|
|
; -------------------- Security Node Start Event Processing ---------------------------
|
||
|
|
;
|
||
|
|
IF ELE="Security" DO QUIT
|
||
|
|
. SET XOBDATA("XOB RPC","SECURITY","TYPE")=$GET(ATR("type"))
|
||
|
|
. SET XOBDATA("XOB RPC","SECURITY","DIV")=$GET(ATR("division"))
|
||
|
|
. SET XOBDATA("XOB RPC","SECURITY","STATE")=$GET(ATR("state"),"notauthenticated")
|
||
|
|
. KILL XOBSECFL
|
||
|
|
. ;
|
||
|
|
. ; -- use to make sure child nodes are from Security
|
||
|
|
. ; parent when processing child node names
|
||
|
|
. SET XOBSECFL=1
|
||
|
|
;
|
||
|
|
IF ELE="AccessVerify",$GET(XOBSECFL),$EXTRACT($GET(XOBDATA("XOB RPC","SECURITY","TYPE")),1,2)="av" DO QUIT
|
||
|
|
. SET XOBAVCOD=""
|
||
|
|
;
|
||
|
|
IF ELE="KernelCcowToken",$GET(XOBSECFL),$GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="ccow" DO QUIT
|
||
|
|
. SET XOBCCOWT=""
|
||
|
|
;
|
||
|
|
IF ELE="Duz",$GET(XOBSECFL),$GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="duz" DO QUIT
|
||
|
|
. SET XOBDATA("XOB RPC","SECURITY","TYPE","VALUE")=$GET(ATR("value"))
|
||
|
|
;
|
||
|
|
IF ELE="Vpid",$GET(XOBSECFL),$GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="vpid" DO QUIT
|
||
|
|
. SET XOBDATA("XOB RPC","SECURITY","TYPE","VALUE")=$GET(ATR("value"))
|
||
|
|
;
|
||
|
|
IF ELE="ApplicationProxyName",$GET(XOBSECFL),$GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="appproxy" DO QUIT
|
||
|
|
. SET XOBDATA("XOB RPC","SECURITY","TYPE","VALUE")=$GET(ATR("value"))
|
||
|
|
;
|
||
|
|
; ---------------------------------------------------------------------------
|
||
|
|
;
|
||
|
|
QUIT
|
||
|
|
;
|
||
|
|
ELEND(ELE) ; -- element end event handler
|
||
|
|
IF ELE="VistaLink" DO QUIT
|
||
|
|
. SET XOBDATA("MODE")=$GET(ATR("mode"),"singleton")
|
||
|
|
. KILL XOBPOS,XOBPARAM,XOBCTXT,XOBPN,XOBPTYPE
|
||
|
|
;
|
||
|
|
IF ELE="RpcContext" DO QUIT
|
||
|
|
. SET XOBDATA("XOB RPC","RPC CONTEXT")=$GET(XOBCTXT)
|
||
|
|
;
|
||
|
|
IF ELE="Param" DO KILL XOBPARAM QUIT
|
||
|
|
. IF XOBPTYPE="string" SET @XOBPN=$$ESC^XOBVRMX(XOBPARAM) QUIT
|
||
|
|
. IF XOBPTYPE="ref" SET @XOBPN=$GET(@$$ESC^XOBVRMX(XOBPARAM)) QUIT
|
||
|
|
;
|
||
|
|
IF ELE="Params" DO QUIT
|
||
|
|
. NEW POS,PARAMS
|
||
|
|
. SET PARAMS="",POS=0
|
||
|
|
. FOR SET POS=$ORDER(XOBDATA("XOB RPC","PARAMS",POS)) QUIT:'POS SET PARAMS=PARAMS_",."_XOBDATA("XOB RPC","PARAMS",POS)
|
||
|
|
. SET XOBDATA("XOB RPC","PARAMS")=PARAMS
|
||
|
|
;
|
||
|
|
IF ELE="Index" DO QUIT
|
||
|
|
. IF $DATA(XOBPARNM)&$DATA(XOBPARVL) DO
|
||
|
|
. . KILL XOBPARAM
|
||
|
|
. . IF $EXTRACT(XOBPARNM,1)=$CHAR(13) DO
|
||
|
|
. . . SET @("@XOBPN@("_$$ESC^XOBVRMX($EXTRACT(XOBPARNM,2,$LENGTH(XOBPARNM)))_")=$$ESC^XOBVRMX(XOBPARVL)")
|
||
|
|
. . ELSE DO
|
||
|
|
. . . SET @XOBPN@($$ESC^XOBVRMX(XOBPARNM))=$$ESC^XOBVRMX(XOBPARVL)
|
||
|
|
. . KILL XOBPARNM,XOBPARVL
|
||
|
|
;
|
||
|
|
IF ELE="Name" DO QUIT
|
||
|
|
. SET XOBPARNM("DONE")=1
|
||
|
|
;
|
||
|
|
IF ELE="Value" DO QUIT
|
||
|
|
. SET XOBPARVL("DONE")=1
|
||
|
|
;
|
||
|
|
IF ELE="AccessVerify",$GET(XOBSECFL),$EXTRACT($GET(XOBDATA("XOB RPC","SECURITY","TYPE")),1,2)="av" DO QUIT
|
||
|
|
. SET XOBDATA("XOB RPC","SECURITY","TYPE","AVCODE")=XOBAVCOD KILL XOBAVCOD
|
||
|
|
IF ELE="KernelCcowToken",$GET(XOBSECFL),$GET(XOBDATA("XOB RPC","SECURITY","TYPE"))="ccow" DO QUIT
|
||
|
|
. SET XOBDATA("XOB RPC","SECURITY","TYPE","CCOW")=XOBCCOWT KILL XOBCCOWT
|
||
|
|
IF ELE="Security" KILL XOBSECFL QUIT
|
||
|
|
;
|
||
|
|
QUIT
|
||
|
|
;
|
||
|
|
CHR(TEXT) ; -- character value event handler <tag>TEXT</tag)
|
||
|
|
; -- need to concatenate because MXML parses on ENTITY characters (<>& etc.) and
|
||
|
|
; callback gets hit multiple times even though the tag text value is just one piece of data.
|
||
|
|
; (Yes, this seems kludgie!)
|
||
|
|
IF $DATA(XOBPARAM) SET XOBPARAM=XOBPARAM_TEXT
|
||
|
|
IF $DATA(XOBPARNM),'+$GET(XOBPARNM("DONE")) SET XOBPARNM=XOBPARNM_TEXT QUIT
|
||
|
|
IF $DATA(XOBPARVL),'+$GET(XOBPARVL("DONE")) SET XOBPARVL=XOBPARVL_TEXT QUIT
|
||
|
|
IF $DATA(XOBCTXT) SET XOBCTXT=XOBCTXT_TEXT QUIT
|
||
|
|
IF $DATA(XOBAVCOD) SET XOBAVCOD=XOBAVCOD_TEXT QUIT
|
||
|
|
IF $DATA(XOBCCOWT) SET XOBCCOWT=XOBCCOWT_TEXT QUIT
|
||
|
|
QUIT
|
||
|
|
;
|