XOBWD.m

XOBWD ;ALB/MJK - HWSC :: Private Deployment APIs ; 09/13/10 4:00pm

 ;;1.0;HwscWebServiceClient;;September 13, 2010;Build 31

 ;

 QUIT

 ;

GENPORT(XOBY) ; -- generate http port class from WSDL during install

 NEW XOBSTAT,XOBWSDL

 SET XOBWSDL=$GET(XOBY("WSDL FILE"))

 ;

 IF ##class(%File).Exists(XOBWSDL) DO

 . SET XOBSTAT=$$ADDPROXY(.XOBY)

 ELSE  DO

 . SET XOBSTAT="0^File does not exist ["_XOBWSDL_"]"

 QUIT XOBSTAT

 ;

ADDPROXY(XOBY) ; -- create client proxy class

 NEW XOBREADR,XOBSTAT,XOBINFO,XOBCLASS,XOBCXT,I,X,XOBLERR,XOBWSDL,XOBPKG,XOBWSN,XOBTYPE,XOBWAV

 ;

 SET XOBWSDL=$GET(XOBY("WSDL FILE"))

 SET XOBPKG=$GET(XOBY("CACHE PACKAGE NAME"))

 SET XOBWSN=$GET(XOBY("WEB SERVICE NAME"))

 SET XOBWAV=$GET(XOBY("AVAILABILITY RESOURCE"))

 ;

 SET XOBINFO=##class(xobw.WsdlHandler).getInfoFromFile(XOBWSDL)

 IF XOBINFO="" QUIT "0^Unable to parse WSDL file ["_XOBWSDL_"]"

 IF $GET(XOBPKG)="" NEW XOBPKG SET XOBPKG=$LISTGET(XOBINFO,1)

 SET XOBCLASS=XOBPKG_"."_$LISTGET(XOBINFO,2)

 SET XOBCXT=$LISTGET(XOBINFO,3)

 ;

 SET XOBREADR=##class(%SOAP.WSDL.Reader).%New()

 SET XOBREADR.OutputTypeAttribute=1

 SET XOBSTAT=XOBREADR.Process(XOBWSDL,XOBPKG)

 IF XOBSTAT DO

 . DO REGSOAP^XOBWLIB(XOBWSN,XOBCXT,XOBCLASS,XOBWSDL,XOBWAV)

 ELSE  DO

 . DO $system.Status.DecomposeStatus(%objlasterror,.XOBLERR)

 . SET X="" FOR I=1:1:XOBLERR SET X=X_XOBLERR(I)

 . SET XOBSTAT="0^"_X

 ;

 QUIT XOBSTAT

 ;

REGISTER(XOBWSN,XOBTYPE,XOBCXT,XOBCLASS,XOBWSDL,XOBCAURL) ; -- register SOAP and REST service

 ;  Input:

 ;    XOBWSN    -   web service name

 ;    XOBTYPE   -   type of web service [ 1 - SOAP | 2 - REST ]

 ;    XOBCXT    -   web service context root

 ;    XOBCLASS  -   full class name, including package

 ;    XOBWSDL   -   file path containing WSDL document

 ;    XOBCAURL  -   'check availability' url portion to follow context root [optional]

 ;

 NEW XOBCDEF,XOBOK,XOBCHK

 SET XOBCHK=$$CHKTYPE(XOBWSN,XOBTYPE) IF '+XOBCHK DO  QUIT

 . DO BMES^XPDUTL(" o  Type mismatch: attempted "_$SELECT(XOBTYPE=1:"SOAP",XOBTYPE=2:"REST",1:"unknown")_" update of "_$SELECT($P(XOBCHK,"^",2)=1:"SOAP",$P(XOBCHK,"^",2)=2:"REST",1:"unknown")_"-type service '"_XOBWSN_"' failed.")

 IF XOBTYPE=1 DO  QUIT:XOBCDEF=""

 . SET XOBCDEF=##class(%Dictionary.ClassDefinition).%OpenId(XOBCLASS)

 . ; -- perform check to see if port class creation matches what was expected

 . IF XOBCDEF="" DO BMES^XPDUTL(" o  Creating the class definition for '"_XOBCLASS_"' failed.")

 ;

 ; -- add entry into table

 SET XOBOK=$$FILE(XOBWSN,XOBTYPE,XOBCXT,.XOBCLASS,.XOBWSDL,.XOBCAURL)

 DO MES^XPDUTL(" o  WEB SERVICE '"_XOBWSN_"' addition/update "_$SELECT(XOBOK:"succeeded.",1:"failed."))

 DO MES^XPDUTL(" ")

 QUIT

 ;

