Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XOBWD

XOBWD.m

Go to the documentation of this file.
  1. XOBWD ;ALB/MJK - HWSC :: Private Deployment APIs ; 09/13/10 4:00pm
  1. ;;1.0;HwscWebServiceClient;;September 13, 2010;Build 31
  1. ;
  1. QUIT
  1. ;
  1. GENPORT(XOBY) ; -- generate http port class from WSDL during install
  1. NEW XOBSTAT,XOBWSDL
  1. SET XOBWSDL=$GET(XOBY("WSDL FILE"))
  1. ;
  1. IF ##class(%File).Exists(XOBWSDL) DO
  1. . SET XOBSTAT=$$ADDPROXY(.XOBY)
  1. ELSE DO
  1. . SET XOBSTAT="0^File does not exist ["_XOBWSDL_"]"
  1. QUIT XOBSTAT
  1. ;
  1. ADDPROXY(XOBY) ; -- create client proxy class
  1. NEW XOBREADR,XOBSTAT,XOBINFO,XOBCLASS,XOBCXT,I,X,XOBLERR,XOBWSDL,XOBPKG,XOBWSN,XOBTYPE,XOBWAV
  1. ;
  1. SET XOBWSDL=$GET(XOBY("WSDL FILE"))
  1. SET XOBPKG=$GET(XOBY("CACHE PACKAGE NAME"))
  1. SET XOBWSN=$GET(XOBY("WEB SERVICE NAME"))
  1. SET XOBWAV=$GET(XOBY("AVAILABILITY RESOURCE"))
  1. ;
  1. SET XOBINFO=##class(xobw.WsdlHandler).getInfoFromFile(XOBWSDL)
  1. IF XOBINFO="" QUIT "0^Unable to parse WSDL file ["_XOBWSDL_"]"
  1. IF $GET(XOBPKG)="" NEW XOBPKG SET XOBPKG=$LISTGET(XOBINFO,1)
  1. SET XOBCLASS=XOBPKG_"."_$LISTGET(XOBINFO,2)
  1. SET XOBCXT=$LISTGET(XOBINFO,3)
  1. ;
  1. SET XOBREADR=##class(%SOAP.WSDL.Reader).%New()
  1. SET XOBREADR.OutputTypeAttribute=1
  1. SET XOBSTAT=XOBREADR.Process(XOBWSDL,XOBPKG)
  1. IF XOBSTAT DO
  1. . DO REGSOAP^XOBWLIB(XOBWSN,XOBCXT,XOBCLASS,XOBWSDL,XOBWAV)
  1. ELSE DO
  1. . DO $system.Status.DecomposeStatus(%objlasterror,.XOBLERR)
  1. . SET X="" FOR I=1:1:XOBLERR SET X=X_XOBLERR(I)
  1. . SET XOBSTAT="0^"_X
  1. ;
  1. QUIT XOBSTAT
  1. ;
  1. REGISTER(XOBWSN,XOBTYPE,XOBCXT,XOBCLASS,XOBWSDL,XOBCAURL) ; -- register SOAP and REST service
  1. ; Input:
  1. ; XOBWSN - web service name
  1. ; XOBTYPE - type of web service [ 1 - SOAP | 2 - REST ]
  1. ; XOBCXT - web service context root
  1. ; XOBCLASS - full class name, including package
  1. ; XOBWSDL - file path containing WSDL document
  1. ; XOBCAURL - 'check availability' url portion to follow context root [optional]
  1. ;
  1. NEW XOBCDEF,XOBOK,XOBCHK
  1. SET XOBCHK=$$CHKTYPE(XOBWSN,XOBTYPE) IF '+XOBCHK DO QUIT
  1. . 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.")
  1. IF XOBTYPE=1 DO QUIT:XOBCDEF=""
  1. . SET XOBCDEF=##class(%Dictionary.ClassDefinition).%OpenId(XOBCLASS)
  1. . ; -- perform check to see if port class creation matches what was expected
  1. . IF XOBCDEF="" DO BMES^XPDUTL(" o Creating the class definition for '"_XOBCLASS_"' failed.")
  1. ;
  1. ; -- add entry into table
  1. SET XOBOK=$$FILE(XOBWSN,XOBTYPE,XOBCXT,.XOBCLASS,.XOBWSDL,.XOBCAURL)
  1. DO MES^XPDUTL(" o WEB SERVICE '"_XOBWSN_"' addition/update "_$SELECT(XOBOK:"succeeded.",1:"failed."))
  1. DO MES^XPDUTL(" ")
  1. QUIT
  1. ;
  1. UNREG(XOBWSN) ; -- unregister and delete web service
  1. NEW DIK,XOBSRVDA,XOBMULDA,XOBDA,XOBSRVNM,DA
  1. SET XOBDA=$ORDER(^XOB(18.02,"B",XOBWSN,0)) IF '+XOBDA DO QUIT
  1. . DO MES^XPDUTL(" o WEB SERVICE '"_XOBWSN_"' not found for deletion.")
  1. ; delete from web servers' authorized multiple
  1. SET XOBSRVDA=0,XOBMULDA=0
  1. FOR SET XOBSRVDA=$ORDER(^XOB(18.12,"AB",XOBDA,XOBSRVDA)) Q:'+XOBSRVDA DO
  1. . FOR SET XOBMULDA=$ORDER(^XOB(18.12,"AB",XOBDA,XOBSRVDA,XOBMULDA)) Q:'+XOBMULDA DO
  1. . . SET XOBSRVNM=$P($G(^XOB(18.12,XOBSRVDA,0)),U)
  1. . . KILL DIK,DA SET DA=XOBMULDA,DA(1)=XOBSRVDA,DIK="^XOB(18.12,"_DA(1)_",100,"
  1. . . DO ^DIK
  1. . . DO MES^XPDUTL(" o WEB SERVICE '"_XOBWSN_"' unauthorized from '"_XOBSRVNM_"'.")
  1. ; delete web service
  1. KILL DIK,DA SET DA=XOBDA,DIK="^XOB(18.02," DO ^DIK
  1. DO MES^XPDUTL(" o WEB SERVICE '"_XOBWSN_"' unregistered/deleted.")
  1. QUIT
  1. ;
  1. CHKTYPE(XOBWSN,XOBTYPE) ; return 1 if no svc, or right type; 0^existing type if mismatch
  1. NEW XOBIEN
  1. SET XOBIEN=+$$FIND1^DIC(18.02,"","BX",XOBWSN,"","","")
  1. IF XOBIEN,XOBTYPE'=$P(^XOB(18.02,XOBIEN,0),"^",2) QUIT 0_"^"_$P(^XOB(18.02,XOBIEN,0),"^",2)
  1. QUIT 1
  1. ;
  1. FILE(XOBWSN,XOBTYPE,XOBCXT,XOBCLASS,XOBWSDL,XOBCAURL) ;-- File a new record in file #18.02 or edit existing
  1. ; Input:
  1. ; XOBWSN - web service name
  1. ; XOBTYPE - type of web service [ 1 - SOAP | 2 -REST ]
  1. ; XOBCXT - web service context root
  1. ; XOBCLASS - full class name, including package
  1. ; XOBWSDL - file path containing WSDL document
  1. ; XOBCAURL - 'check availability' url portion to follow context root [optional]
  1. ;
  1. ; Output:
  1. ; Function Value - Returns IEN of record on success, 0 on failure
  1. ;
  1. NEW XOBFDA,XOBFDAI,XOBERR,XOBIENS,XOBIEN,DIERR
  1. ;
  1. SET XOBIEN=+$$FIND1^DIC(18.02,"","BX",XOBWSN,"","","")
  1. ;
  1. ; -- If record doesn't already exist, create new
  1. IF XOBIEN SET XOBIENS=XOBIEN_","
  1. ELSE SET XOBIENS="+1,"
  1. ;
  1. ; -- validate values ; quit if not valid
  1. IF '$$VALIDATE() QUIT 0
  1. ;
  1. ; -- Set up array with field values
  1. SET XOBFDA(18.02,XOBIENS,.01)=$GET(XOBWSN)
  1. SET XOBFDA(18.02,XOBIENS,.02)=$GET(XOBTYPE)
  1. SET XOBFDA(18.02,XOBIENS,.03)=$$NOW^XLFDT
  1. SET XOBFDA(18.02,XOBIENS,100)=$GET(XOBCLASS)
  1. SET XOBFDA(18.02,XOBIENS,200)=$GET(XOBCXT)
  1. SET XOBFDA(18.02,XOBIENS,201)=$GET(XOBCAURL)
  1. ;
  1. IF XOBIEN DO
  1. . DO FILE^DIE("","XOBFDA","XOBERR")
  1. . IF $DATA(DIERR) DO
  1. . . DO DISPERR($NAME(XOBERR))
  1. . . SET XOBIEN=0
  1. ELSE DO
  1. . DO UPDATE^DIE("","XOBFDA","XOBFDAI","XOBERR")
  1. . IF $DATA(DIERR) DO
  1. . . DO DISPERR($NAME(XOBERR))
  1. . . SET XOBIEN=0
  1. . ELSE DO
  1. . . SET XOBIEN=$GET(XOBFDAI(1))
  1. ;
  1. ; -- add copy of WSDL to a SOAP-type entry
  1. IF XOBIEN,$GET(XOBWSDL)]"" DO WSDL(.XOBWSDL,.XOBIEN)
  1. ;
  1. QUIT $SELECT($GET(XOBIEN)>0:XOBIEN,1:0)
  1. ;
  1. VALIDATE() ; -- validate values of input variables
  1. NEW XOBY,XOBERR,XOBOK
  1. SET XOBOK=1
  1. DO VAL^DIE(18.02,XOBIENS,.01,"",$GET(XOBWSN),.XOBY,"","XOBERR"),CHK
  1. DO VAL^DIE(18.02,XOBIENS,.02,"",$GET(XOBTYPE),.XOBY,"","XOBERR"),CHK
  1. DO VAL^DIE(18.02,XOBIENS,100,"",$GET(XOBCLASS),.XOBY,"","XOBERR"),CHK
  1. DO VAL^DIE(18.02,XOBIENS,200,"",$GET(XOBCXT),.XOBY,"","XOBERR"),CHK
  1. ; -- work around for FM DBS bug that does not allow input to start with ?
  1. IF $EXTRACT($GET(XOBCAURL))'="?" DO
  1. . DO VAL^DIE(18.02,XOBIENS,201,"",$GET(XOBCAURL),.XOBY,"","XOBERR"),CHK
  1. QUIT XOBOK
  1. ;
  1. CHK ;
  1. IF $GET(XOBY)="^" DO
  1. . SET XOBOK=0
  1. . DO DISPERR("XOBERR")
  1. QUIT
  1. ;
  1. DISPERR(XOBINARR) ; -- display error message
  1. NEW XOBOUT,XOBI,XOBX
  1. DO MES^XPDUTL("FM Database Server Error Information:")
  1. DO MSG^DIALOG("AE",.XOBOUT,70,"",XOBINARR)
  1. FOR XOBI=1:1 QUIT:$D(XOBOUT(XOBI))=0 DO MES^XPDUTL($GET(XOBOUT(XOBI)))
  1. QUIT
  1. ;
  1. WSDL(XOBWSDL,XOBIEN) ; -- file copy of WSDL
  1. NEW XOBSTRM,XOBROOT,XOBI,XOBERR,DIERR
  1. SET XOBROOT=$NAME(^TMP("XOBW WSDL FILING",$JOB))
  1. SET XOBI=0
  1. SET XOBSTRM=##class(%FileCharacterStream).%New()
  1. SET XOBSTRM.Filename=$GET(XOBWSDL)
  1. FOR QUIT:XOBSTRM.AtEnd DO
  1. . SET XOBI=XOBI+1
  1. . SET @XOBROOT@(XOBI)=XOBSTRM.ReadLine()
  1. DO WP^DIE(18.02,XOBIEN_",",300,"K",XOBROOT,$NAME(XOBERR))
  1. ; -- if error occurs, just display
  1. IF $DATA(DIERR) DO DISPERR($NAME(XOBERR))
  1. QUIT
  1. ;