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

XOBWUS1.m

Go to the documentation of this file. 
  1. XOBWUS1 ;ALB/MJK - HWSC :: Web Service Manager ; 09/13/10 4:00pm
  1.  ;;1.0;HwscWebServiceClient;;September 13, 2010;Build 31
  1.  ;
  1.  QUIT
  1.  ;
  1. ADD ; -- add web service entry
  1.  NEW DIC,Y,XOBY,D
  1.  WRITE !
  1.  SET DIC="^XOB(18.02,",DIC(0)="AELQ",D="B" DO IX^DIC KILL DIC
  1.  SET XOBY=Y
  1.  IF +XOBY>0,'$PIECE(XOBY,U,3) DO  GOTO ADDQ
  1.  . DO DISPLAY("",+XOBY)
  1.  . WRITE !!,"This is not a new entry! Please use 'Edit Service' action."
  1.  . DO PAUSE^VALM1
  1.  IF +XOBY>0,$PIECE(XOBY,U,3) DO DOEDIT(+XOBY)
  1.  DO POSTEDIT(+XOBY)
  1. ADDQ ;
  1.  QUIT
  1.  ;
  1. EDIT ; -- edit web service entry
  1.  NEW XOBDA,XOBI,VALMY
  1.  DO EN^VALM2(XQORNOD(0),"OS")
  1.  SET XOBI=+$ORDER(VALMY(""))
  1.  IF XOBI>0 DO 
  1.  . SET XOBDA=+$GET(^TMP("XOB WEBSERVICES","IDX",$JOB,XOBI,XOBI))
  1.  . DO DISPLAY(XOBI,XOBDA)
  1.  . DO DOEDIT(XOBDA)
  1.  . DO POSTEDIT(XOBDA)
  1. EDITQ ;
  1.  QUIT
  1.  ;
  1. DOEDIT(DA) ; -- do actual web service edit
  1.  NEW DR,DIE
  1.  SET DR="[XOBW WEB SERVICE EDIT]",DIE="^XOB(18.02," DO ^DIE
  1.  QUIT
  1.  ;
  1. POSTEDIT(XOBDA) ; -- warning checks after 'add' or 'edit'
  1.  NEW XOBCLASS,XOBSTAT,XOBISSUE
  1.  SET XOBSTAT=$$CLSVAL(XOBDA,.XOBCLASS,.XOBISSUE)
  1.  IF 'XOBSTAT DO
  1.  . IF $GET(XOBISSUE)=1 WRITE !!,"Warning: No class name specified"
  1.  . IF $GET(XOBISSUE)=2 WRITE !!,"Warning: Class name of '",$GET(XOBCLASS),"' is not a defined class!"
  1.  . IF $GET(XOBISSUE)=3 WRITE !!,"Warning: Class '",$GET(XOBCLASS),"' does not extend %SOAP.WebClient!"
  1.  . DO PAUSE^VALM1
  1.  QUIT
  1.  ;
  1. CLSCHK(XOBDA) ; -- class check warning message
  1.  NEW XOBCLASS,XOBSTAT,XOBISSUE,XOBMSG
  1.  SET XOBMSG=""
  1.  SET XOBSTAT=$$CLSVAL(XOBDA,.XOBCLASS,.XOBISSUE)
  1.  IF 'XOBSTAT DO
  1.  . IF $GET(XOBISSUE)=1 SET XOBMSG=" o  Class name not specified" QUIT
  1.  . IF $GET(XOBISSUE)=2 SET XOBMSG=" o  Class is not a defined class" QUIT
  1.  . IF $GET(XOBISSUE)=3 SET XOBMSG=" o  Class does not extend %SOAP.WebClient" QUIT
  1.  QUIT XOBMSG
  1.  ;
  1. CLSVAL(XOBDA,XOBCLASS,XOBISSUE) ; -- do actual validation check
  1.  NEW XOBWCDEF,XOBDA0,XOBOK
  1.  SET XOBOK=0,XOBISSUE=0
  1.  SET XOBDA0=$GET(^XOB(18.02,+XOBDA,0))
  1.  ; -- no need to do check for REST-type [2]; quit w/ok
  1.  IF $PIECE(XOBDA0,"^",2)=2 SET XOBOK=1 GOTO CLSVALQ
  1.  ; -- do checks for SOAP-type [1] 
  1.  SET XOBCLASS=$PIECE($GET(^XOB(18.02,+XOBDA,100)),"^")
  1.  ; -- no class name defined
  1.  IF XOBCLASS="" SET XOBOK=0,XOBISSUE=1 GOTO CLSVALQ
  1.  SET XOBWCDEF=##class(%Dictionary.ClassDefinition).%OpenId(XOBCLASS)
  1.  ; -- not a class
  1.  IF XOBWCDEF="" SET XOBOK=0,XOBISSUE=2 GOTO CLSVALQ
  1.  ; -- not a SOAP client class
  1.  IF XOBWCDEF.Super'="%SOAP.WebClient" SET XOBOK=0,XOBISSUE=3 GOTO CLSVALQ
  1.  SET XOBOK=1,XOBISSUE=0
  1. CLSVALQ ;
  1.  QUIT XOBOK
  1.  ;
  1. DEL ; -- delete web service entry
  1.  NEW XOBI,VALMY,Y,XOBDA
  1.  DO EN^VALM2(XQORNOD(0),"OS")
  1.  SET XOBI=+$ORDER(VALMY(""))
  1.  ; -- quit if nothing selected
  1.  IF XOBI'>0 GOTO DELQ
  1.  ; -- display entry, ask if 'ok' and delete
  1.  SET XOBDA=+$GET(^TMP("XOB WEBSERVICES","IDX",$JOB,XOBI,XOBI))
  1.  DO DISPLAY(XOBI,XOBDA)
  1.  IF $ORDER(^XOB(18.12,"AB",XOBDA,""))]"" DO
  1.  . WRITE *7
  1.  . WRITE !,"    ***************************************************"
  1.  . WRITE !,"    * ATTENTION: This web service is still authorized *"
  1.  . WRITE !,"    *            to 1 or more servers.                *"
  1.  . WRITE !,"    ***************************************************"
  1.  DO
  1.  . NEW DIR
  1.  . SET DIR("A")="Are you sure you want to delete entry"
  1.  . SET DIR("B")="NO",DIR(0)="Y"
  1.  . WRITE !
  1.  . DO ^DIR
  1.  IF '$GET(Y) DO  GOTO DELQ
  1.  . WRITE !!,"Deletion aborted."
  1.  . DO PAUSE^VALM1
  1.  ; -- execute deletion
  1.  DO UNREG^XOBWLIB($P(^XOB(18.02,XOBDA,0),"^"))
  1.  WRITE !!,"Entry has been deleted."
  1.  DO PAUSE^VALM1
  1. DELQ ;
  1.  QUIT
  1.  ;
  1. DISPLAY(XOBI,DA) ; display web service informaton
  1.  ; input: XOBI == list entry number
  1.  ;        DA   == internal entry number in file 18.02
  1.  NEW X,DIQ,XOBY,DR,DIC,XOBLINE,XOBDASH,XOBTYPE,XOBCMSG,XOBSRVDA,XOBMULDA
  1.  SET $PIECE(XOBLINE,"=",$GET(IOM,80))=""
  1.  SET $PIECE(XOBDASH,"-",$GET(IOM,80))=""
  1.  DO CLEAR^VALM1
  1.  WRITE !,XOBLINE
  1.  IF $GET(XOBI) DO
  1.  . WRITE !,@VALMAR@(XOBI,0)
  1.  . WRITE !,XOBDASH
  1.  SET DIC="^XOB(18.02,"
  1.  SET DIQ="XOBY("
  1.  SET DIQ(0)="E"
  1.  SET DR=".01;.02;.03;100;200;201;"
  1.  DO EN^DIQ1
  1.  SET XOBTYPE=$GET(XOBY(18.02,DA,.02,"E"))
  1.  WRITE !?5,"                Name: ",$GET(XOBY(18.02,DA,.01,"E"))
  1.  WRITE !?5,"                Type: ",$GET(XOBY(18.02,DA,.02,"E"))
  1.  WRITE !?5,"Registered Date/Time: ",$GET(XOBY(18.02,DA,.03,"E"))
  1.  IF XOBTYPE="SOAP" DO
  1.  . WRITE !?5,"    Proxy Class Name: ",$GET(XOBY(18.02,DA,100,"E"))
  1.  . SET XOBCMSG=$$CLSCHK(DA)
  1.  . IF XOBCMSG]"" WRITE !?5,"                      ",XOBCMSG
  1.  WRITE !?5,"        Context Root: ",$GET(XOBY(18.02,DA,200,"E"))
  1.  WRITE !?4,"Availability Resource: "_$GET(XOBY(18.02,DA,201,"E"))
  1.  SET X="----------- Web servers '"_$GET(XOBY(18.02,DA,.01,"E"))_"' is authorized to: "
  1.  WRITE !!,X_$EXTRACT(XOBDASH,$L(X)+1,999)
  1.  IF $ORDER(^XOB(18.12,"AB",DA,""))']"" DO
  1.  . WRITE !!,"        <<<none>>>"
  1.  ELSE  DO
  1.  . WRITE ! SET XOBSRVDA=0,XOBMULDA=0
  1.  . FOR  SET XOBSRVDA=$ORDER(^XOB(18.12,"AB",DA,XOBSRVDA)) Q:XOBSRVDA']""  DO
  1.  . . FOR  SET XOBMULDA=$ORDER(^XOB(18.12,"AB",DA,XOBSRVDA,XOBMULDA)) Q:XOBMULDA']""  DO
  1.  . . . W !," - ",$PIECE($GET(^XOB(18.12,XOBSRVDA,0)),U)
  1.  WRITE !!,XOBDASH,!
  1.  QUIT
  1.  ;
  1. EXPAND ; -- expand Protocol
  1.  NEW XOBI,XOBY,VALMY
  1.  DO EN^VALM2(XQORNOD(0),"OS")
  1.  SET XOBI=+$ORDER(VALMY(""))
  1.  IF $GET(XOBI) DO
  1.  . SET XOBY("HEADER",1)=""
  1.  . SET XOBY("HEADER",2)=@VALMAR@(XOBI,0)
  1.  . SET XOBY("TITLE")="Web Service Metadata Display"
  1.  . SET XOBY("BUILD CALLBACK")="DO BUILD^XOBWUS1("_+$GET(^TMP("XOB WEBSERVICES","IDX",$JOB,XOBI,XOBI))_")"
  1.  . D EN^XOBWUS2(.XOBY)
  1.  QUIT
  1.  ;
  1. BUILD(XOBDA) ; -- build display array with WSDL content (callback)
  1.  NEW DIQ,XOBY,DR,DIC,DA,XOBJ,XOBWSDL,XOBDOTS,X,XOBTYPE,XOBCMSG,XOBSRVDA,XOBMULDA
  1.  SET $PIECE(XOBDOTS,".",$GET(IOM,80))="."
  1.  DO CLEAN^VALM10
  1.  SET DIC="^XOB(18.02,"
  1.  SET DIQ="XOBY("
  1.  SET DIQ(0)="E"
  1.  SET DR=".01;.02;.03;100;200;201;300"
  1.  SET DA=$GET(XOBDA)
  1.  DO EN^DIQ1
  1.  SET VALMCNT=0
  1.  SET XOBTYPE=$GET(XOBY(18.02,DA,.02,"E"))
  1.  DO ADDLN("                     Name: "_$GET(XOBY(18.02,DA,.01,"E")))
  1.  DO ADDLN("             Service Type: "_$GET(XOBY(18.02,DA,.02,"E")))
  1.  DO ADDLN("     Registered Date/Time: "_$GET(XOBY(18.02,DA,.03,"E")))
  1.  IF XOBTYPE="SOAP" DO
  1.  . DO ADDLN("         Proxy Class Name: "_$GET(XOBY(18.02,DA,100,"E")))
  1.  . SET XOBCMSG=$$CLSCHK(DA)
  1.  . IF XOBCMSG]"" DO ADDLN("                           "_XOBCMSG)
  1.  DO ADDLN("             Context Root: "_$GET(XOBY(18.02,DA,200,"E")))
  1.  DO ADDLN("    Availability Resource: "_$GET(XOBY(18.02,DA,201,"E")))
  1.  SET X="............Web servers '"_$GET(XOBY(18.02,DA,.01,"E"))_"' authorized to:"
  1.  DO ADDLN(" "),ADDLN(X_$EXTRACT(XOBDOTS,$L(X)+1,999))
  1.  IF $ORDER(^XOB(18.12,"AB",XOBDA,""))']"" DO
  1.  . DO ADDLN(" "),ADDLN("        <<<none>>>")
  1.  ELSE  DO
  1.  . DO ADDLN(" ") 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.  . . . DO ADDLN(" - "_$PIECE($GET(^XOB(18.12,XOBSRVDA,0)),U))
  1.  DO ADDLN(" ")
  1.  ;
  1.  ; -- no need to do WSDL display info for REST services
  1.  IF XOBTYPE="REST" GOTO BUILDQ
  1.  ;
  1.  ; -- build WSDL lines
  1.  SET X="............WSDL Document:"
  1.  DO ADDLN(X_$EXTRACT(XOBDOTS,$L(X)+1,999))
  1.  SET XOBJ=0
  1.  FOR  SET XOBJ=$ORDER(XOBY(18.02,DA,300,XOBJ)) QUIT:XOBJ=""  DO
  1.  . DO ADDLN($GET(XOBY(18.02,DA,300,XOBJ)))
  1.  . SET XOBWSDL=1
  1.  ;
  1.  IF '$GET(XOBWSDL) DO
  1.  . DO ADDLN("")
  1.  . DO ADDLN("        <<< No WSDL document available for this web service! >>>")
  1.  . DO ADDLN("")
  1. BUILDQ ;
  1.  DO ADDLN(XOBDOTS)
  1.  QUIT
  1.  ;
  1. ADDLN(XOBTEXT) ; -- add line utility
  1.  SET VALMCNT=VALMCNT+1
  1.  D SET^VALM10(VALMCNT,XOBTEXT)
  1.  QUIT
  1.  ;