UNREG(XOBWSN) ; -- unregister and delete web service

 NEW DIK,XOBSRVDA,XOBMULDA,XOBDA,XOBSRVNM,DA

 SET XOBDA=$ORDER(^XOB(18.02,"B",XOBWSN,0)) IF '+XOBDA DO  QUIT

 . DO MES^XPDUTL(" o  WEB SERVICE '"_XOBWSN_"' not found for deletion.")

 ; delete from web servers' authorized multiple

 SET XOBSRVDA=0,XOBMULDA=0

 FOR  SET XOBSRVDA=$ORDER(^XOB(18.12,"AB",XOBDA,XOBSRVDA)) Q:'+XOBSRVDA  DO

 . FOR  SET XOBMULDA=$ORDER(^XOB(18.12,"AB",XOBDA,XOBSRVDA,XOBMULDA)) Q:'+XOBMULDA  DO

 . . SET XOBSRVNM=$P($G(^XOB(18.12,XOBSRVDA,0)),U)

 . . KILL DIK,DA SET DA=XOBMULDA,DA(1)=XOBSRVDA,DIK="^XOB(18.12,"_DA(1)_",100,"

 . . DO ^DIK

 . . DO MES^XPDUTL(" o  WEB SERVICE '"_XOBWSN_"' unauthorized from '"_XOBSRVNM_"'.")

 ; delete web service

 KILL DIK,DA SET DA=XOBDA,DIK="^XOB(18.02," DO ^DIK

 DO MES^XPDUTL(" o  WEB SERVICE '"_XOBWSN_"' unregistered/deleted.")

 QUIT

 ;

CHKTYPE(XOBWSN,XOBTYPE) ; return 1 if no svc, or right type; 0^existing type if mismatch

  NEW XOBIEN

  SET XOBIEN=+$$FIND1^DIC(18.02,"","BX",XOBWSN,"","","")

  IF XOBIEN,XOBTYPE'=$P(^XOB(18.02,XOBIEN,0),"^",2) QUIT 0_"^"_$P(^XOB(18.02,XOBIEN,0),"^",2)

  QUIT 1

  ;

FILE(XOBWSN,XOBTYPE,XOBCXT,XOBCLASS,XOBWSDL,XOBCAURL) ;-- File a new record in file #18.02 or edit existing

 ;  Input:

 ;    XOBWSN    -   web service name

 ;    XOBTYPE   -   type of web service [ 1 - SOAP | 2 -REST ]

 ;    XOBCXT    -   web service context root

 ;    XOBCLASS  -   full class name, including package

 ;    XOBWSDL   -   file path containing WSDL document

 ;    XOBCAURL  -   'check availability' url portion to follow context root [optional]

 ;

 ; Output:

 ;    Function Value - Returns IEN of record on success, 0 on failure

 ;

 NEW XOBFDA,XOBFDAI,XOBERR,XOBIENS,XOBIEN,DIERR

 ;

 SET XOBIEN=+$$FIND1^DIC(18.02,"","BX",XOBWSN,"","","")

 ;

 ; -- If record doesn't already exist, create new

 IF XOBIEN SET XOBIENS=XOBIEN_","

 ELSE  SET XOBIENS="+1,"

 ;

 ; -- validate values ; quit if not valid

 IF '$$VALIDATE() QUIT 0

 ;

 ; -- Set up array with field values

 SET XOBFDA(18.02,XOBIENS,.01)=$GET(XOBWSN)

 SET XOBFDA(18.02,XOBIENS,.02)=$GET(XOBTYPE)

 SET XOBFDA(18.02,XOBIENS,.03)=$$NOW^XLFDT

 SET XOBFDA(18.02,XOBIENS,100)=$GET(XOBCLASS)

 SET XOBFDA(18.02,XOBIENS,200)=$GET(XOBCXT)

 SET XOBFDA(18.02,XOBIENS,201)=$GET(XOBCAURL)

 ;

 IF XOBIEN DO

 . DO FILE^DIE("","XOBFDA","XOBERR")

 . IF $DATA(DIERR) DO

 . . DO DISPERR($NAME(XOBERR))

 . . SET XOBIEN=0

 ELSE  DO

 . DO UPDATE^DIE("","XOBFDA","XOBFDAI","XOBERR")

 . IF $DATA(DIERR) DO

 . . DO DISPERR($NAME(XOBERR))

 . . SET XOBIEN=0

 . ELSE  DO

 . . SET XOBIEN=$GET(XOBFDAI(1))

 ;

 ; -- add copy of WSDL to a SOAP-type entry

 IF XOBIEN,$GET(XOBWSDL)]"" DO WSDL(.XOBWSDL,.XOBIEN)

 ;

 QUIT $SELECT($GET(XOBIEN)>0:XOBIEN,1:0)

 ;

VALIDATE() ; -- validate values of input variables

 NEW XOBY,XOBERR,XOBOK

 SET XOBOK=1

 DO VAL^DIE(18.02,XOBIENS,.01,"",$GET(XOBWSN),.XOBY,"","XOBERR"),CHK

 DO VAL^DIE(18.02,XOBIENS,.02,"",$GET(XOBTYPE),.XOBY,"","XOBERR"),CHK

 DO VAL^DIE(18.02,XOBIENS,100,"",$GET(XOBCLASS),.XOBY,"","XOBERR"),CHK

 DO VAL^DIE(18.02,XOBIENS,200,"",$GET(XOBCXT),.XOBY,"","XOBERR"),CHK

 ; -- work around for FM DBS bug that does not allow input to start with ?

 IF $EXTRACT($GET(XOBCAURL))'="?" DO

 . DO VAL^DIE(18.02,XOBIENS,201,"",$GET(XOBCAURL),.XOBY,"","XOBERR"),CHK

 QUIT XOBOK

 ;

CHK ;

 IF $GET(XOBY)="^" DO

 . SET XOBOK=0

 . DO DISPERR("XOBERR")

 QUIT

 ;

DISPERR(XOBINARR) ; -- display error message

 NEW XOBOUT,XOBI,XOBX

 DO MES^XPDUTL("FM Database Server Error Information:")

 DO MSG^DIALOG("AE",.XOBOUT,70,"",XOBINARR)

 FOR XOBI=1:1 QUIT:$D(XOBOUT(XOBI))=0  DO MES^XPDUTL($GET(XOBOUT(XOBI)))

 QUIT

 ;

WSDL(XOBWSDL,XOBIEN) ; -- file copy of WSDL

 NEW XOBSTRM,XOBROOT,XOBI,XOBERR,DIERR

 SET XOBROOT=$NAME(^TMP("XOBW WSDL FILING",$JOB))

 SET XOBI=0

 SET XOBSTRM=##class(%FileCharacterStream).%New()

 SET XOBSTRM.Filename=$GET(XOBWSDL)

 FOR  QUIT:XOBSTRM.AtEnd  DO

 . SET XOBI=XOBI+1

 . SET @XOBROOT@(XOBI)=XOBSTRM.ReadLine()

 DO WP^DIE(18.02,XOBIEN_",",300,"K",XOBROOT,$NAME(XOBERR))

 ; -- if error occurs, just display

 IF $DATA(DIERR) DO DISPERR($NAME(XOBERR))

 QUIT

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XOBWD   6899     printed  Apr 09, 2024@21:48:25                                                                                                                                                                                                       Page 2

XOBWD     ;ALB/MJK - HWSC :: Private Deployment APIs ; 09/13/10 4:00pm

 +1       ;;1.0;HwscWebServiceClient;;September 13, 2010;Build 31

 +2       ;

 +3        QUIT 

 +4       ;

GENPORT(XOBY) ; -- generate http port class from WSDL during install

 +1        NEW XOBSTAT,XOBWSDL

 +2        SET XOBWSDL=$GET(XOBY("WSDL FILE"))

 +3       ;

 +4        IF ##class(%File).Exists(XOBWSDL)

               Begin DoDot:1

 +5                SET XOBSTAT=$$ADDPROXY(.XOBY)

               End DoDot:1

 +6       IF '$TEST

               Begin DoDot:1

 +7                SET XOBSTAT="0^File does not exist ["_XOBWSDL_"]"

               End DoDot:1

 +8        QUIT XOBSTAT

 +9       ;

ADDPROXY(XOBY) ; -- create client proxy class

 +1        NEW XOBREADR,XOBSTAT,XOBINFO,XOBCLASS,XOBCXT,I,X,XOBLERR,XOBWSDL,XOBPKG,XOBWSN,XOBTYPE,XOBWAV

 +2       ;

 +3        SET XOBWSDL=$GET(XOBY("WSDL FILE"))

 +4        SET XOBPKG=$GET(XOBY("CACHE PACKAGE NAME"))

 +5        SET XOBWSN=$GET(XOBY("WEB SERVICE NAME"))

 +6        SET XOBWAV=$GET(XOBY("AVAILABILITY RESOURCE"))

 +7       ;

 +8        SET XOBINFO=##class(xobw.WsdlHandler).getInfoFromFile(XOBWSDL)

 +9        IF XOBINFO=""

               QUIT "0^Unable to parse WSDL file ["_XOBWSDL_"]"

 +10       IF $GET(XOBPKG)=""

               NEW XOBPKG