diff --git a/p/C0PEWD1.m b/p/C0PEWD1.m new file mode 100644 index 0000000..cd746fb --- /dev/null +++ b/p/C0PEWD1.m @@ -0,0 +1,90 @@ +C0PEWD1 ; CCDCCR/GPL - ePrescription utilities; 12/6/08 + ;;0.1;CCDCCR;nopatch;noreleasedate + ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q + ;TEST(filepath) ; filepath IS THE PATH/FILE TO BE READ IN + i $g(^%ZISH)["" d ; if the VistA Kernal routine %ZISH exists + . n zfile,zpath,ztmp s (zfile,zpath,ztmp)="" + . s zfile=$re($p($re(filepath),"/",1)) ;file name + . s zpath=$p(filepath,zfile,1) ; file path + . s ztmp=$na(^CacheTempEWD($j,0)) + . s ok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file incrementing subscr 2 + q + ; +TEST2 ; + s zfilepath="/home/vademo2/CCR/PAT_780_CCR_V1_0_17.xml" + ;s ok=$$gtmImportFile^%zewdHTMLParser(zfilepath) + s ok=$$LOAD(zfilepath) ;load the XML file to the EWD global + s ok=$$parseDocument^%zewdHTMLParser("DerekDOM",0) + ;s ok=$$parseXMLFile^%zewdAPI(zfilepath,"fourthDOM") + w ok,! + q + ; +GPLTEST ; + ;s ok=$$httpGET^%zewdGTM("http://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml",.gpl) + s URL="https://trac.opensourcevista.net/CCD-CCR-Project/browser/ccr/tags/CCR_1_0_7/output" + s ok=$$httpGET^%zewdGTM(URL,.gpl) + S ZG="" + F S ZG=$O(gpl(ZG)) Q:ZG="" D ; + . s gpl(ZG)=$$CLEAN^C0PEWDU(gpl(ZG)) ; + . ;w gpl(ZG) + m ^CacheTempEWD($j)=gpl + b + s ok=$$parseDocument^%zewdHTMLParser("gpl2",0) + s ok=$$outputDOM^%zewdDOM("gpl2",1,1) + Q + ; +GPLTEST2 ; + s URL="https://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml" + ;s URL="https://trac.opensourcevista.net/CCD-CCR-Project/browser/ccr/tags/CCR_1_0_7/output" + s ok=$$httpGET^%zewdGTM(URL,.gpl) + D INDEX^C0CXPATH("gpl","gpl2") + S G="" + F S G=$O(gpl2(G)) Q:G="" D ; + . W !,G," = ",gpl2(G) + W ! + Q + ; +CLEAN(INX) ;DELETE NON-PRINTING CHARACTER IN INX, PASSED BY VALUE + ;DON'T USE THIS -- IT DOESN'T WORK -- USE $$CLEAN^C0PEWDU + ;N ZT,ZI + S ZT="" + F ZI=32:1:126 S ZT=ZT_$CHAR(ZI) + S ZZ=$TR(INX,ZT) + Q ZZ + ; +LOAD(filepath) ; load an xml file into the EWD global for DOM processing + ; need to call s error=$$parseDocument^%zewdHTMLParser(docName,isHTML) + ; after to process it to the DOM - isHTML=0 for XML files + n i + i $g(^%ZISH)["" d QUIT i ; if VistA Kernal routine %ZISH exists - gpl 2/23/09 + . n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)="" + . s zfile=$re($p($re(filepath),"/",1)) ;file name + . s zpath=$p(filepath,zfile,1) ; file path + . s ztmp=$na(^CacheTempEWD($j,0)) + . s zok=$$FTG^%ZISH(zpath,zfile,ztmp,2) ; import the file increment subscr 2 + . s i=$o(^CacheTempEWD($j,""),-1) ; highest line number + q i + ; +Q(ZQ,ZD) ; SEND QUERY ZQ TO DOM ZD AND DIPLAY NODES RETURNED + I '$D(ZD) S ZD="DerekDOM" + s error=$$select^%zewdXPath(ZQ,ZD,.nodes) ; + d displayNodes^%zewdXPath(.nodes) + q + ; diff --git a/p/C0PEWD2.m b/p/C0PEWD2.m new file mode 100644 index 0000000..e7ba392 --- /dev/null +++ b/p/C0PEWD2.m @@ -0,0 +1,51 @@ +C0PEWD2 ; CCDCCR/GPL - ePrescription utilities; 4/24/09 + ;;0.1;CCDCCR;nopatch;noreleasedate + ;Copyright 2009 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q +TEST ; + s URL="https://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml" + D GET1URL(URL) ; + S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NCScript-RegisterLP.xml" + D GET1URL(URL) + S URL="http://preproduction.newcropaccounts.com/InterfaceV7/GenTestRenewalFDB.xml" + D GET1URL(URL) + S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxFDB.xml" + D GET1URL(URL) + S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxRxNorm.xml" + D GET1URL(URL) + S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxExternalDrugOpt1.xml" + D GET1URL(URL) + S URL="http://preproduction.newcropaccounts.com/InterfaceV7/NewrxExternalDrugOpt2.xml" + D GET1URL(URL) + S URL="http://preproduction.newcropaccounts.com/InterfaceV7/RenewalResponseAccept.xml" + D GET1URL(URL) + S URL="http://preproduction.newcropaccounts.com/InterfaceV7/RenewalResponseDeny.xml" + D GET1URL(URL) + Q + ; +GET1URL(URL) ; + s ok=$$httpGET^%zewdGTM(URL,.gpl) + D INDEX^C0CXPATH("gpl","gpl2") + W !,"S URL=""",URL,"""",! + S G="" + F S G=$O(gpl2(G)) Q:G="" D ; + . W " S VDX(""",G,""")=""",gpl2(G),"""",! + W ! + Q + ; diff --git a/p/C0PEWDU.m b/p/C0PEWDU.m new file mode 100644 index 0000000..ff6e457 --- /dev/null +++ b/p/C0PEWDU.m @@ -0,0 +1,34 @@ +C0PEWDU ; WV/SMH - E-prescription utilities; Mar 3 2009 + ;;0.1;WV EPrescribing;; + Q + ; +CLEAN(STR) ; extrinsic function; returns string + ;; Removes all non printable characters from a string. + ;; STR by Value + N TR,I + F I=0:1:31 S TR=$G(TR)_$C(I) + S TR=TR_$C(127) + QUIT $TR(STR,TR) + ; +GETSOAP(ENTRY,REQUEST,RESULT) ; XML SOAP Spec for NewCrop + ;; Gets world processing field from Fileman for Parsing + ;; ENTRY Input by Value + ;; REQUEST XML Output by Reference + ;; RESULT XML Output by Reference + ;; Example call: D GETSOAP^C0PEWDU("DrugAllergyInteraction",.REQ,.RES) + ; + N OK,ERR,IEN,F ; if call is okay, Error, IEN, File + S F=175.101 + S IEN=$$FIND1^DIC(F,"","",ENTRY,"B") + S OK=$$GET1^DIQ(F,IEN,2,"","REQUEST","ERR") + I OK=""!($D(ERR)) S REQUEST="" + ; M ^CacheTempEWD($j)=REQUEST + ; K REQUEST + ; S ok=$$parseDocument^%zewdHTMLParser("REQUEST",0) + ; S ok=$$outputDOM^%zewdDOM("REQUEST",1,1) + ; Q ; remove later + K OK,ERR + S OK=$$GET1^DIQ(F,IEN,3,"","RESULT","ERR") + I OK=""!($D(ERR)) S RESULT="" + QUIT + ; diff --git a/p/_zewdAPI.m b/p/_zewdAPI.m new file mode 100644 index 0000000..d7ef04a --- /dev/null +++ b/p/_zewdAPI.m @@ -0,0 +1,1868 @@ +%zewdAPI ; Enterprise Web Developer run-time functions and user APIs + ; + ; Product: Enterprise Web Developer version 4.0.755 + ; Build Date: Thu, 12 Feb 2009 09:53:12 + ; + ; ---------------------------------------------------------------------------- + ; | Enterprise Web Developer for GT.M and m_apache | + ; | Copyright (c) 2004-9 M/Gateway Developments Ltd, | + ; | Reigate, Surrey UK. | + ; | All rights reserved. | + ; | | + ; | http://www.mgateway.com | + ; | Email: rtweed@mgateway.com | + ; | | + ; | This program is free software: you can redistribute it and/or modify | + ; | it under the terms of the GNU Affero General Public License as | + ; | published by the Free Software Foundation, either version 3 of the | + ; | License, or (at your option) any later version. | + ; | | + ; | This program is distributed in the hope that it will be useful, | + ; | but WITHOUT ANY WARRANTY; without even the implied warranty of | + ; | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | + ; | GNU Affero General Public License for more details. | + ; | | + ; | You should have received a copy of the GNU Affero General Public License | + ; | along with this program. If not, see . | + ; ---------------------------------------------------------------------------- + ; + QUIT + ; + ; +version() ; + QUIT "Enterprise Web Developer (Build "_$$getVersion^%zewdCompiler()_")" + ; +date() ; + QUIT $$getDate^%zewdCompiler() + ; +compilePage(app,page,mode,technology,outputPath,multilingual,maxLines) + d compilePage^%zewdCompiler($g(app),$g(page),$g(mode),$g(technology),$g(outputPath),$g(multilingual),$g(maxLines)) + QUIT + ; +compileAll(app,mode,technology,outputPath,multilingual,templatePageName,maxLines) + d compileAll^%zewdCompiler($g(app),$g(mode),$g(technology),$g(outputPath),$g(multilingual),$g(templatePageName),$g(maxLines)) + QUIT + ; +autoTranslate(app,language,verbose) + d autoTranslate^%zewdMgr($g(app),$g(language),$g(verbose)) + ; +startSession(page,requestArray,serverArray,sessionArray,filesArray) ; + ; + QUIT $$startSession^%zewdPHP(page,.requestArray,.serverArray,.sessionArray,.filesArray) + ; +closeSession(requestArray) ; + ; + QUIT $$closeSession^%zewdPHP(.requestArray) + ; +saveSession(sessionArray) ; + ; + d saveSession^%zewdPHP(.sessionArray) + QUIT + ; +endOfPage(sessionArray) + ; + d endOfPage^%zewdPHP(.sessionArray) + QUIT + ; +prePageScript(sessid) + QUIT $$prePageScript^%zewdPHP(sessid) + ; +releaseLock(sessid) + d releaseLock^%zewdPHP(sessid) + QUIT + ; +tokeniseURL(url,sessid) + QUIT $$tokeniseURL^%zewdCompiler16($g(url),$g(sessid)) + ; +getSessid(token) + ; + i token="" QUIT "" + i $$isTokenExpired(token) QUIT "" + QUIT +^%zewdSession("tokens",token) + ; +initialiseSession(sessid) + k ^%zewdSession("session",sessid) + QUIT + ; +deleteSession(sessid) + ; + d deleteSession^%zewdPHP(sessid) + ; + QUIT + ; +setRedirect(toPage,sessid) + d setJump(toPage,sessid) + QUIT + ; +setJump(toPage,sessid) + ; + n token + ; + d setSessionValue("ewd_nextPage",toPage,sessid) + d setSessionValue("ewd_jump",toPage,sessid) + QUIT:$e(sessid,1,4)="csp:" + s token=$$setNextPageToken(toPage,sessid) + d setSessionValue("ewd_pageToken",token,sessid) + QUIT + ; +setNextPageToken(nextPage,sessid) + ; + n token,length + ; + s length=$$getSessionValue("ewd_sessid_length",sessid) + i length="" s length=30 + f s token=$$makeTokenString(length) q:'$d(^%zewdSession("nextPageTokens",sessid,token)) + i $g(^zewd("trace"))=1 d trace^%zewdAPI("setNextPageToken^%zewdAPI: sessid="_sessid_"; token="_token_"; nextPage="_nextPage) + s ^%zewdSession("nextPageTokens",sessid,token,$$zcvt(nextPage,"l"))="" + QUIT token + ; +isNextPageTokenValid(token,sessid,page) + QUIT $$isNextPageTokenValid^%zewdCompiler13(token,sessid,page) + ; +isCSP(sessid) + QUIT $e(sessid,1,4)="csp:" + ; +normaliseTextValue(text) + s text=$$replaceAll(text,"'","'") + QUIT $$zcvt(text,"o","HTML") + ; +displayOptions(fieldName,listName,escape) + ;d displayOptions^%zewdCompiler13($g(fieldName),$g(listName),$g(escape)) + n codeValue,%d,i,name,nnvp,nvp,pos,textValue,value + ; + s fieldName=$tr(fieldName,".","_") + s listName=$tr(listName,".","_") + i 0 + e d + . s escape=+$g(escape) + . s pos="" + . f s pos=$o(^%zewdSession("session",sessid,"ewd_list",listName,pos)) q:pos="" d + . . k %d,textValue,codeValue,codeValueEsc,textValueEsc + . . s %d=^%zewdSession("session",sessid,"ewd_list",listName,pos) + . . s textValue=$p(%d,$c(1),1) + . . ; + . . s textValueEsc=textValue + . . s textValueEsc=$$replaceAll(textValueEsc,"'","'") + . . i escape s textValueEsc=$$zcvt(textValue,"o","HTML") + . . ; + . . s codeValue=$p(%d,$c(1),2) + . . i codeValue="" s codeValue=textValue + . . s codeValueEsc=codeValue + . . s codeValueEsc=$$replaceAll(codeValueEsc,"'","'") + . . i escape s codeValueEsc=$$zcvt(codeValue,"o","HTML") + . . w ""_$c(13,10) + QUIT + ; +displayTextArea(fieldName) + d displayTextArea^%zewdCompiler13($g(fieldName)) + QUIT + ; +mCSPReq2(fields) + ; + n i,noOfFields,field,type + s noOfFields=$l(fields,"`") + f i=1:1:noOfFields d + . s field=$p(fields,"`",i) + . q:field="" + . s type=$p(field,"|",2) + . S field=$P(field,"|",1) + . d mergeCSPRequestToSession(field,type) + d mergeCSPRequestToSession("ewd_pressed","hidden") + QUIT + ; +mCSPReq(fieldName,type) + d mergeCSPRequestToSession(fieldName,type) + QUIT + ; +mergeCSPRequestToSession(fieldName,type) + d mergeCSPRequestToSession^%zewdCompiler16($g(fieldName),$g(type)) + QUIT + ; + ; note - textarea data storage can be queried using SQL with the following construct + ; + ; listAttributeFL {type=%Library.String ; sqllisttype=subnode} + ; +displayText(textID,reviewMode,sessid) + QUIT $$displayText^%zewdCompiler13($g(textID),$g(reviewMode),$g(sessid)) + ; +systemMessage(text,type,sessid,appName,langCode) + n textid,fragments,outputText,error,technology,translationMode,typex + ; + ;d trace^%zewdAPI("systemMessage : text="_text_" ; type="_type_" ; sessid="_sessid) + i $g(text)="" QUIT "" + ; manual API or where sessid not known + i $g(sessid)="" QUIT $$systemMessage^%zewdCompiler5(text,$g(type),$g(appName),$g(langCode)) + s translationMode=+$$getSessionValue^%zewdAPI("ewd_translationMode",sessid) + ;d trace^%zewdAPI("ewd_translationMode="_translationMode) + i 'translationMode QUIT text + s appName=$$getSessionValue^%zewdAPI("ewd_appName",sessid) + ;d trace^%zewdAPI("appName="_appName) + s typex=type ; avoid Cache bug ! + i $$getPhraseIndex^%zewdCompiler5(text)="" QUIT "" + i '$$isTextPreviouslyFound^%zewdCompiler5(text,appName,"","",.textid,,,type) d + . s textid=$$addTextToIndex^%zewdCompiler5(text,appName,"","",.fragments,.outputText,typex) + s error=$$displayText(textid,0,sessid) + QUIT error + ; +errorMessage(text,sessid) + QUIT $$systemMessage(text,"error",sessid) + ; + ; ============================================================================ + ; User API Methods + ; ============================================================================ + ; +isCSPPage(docOID) + ; + n docName + ; + s docName=$$getDocumentName^%zewdDOM(docOID) + QUIT $$bypassMode^%zewdCompiler(docName) + ; +getSessionValue(name,sessid) + ; + n %zt,return,value + ; + s name=$$stripSpaces(name) + s %zt=$zt + i $g(name)="" QUIT "" + i $g(sessid)="" QUIT "" + i name["." d QUIT value + . n np,obj,prop + . i name["_" s name=$p(name,"_",1)_"."_$p(name,"_",2,200) + . s np=$l(name,".") + . s obj=$p(name,".",1,np-1) + . s prop=$p(name,".",np) + . s value=$$getSessionObject(obj,prop,sessid) + ;s $zt="extcErr" + ;i $r(100)<10 i '$$$licensed("DOM",,,,,,,,,,) d setWarning("You do not have a current eXtc License",sessid) + ;i $$isTemp(name) d QUIT value + i $e(name,1,4)="tmp_" d QUIT value + . s value=$g(zewdSession(name)) + . i value="",$g(^%zewdSession("session",sessid,"ewd_technology"))="gtm" s value=$g(sessionArray(name)) + QUIT $g(^%zewdSession("session",sessid,name)) + ; +setWLDSymbol(name,sessid) + ; + ; ------------------------------------------------------ + ; Duplicate copy for performance: see also %zewdPHP! + ; ------------------------------------------------------ + ; + n wldAppName,wldName,wldSessid,%zzname + ; + QUIT:$zv["GT.M" + QUIT + ; +extcErr + ; + n mess + s mess="eXtc does not appear to have been installed or is unavailable in the "_$$namespace()_" namespace where your application is attempting to run. Your application will be unable to run correctly" + d setWarning(mess,sessid) + s $zt=%zt + QUIT "" + ; +valueErr ; + s $zt=%zt + QUIT "" + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +exportCustomTags(tagList,filepath) + QUIT $$exportCustomTags^%zewdCompiler16(.tagList,$g(filepath)) + ; +exportAllCustomTags(filepath) + QUIT $$exportAllCustomTags^%zewdCompiler16($g(filepath)) + ; +importCustomTags(filePath) + QUIT $$importCustomTags^%zewdForm($g(filePath)) + ; +setSessionValue(name,value,sessid) + ; + s name=$$stripSpaces(name) + i $g(name)="" QUIT + i $g(sessid)="" QUIT + i name["." d QUIT + . n np,obj,prop + . i name["_" s name=$p(name,"_",1)_"."_$p(name,"_",2,200) + . s np=$l(name,".") + . s obj=$p(name,".",1,np-1) + . s prop=$p(name,".",np) + . d setSessionObject(obj,prop,value,sessid) + s value=$g(value) + i $e(name,1,4)="tmp_" s zewdSession(name)=value QUIT + s ^%zewdSession("session",sessid,name)=value + QUIT + ; +allowJSONAccess(sessionName,access,sessid) + ; access="r|rw" + s ^%zewdSession("jsonAccess",sessid,sessionName)=access + QUIT + ; +disallowJSONAccess(sessionName,sessid) + k ^%zewdSession("jsonAccess",sessid,sessionName) + QUIT + ; +JSONAccess(sessionName,sessid) + QUIT $g(^%zewdSession("jsonAccess",sessid,sessionName)) + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +isTemp(name) + QUIT $e(name,1,4)="tmp_" + ; + ; +existsInSession(name,sessid) + QUIT $$existsInSession^%zewdCompiler13($g(name),$g(sessid)) + ; +existsInSessionArray(name,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11) + QUIT $$existsInSessionArray^%zewdCompiler13($g(name),$g(p1),$g(p2),$g(p3),$g(p4),$g(p5),$g(p6),$g(p7),$g(p8),$g(p9),$g(p10),$g(p11)) + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +clearSessionArray(arrayName,sessid) + s arrayName=$$stripSpaces(arrayName) + i $g(sessid)="" QUIT + i $g(arrayName)="" QUIT + s arrayName=$tr(arrayName,".","_") + ;i $$isTemp(arrayName) k zewdSession(arrayName) QUIT + i $e(arrayName,1,4)="tmp_" k zewdSession(arrayName) QUIT + k ^%zewdSession("session",sessid,arrayName) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +setSessionArray(arrayName,itemName,itemValue,sessid) + ; + s arrayName=$$stripSpaces(arrayName) + QUIT:$g(arrayName)="" + QUIT:$g(itemName)="" + QUIT:$g(sessid)="" + s arrayName=$tr(arrayName,".","_") + i $$isTemp(arrayName) s zewdSession(arrayName,itemName)=itemValue QUIT + s ^%zewdSession("session",sessid,arrayName,itemName)=itemValue + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +getSessionArray(arrayName,sessid,array,clearArray) + ; + s arrayName=$$stripSpaces(arrayName) + QUIT:$g(arrayName)="" + s arrayName=$tr(arrayName,".","_") + QUIT:$g(sessid)="" + set $zt="getSessionArrayErr" + i $g(clearArray)=1 k array + i $$isTemp(arrayName) m array=zewdSession(arrayName) QUIT + m array=^%zewdSession("session",sessid,arrayName) + QUIT + ; +getSessionArrayErr ; --- Come here if error occurred in 'getSessionArray' --- + set $zt="" + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +addToSession(name,sessid) + s name=$$stripSpaces(name) + QUIT:$g(sessid)="" + QUIT:$g(name)="" + s name=$tr(name,".","_") + i $$isTemp(name) m zewdSession(name)=@name QUIT + m ^%zewdSession("session",sessid,name)=@name + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +mergeToSession(name,sessid) + QUIT:$g(sessid)="" + QUIT:$g(name)="" + d addToSession(name,sessid) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +mergeGlobalToSession(globalName,sessionName,sessid) + d mergeGlobalToSession^%zewdCompiler13($g(globalName),$g(sessionName),$g(sessid)) + QUIT + ; +mergeGlobalFromSession(globalName,sessionName,sessid) + d mergeGlobalFromSession^%zewdCompiler13($g(globalName),$g(sessionName),$g(sessid)) + QUIT + ; +mergeArrayToSession(array,sessionName,sessid) + QUIT:$g(sessid)="" + QUIT:$g(sessionName)="" + s sessionName=$tr(sessionName,".","_") + ;i $$isTemp(sessionName) m zewdSession(sessionName)=array QUIT + i $e(sessionName,1,4)="tmp_" m zewdSession(sessionName)=array QUIT + m ^%zewdSession("session",sessid,sessionName)=array + QUIT + ; +mergeArrayToSessionObject(array,sessionName,sessid) + d mergeArrayToSessionObject^%zewdCompiler16(.array,$g(sessionName),$g(sessid)) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +mergeArrayFromSession(array,sessionName,sessid) + QUIT:$g(sessid)="" + QUIT:$g(sessionName)="" + s sessionName=$tr(sessionName,".","_") + ;i $$isTemp(sessionName) m array=zewdSession(sessionName) QUIT + i $e(sessionName,1,4)="tmp_" m array=zewdSession(sessionName) QUIT + m array=^%zewdSession("session",sessid,sessionName) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +mergeFromSession(name,sessid) + QUIT:$g(sessid)="" + QUIT:$g(name)="" + s name=$tr(name,".","_") + i $$isTemp(name) m @name=zewdSession(name) + m @name=^%zewdSession("session",sessid,name) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +deleteFromSession(name,sessid) + QUIT:$g(sessid)="" + QUIT:$g(name)="" + i name["." d QUIT + . n np,obj,prop + . s np=$l(name,".") + . s obj=$p(name,".",1,np-1) + . s prop=$p(name,".",np) + . d deleteFromSessionObject(obj,prop,sessid) + ;i $$isTemp(name) k zewdSession(name) QUIT + i $e(name,1,4)="tmp_" k zewdSession(name) QUIT + k ^%zewdSession("session",sessid,name) + QUIT + ; +sessionNameExists(name,sessid) + QUIT:$g(sessid)="" + QUIT:$g(name)="" + s name=$tr(name,".","_") + i $$isTemp(name) QUIT $d(zewdSession(name)) + QUIT $d(^%zewdSession("session",sessid,name)) + ; +getSessionArrayValue(arrayName,subscript,sessid,exists) + QUIT $$getSessionArrayValue^%zewdCompiler13($g(arrayName),$g(subscript),$g(sessid),.exists) + ; +sessionArrayValueExists(arrayName,subscript,sessid) + QUIT $$sessionArrayValueExists^%zewdCompiler13($g(arrayName),$g(subscript),$g(sessid)) + ; +deleteSessionArrayValue(arrayName,subscript,sessid) + d deleteSessionArrayValue^%zewdCompiler13($g(arrayName),$g(subscript),$g(sessid)) + QUIT + ; + ; Objects + ; +setSessionObject(objectName,propertyName,propertyValue,sessid) + ;d setSessionObject^%zewdCompiler13($g(objectName),$g(propertyName),$g(propertyValue),$g(sessid)) + ;QUIT + ; + n comma,i,np,p,sessionArray,x + ; + i $g(objectName)="" QUIT + i $g(propertyName)="" QUIT + ;i $g(propertyValue)="" QUIT + i $g(sessid)="" QUIT + s np=$l(objectName,".") + ;s objectName=$$replace(objectName,".","_") + i objectName["." s objectName=$p(objectName,".",1)_"_"_$p(objectName,".",2,2000) + i np=1 d QUIT + . i $e(objectName,1,3)="tmp" s zewdSession(objectName_"_"_propertyName)=propertyValue q + . s ^%zewdSession("session",sessid,(objectName_"_"_propertyName))=propertyValue + ; + f i=1:1:np-1 s p(i)=$p(objectName,".",i) + s comma="," + i $e(objectName,1,4)="tmp_" d + . s x="s zewdSession(",comma="" + e d + . s x="s ^%zewdSession(""session"","_sessid + f i=1:1:np-1 s x=x_comma_""""_p(i)_"""",comma="," + s x=x_","""_propertyName_""")="""_propertyValue_"""" + x x + QUIT + ; +getSessionObject(objectName,propertyName,sessid) + ; + n i,np,p,value,x + ; + i $g(sessid)="" QUIT "" + s value="" + s np=$l(objectName,".") + i objectName[".",objectName'["_" s objectName=$p(objectName,".",1)_"_"_$p(objectName,".",2,2000) + ;s objectName=$$replace(objectName,".","_") + i np=1 QUIT $g(^%zewdSession("session",sessid,(objectName_"_"_propertyName))) + ; + f i=1:1:np-1 s p(i)=$p(objectName,".",i) + s x="s value=$g(^%zewdSession(""session"","_sessid + f i=1:1:np-1 s x=x_","""_p(i)_"""" + s x=x_","""_propertyName_"""))" + x x + QUIT value + ; +deleteFromSessionObject(objectName,propertyName,sessid) + d deleteFromSessionObject^%zewdCompiler13($g(objectName),$g(propertyName),$g(sessid)) + QUIT + ; +sessionObjectPropertyExists(objectName,propertyName,sessid) + QUIT $$sessionObjectPropertyExists^%zewdCompiler13($g(objectName),$g(propertyName),$g(sessid)) + ; +deleteSessionObject(objectName,sessid) + n obj + s obj=objectName + i obj["." s obj=$tr(obj,".","_") + i obj'["_" s obj=obj_"_" + d clearSessionByPrefix(obj,$g(sessid)) + ;d deleteSessionObject^%zewdCompiler13($g(objectName),$g(sessid)) + QUIT + ; +copyObjectToSession(oref,objectName,sessid) + d copyObjectToSession^%zewdCompiler13($g(oref),$g(objectName),$g(sessid)) + QUIT + ; +copyResultSetToSession(oref,objectName,sessid) + d copyResultSetToSession^%zewdCompiler13($g(oref),$g(objectName),$g(sessid)) + QUIT + ; +getResultSetValue(resultSetName,index,propertyName,sessid) + QUIT $$getResultSetValue^%zewdCompiler13($g(resultSetName),$g(index),$g(propertyName),$g(sessid)) + ; +addToResultSet(sessionName,propertyName,value,sessid) + d addToResultSet^%zewdCompiler13($g(sessionName),$g(propertyName),$g(value),$g(sessid)) + QUIT + ; +mergeRecordArrayToResultSet(sessionName,recordArray,sessid) + d mergeRecordArrayToResultSet^%zewdCompiler13($g(sessionName),.recordArray,$g(sessid)) + QUIT + ; +JSONToSessionObject(objectName,jsonString,sessid) + d JSONToSessionObject^%zewdCompiler13($g(objectName),$g(jsonString),$g(sessid)) + QUIT + ; +sessionObjectToJSON(objectName,sessid) + QUIT $$sessionObjectToJSON^%zewdCompiler13($g(objectName),$g(sessid)) + ; +objectGlobalToJSON(objectName) + QUIT $$objectGlobalToJSON^%zewdCompiler13($g(objectName)) + ; +saveJSON(objectName,jsonString) + QUIT $$saveJSON^%zewdCompiler13($g(objectName),$g(jsonString)) + ; +getJSON(objectName,addRefCol) + QUIT $$getJSON^%zewdCompiler13($g(objectName),$g(addRefCol)) + ; +setJSONValue(JSONName,objectName,sessid) + d setJSONValue^%zewdCompiler16($g(JSONName),$g(objectName),$g(sessid)) + d allowJSONAccess(objectName,"r",sessid) + QUIT + ; +convertToJSON(arrayName,isExtJS) + n dojo + i '$d(@arrayName) QUIT "" + s dojo="" + i $g(isExtJS)=1 s dojo=2 + QUIT $$walkArray^%zewdCompiler13("",arrayName,dojo) + ; +mergeToJSObject(sessionObject,JSObject) + QUIT $$mergeToJSObject^%zewdCompiler13($g(sessionObject),$g(JSObject),$g(sessid)) + ; + ; Javascript objects + ; +getJavascriptObjectBlock(objectName,docName,textArray) + QUIT $$getJavascriptObjectBlock^%zewdCompiler13($g(objectName),$g(docName),.textArray) + ; +replaceJavascriptObject(objectName,newFunctionText,docName) + QUIT $$replaceJavascriptObject^%zewdCompiler13($g(objectName),$g(newFunctionText),$g(docName)) + ; +replaceJavascriptObjectBody(functionName,newBody,docName) + QUIT $$replaceJavascriptObjectBody^%zewdCompiler13($g(functionName),$g(newBody),$g(docName)) + ; +getJavascriptObjectBody(functionName,docName) + QUIT $$getJavascriptObjectBody^%zewdCompiler13($g(functionName),$g(docName)) + ; +getJavascriptObject(objectName,docName,eOID) + QUIT $$getJavascriptObject^%zewdCompiler13($g(objectName),$g(docName),$g(eOID)) + ; +javascriptObjectExists(objectName,docName) + QUIT $$javascriptObjectExists^%zewdCompiler13($g(objectName),$g(docName)) + ; +getLastJavascriptTag(docName,textArray) + QUIT $$getLastJavascriptTag^%zewdCompiler13($g(docName),.textArray) + ; +addJavascriptObject(docName,jsText) + QUIT $$addJavascriptObject^%zewdCompiler13($g(docName),.jsText) + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +setSessionValues(nvArray,sessid) + ; + QUIT:$g(sessid)="" + n name,no,value + s name="" + f s name=$o(nvArray(name)) q:name="" d + . d deleteFromSession(name,sessid) + . d clearSelected(name,sessid) + . s value=$g(nvArray(name)) + . d setSessionValue(name,value,sessid) + . s no="" + . f s no=$o(nvArray(name,no)) q:no="" d + . . s value=nvArray(name,no) + . . d addToSelected(name,value,sessid) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +getSessionValues(prefix,nvArray,sessid) + ; + n len,name,no,value + QUIT:$g(sessid)="" + QUIT:$g(prefix)="" + set $zt="getSessionValuesErr" + s len=$l(prefix) + k nvArray + s name=prefix + f s name=$o(^%zewdSession("session",sessid,name)) q:name="" q:$e(name,1,len)'=prefix d + . d setNVArray(name,.nvArray,sessid) + s name=prefix,no=0 + f s name=$o(^%zewdSession("session",sessid,"ewd_selected",name)) q:name="" q:$e(name,1,len)'=prefix d + . s value="" + . f s value=$o(^%zewdSession("session",sessid,"ewd_selected",name,value)) q:value="" d + . . s no=no+1 + . . s nvArray(name,no)=value + QUIT + ; +getSessionValuesErr ; --- Come here if error occurred in 'getSessionValues' --- + set $zt="" + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +getSessionValuesByPrefix(prefix,sessid) + ; + n len,name + QUIT:$g(sessid)="" + QUIT:$g(prefix)="" + s prefix=$tr(prefix,".","_") + set $zt="getSessionValuesByPrefixErr" + s len=$l(prefix) + s name=prefix + f s name=$o(^%zewdSession("session",sessid,name)) q:name="" q:$e(name,1,len)'=prefix d + . i name?1A.AN m @name=^%zewdSession("session",sessid,name) + QUIT + ; +getSessionValuesByPrefixErr + set $zt="" + QUIT + ; +setNVArray(name,nvArray,sessid) + n selected,value,no + s nvArray(name)=$$getSessionValue(name,sessid) + QUIT + ; +clearSessionByPrefix(prefix,sessid) + ; + n len,name + QUIT:$g(sessid)="" + QUIT:$g(prefix)="" + s prefix=$tr(prefix,".","_") + s len=$l(prefix) + ; + s name=prefix + f s name=$o(^%zewdSession("session",sessid,name)) q:name="" q:$e(name,1,len)'=prefix d + . i $e(name,1,4)="ewd_" q + . d deleteFromSession(name,sessid) + s name=prefix + f s name=$o(^%zewdSession("session",sessid,"ewd_selected",name)) q:name="" q:$e(name,1,len)'=prefix d + . d clearSelected(name,sessid) + s name=prefix + f s name=$o(^%zewdSession("session",sessid,"ewd_list",name)) q:name="" q:$e(name,1,len)'=prefix d + . d clearList(name,sessid) + s name=prefix + f s name=$o(^%zewdSession("session",sessid,"ewd_textarea",name)) q:name="" q:$e(name,1,len)'=prefix d + . d clearTextArea(name,sessid) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; + ; HTML Form-specific APIs + ; +getTextValue(fieldName,sessid) + QUIT $$getSessionValue(fieldName,sessid) + ; +setTextValue(fieldName,value,sessid) + d setSessionValue(fieldName,value,sessid) + QUIT + ; +getPasswordValue(fieldName,sessid) + QUIT $$getSessionValue(fieldName,sessid) + ; +getHiddenValue(fieldName,sessid) + QUIT $$getSessionValue(fieldName,sessid) + ; +setHiddenValue(fieldName,value,sessid) + d setSessionValue(fieldName,value,sessid) + ; +getRadioValue(fieldName,sessid) + QUIT $$getSessionValue(fieldName,sessid) + ; +setRadioOn(fieldName,value,sessid) + d setSessionValue(fieldName,value,sessid) + QUIT + ; +isRadionOn(fieldName,value,sessid) + QUIT $$getRadioValue(fieldName,sessid)=value + ; +isCheckboxOn(fieldName,value,sessid) + QUIT $$isSelected(fieldName,value,sessid) + ; +getCheckboxValues(fieldName,selectedValueArray,sessid) + d mergeFromSelected(fieldName,.selectedValueArray,sessid) + QUIT + ; +initialiseCheckbox(fieldName,sessid) + d clearSelected(fieldName,sessid) + QUIT + ; +setCheckboxOn(fieldName,value,sessid) + d addToSelected(fieldName,value,sessid) + QUIT + ; +setCheckboxOff(fieldName,value,sessid) + d removeFromSelected(fieldName,value,sessid) + ; +setCheckboxValues(fieldName,selectedValueArray,sessid) + ; + ; array format : array(checkboxValue)=checkboxValue + ; eg selected("red")="red" + ; + d mergeToSelected(fieldName,.selectedValueArray,sessid) + QUIT + ; +getSelectValue(fieldName,sessid,nullify) + ; + n value + ; + s value=$$getSessionValue(fieldName,sessid) + i $a(value)=160 s value="" + QUIT value + ; +setSelectValue(fieldName,value,sessid) + d setSessionValue(fieldName,value,sessid) + ; +isSelectOn(fieldName,value,sessid) + QUIT $$getSelectValue(fieldName,sessid)=value + ; +isMultipleSelectOn(fieldName,value,sessid) + QUIT $$isSelected(fieldName,value,sessid) + ; +getMultipleSelectValues(fieldName,selectedValueArray,sessid) + d mergeFromSelected(fieldName,.selectedValueArray,sessid) + QUIT + ; +initialiseMultipleSelect(fieldName,sessid) + d clearSelected(fieldName,sessid) + QUIT + ; +setMultipleSelectOn(fieldName,value,sessid) + d addToSelected(fieldName,value,sessid) + QUIT + ; +setMultipleSelectOff(fieldName,value,sessid) + d removeFromSelected(fieldName,value,sessid) + ; +setMultipleSelectValues(fieldName,selectedValueArray,sessid) + ; + ; array format : array(checkboxValue)=checkboxValue + ; eg selected("red")="red" + ; + d mergeToSelected(fieldName,.selectedValueArray,sessid) + QUIT + ; +getTextArea(fieldName,textArray,sessid) + d mergeFromTextArea(fieldName,.textArray,sessid) + QUIT + ; +setFieldError(fieldName,sessid) + ; + n errors + s errors(fieldName)=$$getSessionValue("ewd_errorClass",sessid) + d mergeArrayToSession^%zewdAPI(.errors,"ewd_errorFields",sessid) + d setSessionValue^%zewdAPI("ewd_hasErrors",1,sessid) + QUIT + ; +setErrorClasses() + QUIT $$setErrorClasses^%zewdUtilities() + ; +getRequestValue(fieldName,sessid) + set $zt="getRequestValueErr" + s sessid=$g(sessid) + i $g(fieldName)="" QUIT "" + QUIT $g(requestArray(fieldName)) + ; +getRequestValueErr + set $zt="" + QUIT "" + ; +mergeFromRequest(array,fieldName,sessid) + QUIT:fieldName="" + m array=requestArray(fieldName) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +copyRequestValueToSession(fieldName,sessid) + ; + QUIT:$g(sessid)="" + QUIT:$g(fieldName)="" + i $$isTemp(fieldName) m zewdSession(fieldName)=requestArray(fieldName) + m ^%zewdSession("session",sessid,fieldName)=requestArray(fieldName) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +getCookieValue(cookieName,sessid) + QUIT:$g(cookieName)="" + set $zt="getCookieValueErr" + QUIT $g(requestArray(cookieName)) + ; +getCookieValueErr ; --- Come here if error occurred in 'getCookieValue' --- + set $zt="" + QUIT "" + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +deleteCookie(cookieName,sessid) + d setCookieValue(cookieName,"",-3600,sessid) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +convertDaysToSeconds(days) + QUIT days*86400 + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +parseHTMLFile(filepath,docName) + QUIT $$parseHTMLFile^%zewdCompiler16($g(filepath),$g(docName)) + ; +parseXMLFile(filepath,docName) + QUIT $$parseXMLFile^%zewdCompiler16($g(filepath),$g(docName)) + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +parseStream(streamName,docName,error,isHTML) + d parseStream^%zewdCompiler16($g(streamName),$g(docName),.error,$g(isHTML)) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +parseHTMLStream(streamName,docName) + QUIT $$parseHTMLStream^%zewdCompiler16($g(streamName),$g(docName)) + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +parseURL(server,getPath,docName,port,isHTML,responseTime,browserType,post) + ; + QUIT $$parseURL^%zewdHTMLParser($g(server),$g(getPath),$g(docName),$g(port),$g(isHTML),.responseTime,$g(browserType),$g(post)) + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +setCookieValue(cookieName,value,expiryDuration,sessid) + ; + ; expiryDuration is no of seconds + ; + n expires + s expires=expiryDuration + i $$isCSP(sessid) d + . s expires=$$convertDateToSeconds($h)+expires + . s expires=$$convertSecondsToDate(expires) + . s expires=$$inetDate(expires) + s value=value_$c(1)_expires + d setSessionArray("ewd_cookie",cookieName,value,sessid) + ; + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +setResponseHeader(headerName,headerValue,sessid) + d setSessionArray^%zewdAPI("ewd_header",$g(headerName),$g(headerValue),$g(sessid)) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +suppressResponseHeader(headerName,sessid) + i $$isCSP(sessid) d setResponseHeader(headerName,"",sessid) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +addServerToSession(sessid,serverArray) + d addServerToSession^%zewdCompiler13($g(sessid),.serverArray) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +getServerValue(serverFieldName,sessid) + ; + s sessid=$g(sessid) + set $zt="getServerValueErr" + s $zt="g "_$zt + i $g(serverFieldName)="" QUIT "" + ; + s $zt="" + QUIT $g(serverArray(serverFieldName)) + ; +getServerValueErr ; --- Come here if error occurred in 'getServerValue' --- + set $zt="" + QUIT "" + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +deleteWarning(sessid) + QUIT:$g(sessid)="" + d deleteFromSession("ewd_warning",sessid) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +setWarning(warningMessage,sessid) + QUIT:$g(sessid)="" + QUIT:$g(warningMessage)="" + s warningMessage=$$systemMessage(warningMessage,"warning",sessid) + i '$$isCSP(sessid) s warningMessage=$$zcvt(warningMessage,"o","JS") + d setSessionValue("ewd_warning",warningMessage,sessid) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +clearAllSelected(sessid) + k ^%zewdSession("session",sessid,"ewd_selected") + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +clearSelected(fieldName,sessid) + QUIT:$g(fieldName)="" + QUIT:$g(sessid)="" + s fieldName=$tr(fieldName,".","_") + k ^%zewdSession("session",sessid,"ewd_selected",fieldName) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +addToSelected(fieldName,fieldValue,sessid) + ; + n shortFieldValue + QUIT:$g(fieldName)="" + QUIT:$g(sessid)="" + QUIT:$g(fieldValue)="" + s fieldName=$tr(fieldName,".","_") + s shortFieldValue=$e(fieldValue,1,200) + s ^%zewdSession("session",sessid,"ewd_selected",fieldName,shortFieldValue)=fieldValue + QUIT + ; +removeFromSelected(fieldName,fieldValue,sessid) + ; + n shortFieldValue + QUIT:$g(fieldName)="" + QUIT:$g(sessid)="" + QUIT:$g(fieldValue)="" + s fieldName=$tr(fieldName,".","_") + s shortFieldValue=$e(fieldValue,1,200) + k ^%zewdSession("session",sessid,"ewd_selected",fieldName,shortFieldValue) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +mergeFromSelected(fieldName,selected,sessid) + ; + k selected + s fieldName=$tr(fieldName,".","_") + m selected=^%zewdSession("session",sessid,"ewd_selected",fieldName) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +mergeToSelected(fieldName,selected,sessid) + ; + s fieldName=$tr(fieldName,".","_") + ; + k ^%zewdSession("session",sessid,"ewd_selected",fieldName) + m ^%zewdSession("session",sessid,"ewd_selected",fieldName)=selected + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +isSelected(fieldName,fieldValue,sessid) + n shortFieldValue + i $g(fieldName)="" QUIT 0 + i $g(sessid)="" QUIT 0 + i $g(fieldValue)="" QUIT 0 + s fieldName=$tr(fieldName,".","_") + set $zt="isSelectedErr" + s shortFieldValue=$e(fieldValue,1,200) + QUIT $d(^%zewdSession("session",sessid,"ewd_selected",fieldName,shortFieldValue)) + ; +isSelectedErr ; --- Come here if error occurred in 'isSelected' --- + set $zt="" + QUIT 0 + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +clearTextArea(fieldName,sessid) + QUIT:$g(fieldName)="" + QUIT:$g(sessid)="" + s fieldName=$tr(fieldName,".","_") + k ^%zewdSession("session",sessid,"ewd_textarea",fieldName) + s ^%zewdSession("session",sessid,"ewd_textarea",fieldName,1)="" + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +createTextArea(fieldName,textArray,sessid) + ; + QUIT:$g(fieldName)="" + QUIT:$g(sessid)="" + s fieldName=$tr(fieldName,".","_") + m ^%zewdSession("session",sessid,"ewd_textarea",fieldName)=textArray + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +mergeTextAreaFromRequest(fieldName,requestArray,sessid) + ; + q:$g(sessid)="" + s fieldName=$tr(fieldName,".","_") + ; + q:'$d(^%zewdSession("session",sessid,"ewd_textarea",fieldName)) + d clearTextArea(fieldName,sessid) + m ^%zewdSession("session",sessid,"ewd_textarea",fieldName)=requestArray(fieldName) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +appendToTextArea(fieldName,lineOfText,sessid) + ; + n position + ; + QUIT:$g(fieldName)="" + QUIT:$g(sessid)="" + s fieldName=$tr(fieldName,".","_") + ; + s position=$o(^%zewdSession("session",sessid,"ewd_textarea",fieldName,""),-1)+1 + s ^%zewdSession("session",sessid,"ewd_textarea",fieldName,position)=lineOfText + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +mergeFromTextArea(fieldName,textArray,sessid) + ; + s fieldName=$tr(fieldName,".","_") + m textArray=^%zewdSession("session",sessid,"ewd_textarea",fieldName) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +mergeToTextArea(fieldName,textArray,sessid) + ; + s fieldName=$tr(fieldName,".","_") + m ^%zewdSession("session",sessid,"ewd_textarea",fieldName)=textArray + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +clearList(listName,sessid) + QUIT:$g(listName)="" + QUIT:$g(sessid)="" + s listName=$tr(listName,".","_") + k ^%zewdSession("session",sessid,"ewd_list",listName) + k ^%zewdSession("session",sessid,"ewd_listIndex",listName) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +isListDefined(listName,sessid) + QUIT $d(^%zewdSession("session",sessid,"ewd_list",listName)) + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +countList(listName,sessid) + QUIT $$countList^%zewdCompiler16($g(listName),$g(sessid)) + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +appendToList(listName,textValue,codeValue,sessid,otherAttrs) + ; + n position + ; + QUIT:$g(listName)="" + QUIT:$g(sessid)="" + ;QUIT:$g(textValue)="" + ;QUIT:$g(codeValue)="" + s listName=$tr(listName,".","_") + ; + s position=$o(^%zewdSession("session",sessid,"ewd_list",listName,""),-1)+1 + d addToList(listName,textValue,codeValue,position,sessid,.otherAttrs) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +addToList(listName,textValue,codeValue,position,sessid,otherAttrs) + ;d addToList^%zewdCompiler16($g(listName),$g(textValue),$g(codeValue),$g(position),$g(sessid),.otherAttrs) + ; + n attrList,attrName + ; + QUIT:$g(listName)="" + QUIT:$g(sessid)="" + QUIT:$g(position)="" + i $g(codeValue)="",$g(textValue)="" QUIT + s position=+position + d removeFromList(listName,codeValue,sessid) ; just in case + s attrName="",attrList="" + f s attrName=$o(otherAttrs(attrName)) q:attrName="" d + . s attrList=attrList_attrName_$c(3)_otherAttrs(attrName)_$c(1) + ; + s codeValue=$g(codeValue) i codeValue="" s codeValue=textValue + s ^%zewdSession("session",sessid,"ewd_list",listName,position)=textValue_$c(1)_codeValue_$c(1)_attrList + s ^%zewdSession("session",sessid,"ewd_listIndex",listName,codeValue)=position + k otherAttrs + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +mergeToList(listName,listArray,sessid) + ; + d mergeToList^%zewdCompiler7(listName,.listArray,sessid) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +removeFromList(listName,codeValue,sessid) + ; + ;d removeFromList^%zewdCompiler7(listName,codeValue,sessid) + n position + ; + QUIT:$g(listName)="" + QUIT:$g(sessid)="" + QUIT:$g(codeValue)="" + ; + s position=$g(^%zewdSession("session",sessid,"ewd_listIndex",listName,codeValue)) + QUIT:position="" + k ^%zewdSession("session",sessid,"ewd_list",listName,position) + k ^%zewdSession("session",sessid,"ewd_listIndex",listName,codeValue) + d setWLDSymbol("ewd_list",sessid) + d setWLDSymbol("ewd_listIndex",sessid) + QUIT + ; + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +copyList(fromListName,toListName,sessid) + ; + d copyList^%zewdCompiler7($g(fromListName),$g(toListName),$g(sessid)) + QUIT + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +getTextFromList(listName,codeValue,sessid) + ; + QUIT $$getTextFromList^%zewdCompiler7(listName,codeValue,sessid) + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +replaceOptionsByFieldName(formName,fieldName,listName,sessid) + ; + QUIT $$replaceOptionsByFieldName^%zewdCompiler7(formName,fieldName,listName,sessid) + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +replaceOptionsByID(fieldID,listName,sessid) + ; + QUIT $$replaceOptionsByID^%zewdCompiler7(fieldID,listName,sessid) + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +getUploadedFileName(fieldName,sessid) + ; + n filename,technology + s technology=$$getSessionValue^%zewdAPI("ewd_technology",sessid) + QUIT 0 + ; +getUploadedFileNameErr + set $zt="" + QUIT "" + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +getUploadedFileSize(fieldName,sessid) + ; + set $zt="getUploadedFileSizeErr" + QUIT 0 + ; +getUploadedFileSizeErr ; + set $zt="" + QUIT "" + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +getUploadedFileType(fieldName,sessid) + ; + set $zt="getUploadedFileTypeErr" + QUIT 0 + ; +getUploadedFileTypeErr + set $zt="" + QUIT "" + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +errorOccurred(sessid) + ; + n warning + ; + i $g(Error)="" QUIT 0 + s warning=$$getSessionValue("ewd_warning",sessid) + QUIT Error'=warning + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +removeQuotes(string) + ; + n quoted,c1,quote + s quote="" + s c1=$e(string,1) + s quoted=0 + i c1=""""!(c1="'") s quoted=1,quote=c1 + i 'quoted QUIT string + i $e(string,$l(string))'=quote QUIT string + QUIT $e(string,2,$l(string)-1) + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +escapeQuotes(text) + ; + s text=$$replaceAll(text,"'",$c(4)) + s text=$$replaceAll(text,$c(4),"\'") + s text=$$replaceAll(text,"""",$c(4)) + s text=$$replaceAll(text,$c(4),"\""") + ; + QUIT text + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +getAttrValue(attrName,attrValues,technology) + QUIT $$getAttrValue^%zewdCompiler4(attrName,.attrValues,technology) + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +replaceAll(InText,FromStr,ToStr) ; Replace all occurrences of a substring + ; + n %p + ; + s %p=InText + i ToStr[FromStr d QUIT %p + . n i,stop,tempText,tempTo + . s stop=0 + . f i=0:1:255 d q:stop + . . q:InText[$c(i) + . . q:FromStr[$c(i) + . . q:ToStr[$c(i) + . . s stop=1 + . s tempTo=$c(i) + . s tempText=$$replaceAll(InText,FromStr,tempTo) + . s %p=$$replaceAll(tempText,tempTo,ToStr) + f q:%p'[FromStr S %p=$$replace(%p,FromStr,ToStr) + QUIT %p + ; +replace(InText,FromStr,ToStr) ; replace old with new in string + ; + n %p1,%p2 + ; + i InText'[FromStr q InText + s %p1=$p(InText,FromStr,1),%p2=$p(InText,FromStr,2,255) + QUIT %p1_ToStr_%p2 + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +addImmediateOneOffTask(executeCode,startTime,namespace,rc,rm) + QUIT $$addImmediateOneOffTask^%zewdScheduler($g(executeCode),$g(startTime),$g(namespace),.rc,.rm) + ; + ;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= + ; +getDataTypeErrors(errorArray,sessid) + k errorArray + d mergeArrayFromSession(.errorArray,"ewd_DataTypeError",sessid) + QUIT + ; +clearSchemaFormErrors(sessid) + d deleteFromSession("ewd_SchemaFormError",sessid) + QUIT + ; +getSchemaFormErrors(errorArray,sessid) + QUIT $$getSchemaFormErrors^%zewdCompiler13(.errorArray,$g(sessid)) + ; +setSchemaFormErrors(errorArray,sessid) + ; + n sessionName + ; + s sessionName="ewd_SchemaFormError" + d deleteFromSession(sessionName,sessid) + d mergeArrayToSession(.errorArray,sessionName,sessid) + QUIT + ; +removeInstanceDocument(instanceName) + ; + n ok + s ok=$$openDOM + i ok'="" QUIT ok + s ok=$$removeDocument^%zewdDOM(instanceName,"","") + d clearXMLIndex^%zewdSchemaForm(instanceName) + s ok=$$closeDOM^%zewdDOM() + QUIT "" + ; + ; +makeTokenString(length) + ; + n string,token,i + ; + s string="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890" + s token="" + f i=1:1:length s token=token_$e(string,($r($l(string))+1)) + QUIT token + ; +makeString(%char,%len) ; create a string of len characters + ; + n %str + ; + s %str="",$p(%str,%char,%len+1)="" + QUIT %str + ; +convertDateToSeconds(hdate) + ; + Q (hdate*86400)+$p(hdate,",",2) + ; +convertSecondsToDate(secs) + ; + QUIT (secs\86400)_","_(secs#86400) + ; +getTokenExpiry(token) + ; + n sessid + ; + i $g(token)="" QUIT 0 + s sessid=+$g(^%zewdSession("tokens",token)) + i sessid="" QUIT 0 + QUIT $$getSessionValue("ewd_sessionExpiry",sessid) + ; +isTokenExpired(token) + ; + ;QUIT $$getTokenExpiry(token)'>$$convertDateToSeconds($h) + QUIT $$getTokenExpiry(token)'>(($h*86400)+$p($h,",",2)) + ; +randChar() + ; + n string + ; + s string="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890" + QUIT $e(string,($R($l(string))+1)) + ; +lowerCase(string) + QUIT $tr(string,"ABCDEFGHIJKLMNOPQRSTUVQXYZ","abcdefghijklmnopqrstuvwxyz") + ; +stripSpaces(string) + s string=$$stripLeadingSpaces(string) + QUIT $$stripTrailingSpaces(string) + ; +stripLeadingSpaces(string) + n i + ; + f i=1:1:$l(string) QUIT:$e(string,i)'=" " + QUIT $e(string,i,$l(string)) + ; +stripTrailingSpaces(string) + n i,spaces,new + ; + s spaces=$$makeString(" ",100) + s new=string_spaces + QUIT $p(new,spaces,1) + ; +parseMethod(methodString,class,method) + ; + n %p1,%p2,meth + ; + s %p1=$p(methodString,"##class(",2) + s class=$p(%p1,")",1) + s %p2=$p(%p1,")",2,500) + s method=$p(%p2,".",2) + s method=$p(method,"(",1) + QUIT + ; +event(requestArray) + QUIT $$event^%zewdPHP(.requestArray) + ; +clearURLNVP(urlNo) + ; + QUIT + ; +setURLNVP(urlNo,name) + ; + QUIT + ; +decodeDataType(name,dataType,sessid) + ; + n value,inputMethod,x,decodedValue + ; + q:$g(name)="" + q:$g(dataType)="" + s value=$$getSessionValue(name,sessid) + s inputMethod=$$getInputMethod^%zewdCompiler(dataType) + q:inputMethod="" + s x="s decodedValue=$$"_inputMethod_"("""_value_""",sessid)" + x x + d setSessionValue(name,decodedValue,sessid) + QUIT + ; +encodeDataType(name,dataType,sessid) + QUIT $$encodeDataType^%zewdCompiler13($g(name),$g(dataType),$g(sessid)) + ; +copyURLNVPsToSession(urlNo) + ; + n name + ; + QUIT + ; +doubleQuotes(string) + ; + s string=$$replaceAll(string,"""",$c(1,1)) + s string=$tr(string,$c(1),"""") + QUIT string + ; + ; ========================================================================== + ; Error Trap Functions + ; ========================================================================== + ; +copySessionToSymbolTable(sessid) + d copySessionToSymbolTable^%zewdCompiler16($g(sessid)) + QUIT + ; +saveSymbolTable(sessid) + ; + n ok + ;s sessid=0 + k ^%zewdError(sessid) + n %zzv + k ^%zewdError(sessid) + s %zzv="%" + f s %zzv=$o(@%zzv) Q:%zzv="" m ^%zewdError(sessid,%zzv)=@%zzv + QUIT + ; +recoverSymbolTable(sessid,web) + n (sessid,web) + n %zzv + s %zzv="" + f s %zzv=$o(^%zewdError(sessid,%zzv)) QUIT:%zzv="" d + . m @%zzv=^%zewdError(sessid,%zzv) + d writeSymbolTable(web) + QUIT + ; +writeSymbolTable(web) + i $g(web) w "
"
+ zwrite
+ i $g(web) w "
" + QUIT + ; +loadErrorSymbols(sessid) + d loadErrorSymbols^%zewdCompiler19($g(sessid)) + QUIT + ; +deleteErrorLog(sessid) + k ^%zewdError(sessid) + QUIT + ; +deleteAllErrorLogs + k ^%zewdError + QUIT + ; +fileSize(path) + QUIT $$fileSize^%zewdCompiler13($g(path)) + ; +fileExists(path) + QUIT $$fileExists^%zewdCompiler13($g(path)) + ; +fileInfo(path,info) + d fileInfo^%zewdCompiler13($g(path),.info) + QUIT + ; +directoryExists(path) + QUIT $$directoryExists^%zewdCompiler13($g(path)) + ; +deleteFile(filepath) + QUIT $$deleteFile^%zewdCompiler13($g(filepath)) + ; +renameFile(filepath,newpath) + QUIT $$renameFile^%zewdCompiler13($g(filepath),$g(newpath)) + ; +createDirectory(path) + QUIT $$createDirectory^%zewdCompiler13($g(path)) + ; +removeCR(string) + i $e(string,$l(string))=$c(13) s string=$e(string,1,$l(string)-1) + QUIT string + ; +setApplicationRootPath(path) + d setApplicationRootPath^%zewdCompiler(path) + QUIT + ; +applicationRootPath() + QUIT $$applicationRootPath^%zewdCompiler() + ; +getApplicationRootPath() + QUIT $$getApplicationRootPath^%zewdCompiler() + ; +setOutputRootPath(path,technology) + d setOutputRootPath^%zewdCompiler(path,technology) + QUIT + ; +getRootURL(technology) + QUIT $$getRootURL^%zewdCompiler(technology) + ; +setRootURL(cspURL,technology) + d setRootURL^%zewdCompiler(cspURL,technology) + QUIT + ; +getDefaultTechnology() + QUIT $$getDefaultTechnology^%zewdCompiler() + ; +getDefaultMultiLingual() + QUIT $$getDefaultMultiLingual^%zewdCompiler() + ; +getOutputRootPath(technology) + QUIT $$getOutputRootPath^%zewdCompiler(technology) + ; +getJSScriptsPath(app,technology) + QUIT $$getJSScriptsPath^%zewdCompiler8(app,technology) + ; +getJSScriptsPathMode(technology) + QUIT $$getJSScriptsPathMode^%zewdCompiler8(technology) + ; +setJSScriptsPathMode(technology,mode) + d setJSScriptsPathMode^%zewdCompiler8(technology,mode) + QUIT + ; +getJSScriptsRootPath(technology) + QUIT $$getJSScriptsRootPath^%zewdCompiler8(technology) + ; +setJSScriptsRootPath(technology,path) + d setJSScriptsRootPath^%zewdCompiler8(technology,path) + QUIT + ; +getHomePage() + QUIT $$getHomePage^%zewdCompiler() + ; +setHomePage(homePage) + d setHomePage^%zewdCompiler($g(homePage)) + QUIT + ; +getApplications(appList) + QUIT $$getApplications^%zewdCompiler16(.appList) + ; +getPages(application,pageList) + QUIT $$getPages^%zewdCompiler16($g(application),.pageList) + ; +getDefaultFormat() + QUIT $$getDefaultFormat^%zewdCompiler() + ; +getNextChild(parentOID,childOID) + i $g(parentOID)="" QUIT "" + i childOID="" QUIT $$getFirstChild^%zewdDOM(parentOID) + QUIT $$getNextSibling^%zewdDOM(childOID) + ; +addCSPServerScript(parentOID,text) + QUIT $$addCSPServerScript^%zewdCompiler4(parentOID,text) + ; +createPHPCommand(data,docOID) + QUIT $$createPHPCommand^%zewdCompiler4(data,docOID) + ; +createJSPCommand(data,docOID) + QUIT $$createJSPCommand^%zewdCompiler4(data,docOID) + ; +instantiateJSPVar(var,type,docOID,arraySize,initialValue) + d instantiateJSPVar^%zewdCompiler4(var,type,docOID,arraySize,initialValue) + QUIT + ; +removeIntermediateNode(inOID) + d removeIntermediateNode^%zewdCompiler4(inOID) + QUIT + ; +getNormalisedAttributeValue(attrName,nodeOID,technology) + QUIT $$getNormalAttributeValue^%zewdCompiler($g(attrName),$g(nodeOID),$g(technology)) + ; +getNormalAttributeValue(attrName,nodeOID,technology) + QUIT $$getNormalAttributeValue^%zewdCompiler($g(attrName),$g(nodeOID),$g(technology)) + ; +getTagOID(tagName,docName,lowerCase) + QUIT $$getTagOID^%zewdCompiler($g(tagName),$g(docName),$g(lowerCase)) + ; +getTagByNameAndAttr(tagName,attrName,attrValue,matchCase,docName) + QUIT $$getTagByNameAndAttr^%zewdCompiler3($g(tagName),$g(attrName),$g(attrValue),$g(matchCase),$g(docName)) + ; +javascriptFunctionExists(functionName,docName) + QUIT $$javascriptFunctionExists^%zewdCompiler7($g(functionName),$g(docName)) + ; +addJavascriptFunction(docName,jsTextArray) + QUIT $$addJavascriptFunction^%zewdCompiler7($g(docName),.jsTextArray) + ; +getJavascriptFunctionBody(functionName,docName) + QUIT $$getJavascriptFunctionBody^%zewdCompiler7($g(functionName),docName) + ; +replaceJavascriptFunctionBody(functionName,jsText,docName) + QUIT $$replaceJavascriptFunctionBody^%zewdCompiler7($g(functionName),$g(jsText),$g(docName)) + ; +getDelim() + QUIT $$getDelim^%zewdCompiler() + ; + ; =========================================================================== + ; WLD conversion utilities + ; =========================================================================== + ; +configureWebLink(webserver,mode,alias,path) + QUIT $$configure^%zewdWLD($g(webserver),$g(mode),$g(alias),$g(path)) + ; +mergeListToSession(fieldName,sessid) + d mergeListToSession^%zewdCompiler16($g(fieldName),$g(sessid)) + QUIT + ; +getPREVPAGE(sessid) ; + QUIT $$getPREVPAGE^%zewdCompiler19($g(sessid)) ; + ; +copyToWLDSymbolTable(sessid) + d copyToWLDSymbolTable^%zewdCompiler16($g(sessid)) + ; +getPRESSED(sessid) + QUIT $$getSessionValue("ewd_pressed",sessid) + ; +copyToLIST(listName,sessid) + ; + k LIST(listName) + m LIST(listName)=^%zewdSession("session",sessid,"ewd_list",listName) + QUIT + ; +copyToSELECTED(fieldName,sessid) + ; + k SELECTED(fieldName) + m SELECTED(fieldName)=^%zewdSession("session",sessid,"ewd_selected",fieldName) + QUIT + ; +traceModeOn + s ^zewd("trace")=1 + QUIT + ; +traceModeOff + k ^zewd("trace") + QUIT + ; +getTraceMode() + i $g(^zewd("trace"))=1 QUIT 1 + QUIT 0 + ; +trace(text,clear) ; trace ; + n i + s text=$g(text) + i $g(clear)=1 k ^%zewdTrace + s i=$increment(^%zewdTrace) + s ^%zewdTrace(i)=text + QUIT + ; +inetDate(hdate) ; Decode $H date and time to Internet format + ; + N %d,%day,%time,%date + ; + S %time=$P(hdate,",",2) + I %time>86400 D + .S %time=%time-86400 + .S hdate=(hdate+1)_","_%time + ; + S %d="Thu,Fri,Sat,Sun,Mon,Tue,Wed" + S %day=(hdate#7)+1 + S %day=$P(%d,",",%day) + ; + S %date=$$decDate(hdate) + ;S %date=$TR(%date," ","-") + S %time=$$inetTime(hdate) + S %date=%day_", "_%date_" "_%time + Q %date +decDate(hdate) ; Decode a date from $H format + ; + n %yy,%mm,%dd,%d1,%d + i $zv'["GT.M" d + . s %d1=$zd(hdate,5) + . s %yy=$p(%d1,", ",2) + . s %dd=+$p(%d1," ",2) I %dd<10 S %dd="0"_%dd + . s %mm=$p(%d1," ",1) + e d + . n p1,p2 + . s %d1=$zd(hdate,2) + . s %dd=$p(%d1,"-",1) + . s %mm=$p(%d1,"-",2) + . s p1=$e(%mm,1),p2=$e(%mm,2,$l(%mm)) + . s %mm=p1_$$lowerCase(p2) + . s %yy=$p(%d1,"-",3) + . i hdate>58073 s %yy="20"_%yy + s %d=%dd_" "_%mm_" "_%yy + QUIT %d + ; +inetTime(hdate) ; Decode Internet Format Time from $H format + ; Offset is relative to GMT, eg -0500 + ; + n hh,mm,ss,time + s time=$p(hdate,",",2) + s hh=time\3600 i hh<10 s hh="0"_hh + s time=time#3600 + s mm=time\60 i mm<10 s mm="0"_mm + s ss=time#60 i ss<10 s ss="0"_ss + QUIT hh_":"_mm_":"_ss + ; +openNewFile(filepath) + QUIT $$openNewFile^%zewdCompiler($g(filepath)) + ; +openFile(filepath) + QUIT $$openFile^%zewdCompiler($g(filepath)) + ; +openDOM() + ; + n i,ok + ; + f i=1:1:20 s ok=$$openDOM^%zewdDOM(0,,,,,,,,,,,,,,,,,) q:$$zcvt(ok,"l")["licensing violation" q:ok="" h 1 + i ok'="" s ok="No eXtc Licenses available!" + QUIT ok + ; +removeChild(nodeOID,removeFromDOM) + ; + n ver + ; + s ver="" + QUIT $$removeChild^%zewdDOM(nodeOID,$g(removeFromDOM)) + ; +removeAttribute(attrName,nodeOID,removeFromDOM) + ; + n ver + ; + s ver="" + d removeAttribute^%zewdDOM(attrName,nodeOID,$g(removeFromDOM)) QUIT + ; +removeAttributeNS(ns,attrName,nodeOID,removeFromDOM) + ; + n ver + ; + s ver="" + d removeAttributeNS^%zewdDOM(ns,attrName,nodeOID,$g(removeFromDOM)) QUIT + ; +removeIntermediateNodeeXtc(nodeOID,removeFromDOM) + ; + n ver + ; + d removeIntermediateNode^%zewdDOM(nodeOID,$g(removeFromDOM)) + QUIT + ; +export(fileName,prefix,extension) + d export^%zewdCompiler16($g(fileName),$g(prefix),$g(extension)) + QUIT + ; +import(fileName) + ; + i $g(fileName)="" s fileName="zewd.xml" + QUIT + ; +listDOMsByPrefix(prefix) + d listDOMsByPrefix^%zewdCompiler19($g(prefix)) + QUIT + ; +removeDOMsByPrefix(prefix) + d removeDOMsByPrefix^%zewdCompiler19($g(prefix)) + QUIT + ; +dumpDOM(docName) + ; + d dumpDOM^%zewdCompiler20($g(docName)) + QUIT + ; +namespace() + QUIT $zdir + ; +setNamespace(namespace) + s $zdir=namespace + QUIT + ; +zcvt(string,param,param2) + ; + i $g(param)="" s param="l" + i param="l"!(param="L") QUIT $tr(string,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz") + i param="u"!(param="U") QUIT $tr(string,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") + QUIT string + ; +getIP() ; Get own IP address + ; + n ip,ipInfo + ; + QUIT $g(ip) + ; +ajaxErrorRedirect(sessid) + ; + n errorPage + ; + s errorPage=$$getSessionValue^%zewdAPI("ewd.errorPage",sessid) + d setRedirect^%zewdAPI(errorPage,sessid) + ; + QUIT "" + ; +classExport(className,methods,filepath) + ; + QUIT $$classExport^%zewdCompiler16($g(className),.methods,$g(filepath)) + ; +strx(string) + n i,c,a,ok + f i=1:1:$l(string) s c=$e(string,i),a=$a(c) w i_": "_c_" : "_a,! r ok + QUIT + ; +disableEwdMgr + s ^%zewd("disabled")=1 + QUIT + ; +enableEwdMgr + k ^%zewd("disabled") + QUIT + ; +enableWLDAccess(app,page) + i $g(^zewd("allowWLDAccess",$$zcvt(app,"l"),$$zcvt(page,"l")))'=1 s ^zewd("allowWLDAccess",$$zcvt(app,"l"),$$zcvt(page,"l"))=1 + QUIT + ; +disableWLDAccess(app,page) + k ^zewd("allowWLDAccess",$$zcvt(app,"l"),$$zcvt(page,"l")) + QUIT +isSSOValid(sso,username,password,sessid) + QUIT $$isSSOValid^%zewdMgrAjax2($g(sso),$g(username),$g(password),$g(sessid)) + ; +uniqueId(nodeOID,filename) + QUIT $p(filename,".ewd",1)_$p(nodeOID,"-",2) + ; +exportToGTM(routine) diff --git a/p/_zewdGTM.m b/p/_zewdGTM.m new file mode 100644 index 0000000..989347c --- /dev/null +++ b/p/_zewdGTM.m @@ -0,0 +1,863 @@ +%zewdGTM ;Enterprise Web Developer GT.M/ Virtual Appliance Functions + ; + ; Product: Enterprise Web Developer version 4.0.755 + ; Build Date: Thu, 12 Feb 2009 09:53:12 + ; + ; ---------------------------------------------------------------------------- + ; | Enterprise Web Developer for GT.M and m_apache | + ; | Copyright (c) 2004-9 M/Gateway Developments Ltd, | + ; | Reigate, Surrey UK. | + ; | All rights reserved. | + ; | | + ; | http://www.mgateway.com | + ; | Email: rtweed@mgateway.com | + ; | | + ; | This program is free software: you can redistribute it and/or modify | + ; | it under the terms of the GNU Affero General Public License as | + ; | published by the Free Software Foundation, either version 3 of the | + ; | License, or (at your option) any later version. | + ; | | + ; | This program is distributed in the hope that it will be useful, | + ; | but WITHOUT ANY WARRANTY; without even the implied warranty of | + ; | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | + ; | GNU Affero General Public License for more details. | + ; | | + ; | You should have received a copy of the GNU Affero General Public License | + ; | along with this program. If not, see . | + ; ---------------------------------------------------------------------------- + ; + ; + QUIT + ; + ; EWD Virtual Appliance Version/Build +version() + QUIT "6.0" + ; +buildDate() + QUIT "29 January 2009" + ; +config ; + d setApplicationRootPath^%zewdAPI("/usr/ewd/apps") + d setOutputRootPath^%zewdAPI("/usr/php","php") + ;s ^%eXtc("system","license")="2vxuxs3qzqxuyuvtynezvm8yy5Wrz4i7wwwrzmsvqwwtr" + QUIT + ; +getMGWSIPid() + ; + n io,ok,line,stop,temp + s io=$io + s temp="temp"_$p($h,",",2)_".txt" + zsystem "ps -A|grep mgwsi > "_temp + o temp:(readonly:exception="g nsFileNotExists") + u temp + r line + c temp + u io + s ok=$$deleteFile^%zewdAPI(temp) + s line=$$stripSpaces^%zewdAPI(line) + QUIT +line +startMGWSI ; + k ^%zewd("mgwsis") + d START^%ZMGWSI(0) + ;s ^%zewd("mgwsi","job")=$zjob + QUIT + ; +stopMGWSI ; + n pid + ;s pid=$g(^%zewd("mgwsi","job")) + ;s pid=$$getMGWSIPid() + ;i pid'="" d + ;. k ^%zewd("mgwsi","job") + ;. i $$pidExists(pid) zsystem "kill -TERM "_pid + s pid="" + f s pid=$o(^%zewd("mgwsis",pid)) q:pid="" d + . k ^%zewd("mgwsis",pid) + . i $$pidExists(pid) zsystem "kill -TERM "_pid + QUIT + ; +restartMGWSI + d stopMGWSI + d startMGWSI + QUIT + ; +closeMGWSI(server) + ; eg server=the MGWSI "server" to be closed, eg ewd, LOCAL, etc + n ok,html,url + s url="http://127.0.0.1:7040/cgi-bin/nph-mgwsic?mgwsidef=Default_CloseDown_Server&mgwsiSYS=2&mgwsiCDN="_server_"&mgwsiSYSbOK=Close+Connections(s)" + s ok=$$httpGET(url,.html) + QUIT + ; +closeMGWSIConnections + n pid + s pid="" + f s pid=$o(^%zewd("mgwsis",pid)) q:pid="" d + . k ^%zewd("mgwsis",pid) + . i $$pidExists(pid) zsystem "kill -TERM "_pid + QUIT + ; +shutdown + zsystem "shutdown -h now" + QUIT + ; +restart + zsystem "shutdown -r now" + QUIT + ; +pidExists(pid) ; + n io,line,ok,temp + s io=$io + s temp="temp"_$p($h,",",2)_".txt" + zsystem "ps --no-heading "_pid_" > "_temp + c temp + o temp:(readonly:exception="g pidFileNotExists") + u temp r line + c temp + u io + s ok=$$deleteFile^%zewdAPI(temp) + i line'[pid QUIT 0 + QUIT 1 +pidFileNotExists + c temp + s ok=$$deleteFile^%zewdAPI(temp) + u io + i $p($zs,",",1)=2 QUIT 0 + QUIT 0 + ; +validDomain(domain) + ; + n exists,io,ok,line,stop,temp + s io=$io + s temp="temp"_$p($h,",",2)_".txt" + zsystem "nslookup "_domain_" >"_temp + o temp:(readonly:exception="g nsFileNotExists") + u temp + s stop=0,exists=0 + f r line d q:stop + . i line["authoritative answer" s stop=1,exists=1 q + . i line["server can't find" s stop=1,exists=0 q + c temp + u io + s ok=$$deleteFile^%zewdAPI(temp) + QUIT exists +nsFileNotExists + u io + i $p($zs,",",1)=2 QUIT -1 + QUIT -1 + ; +getIP(info) + ; + n exists,io,ip,ok,line,stop,temp,value + s io=$io + s temp="temp"_$p($h,",",2)_".txt" + zsystem "ifconfig eth0 >"_temp + o temp:(readonly:exception="g ipFileNotExists") + u temp + s stop=0,ok=0,ip="" + f r line d q:stop + . i line["HWaddr" d + . . s value=$p(line,"HWaddr ",2) + . . s info("mac")=$$stripSpaces^%zewdAPI(value) + . i line["inet addr:" d + . . s value=$p(line,"inet addr:",2) + . . s ip=$p(value," ",1) + . . s info("ip")=ip + . . i ip="127.0.0.1" s stop=1 + . i line["Bcast:" d + . . s value=$p(line,"Bcast:",2) + . . s value=$p(value," ",1) + . . s info("broadcast")=value + . i line["Mask:" d + . . s value=$p(line,"Mask:",2) + . . s value=$p(value," ",1) + . . s info("mask")=value + . i line["inet6 addr" s stop=1 q + . i line["Local Lookback" s stop=1 q + c temp + u io + s ok=$$deleteFile^%zewdAPI(temp) + QUIT ip +ipFileNotExists + s $zt="" + u io + i $p($zs,",",1)=2 QUIT -1 + QUIT "" + ; +openTCP(host,port,timeout) + n delim,dev + i host'?1N.N1"."1N.N1"."1N.N1"."1N.N,'$$validDomain(host) QUIT 0 + i $g(host)="" QUIT 0 + i $g(port)="" QUIT 0 + i $g(timeout)="" s timeout=20 + s delim=$c(13) + s dev="client$"_$p($h,",",2) + o dev:(connect=host_":"_port_":TCP":attach="client":exception="g tcperr"):timeout:"SOCKET" + QUIT dev + ; +tcperr ; + QUIT 0 + ; +resetSecurity + ; + k ^%zewd("config","security","validSubnet") + QUIT + ; +resetVM + n files + d resetSecurity + k ^%zewdSession + s ^%zewd("nextSessid")=1 + k ^%zewd("mgwsi") + k ^%zewd("mgwsis") + k ^%zewd("emailQueue") + k ^%zewd("daemon","email") + k ^%zewd("relink") + k ^%eXtc + k ^%zewdLog + k ^%zewdError + k ^CacheTempUserNode + k ^CacheTempEWD + k ^%zewdTrace + k ^zewd("trace") + k ^%MGW,^%MGWSI + k ^rob,^robdata,^robcgi + k ^CacheTempWLD + k ^ewdDemo + d removeDOMsByPrefix^%zewdAPI() + ;d getFilesInPath^%zewdHTMLParser("/usr/local/gtm/ewd",".m",.files) + ;f lineNo=1:1 s line=$t(leaveAsM+lineNo) q:line["***END***" d + ;. s leaveFiles($p(line,";;",2))="" + ; s file="" + ;f s file=$o(files(file)) q:file="" d + ;. i $d(leaveFiles(file)) q + ;. i file'["_zewd" q + ;. s path="/usr/local/gtm/ewd/"_file + ; . s ok=$$deleteFile^%zewdAPI(path) + ; s ok=$$deleteFile^%zewdAPI("/usr/local/gtm/ewd/MDB.m") + ; s ok=$$deleteFile^%zewdAPI("/usr/local/gtm/ewd/MDBMgr.m") + ;s ok=$$deleteFile^%zewdAPI("/usr/local/gtm/ewd/MDBConfig.m") + s ok=$$deleteFile^%zewdAPI("/usr/MDB/MDB.conf") + k ^MDB,^MDBUAF + zsystem "rm -f ~/.bash_history" + zsystem "history -c" + ;echo " "> /var/log/apache2/access.log + ;echo " "> /var/log/apache2/error.log + ;echo " "> /var/log/apache2/access.log.1" + ;echo " "> /var/log/apache2/error.log.1" + ;zsystem "rm /usr/php/tutorial/*.*" + ; Now clear down history for root + ; Shutdown Apache and clear down Apache Log files - use above commented commands + ; Delete all ewdapps directories and files + ; Delete all PHP directories and files + ; zero-space all empty content: cat /dev/zero > zero.fill;sync;sleep 1;sync;rm -f zero.fill + ; Compress the virtual drives: + ; G:\virtual_machines\mdb_1_0_master>"C:\Program Files\VMware\VMware Server\vmware-vdiskmanager.exe" -k Ubuntu-cl1.vmdk + QUIT + ; +setClock + zsystem "ntpdate ntp.ubuntu.com" + QUIT + ; +startVM + ; + n cr,ip + s cr=$c(13) + d startMGWSI + w cr,! + d setClock + s ip=$$getIP() + w cr,! + w "======================================================="_cr,! + w " Welcome to the EWD Virtual Appliance "_cr,! + w " -- Version "_$$version()_": "_$$buildDate()_" --"_cr,! + ; + i ip=""!(ip="127.0.0.1") g startVMFail + w ! + w " System clock set to "_$$inetDate^%zewdAPI($h)_cr,!! + w " The EWD Virtual Appliance is now ready for use!"_cr,! + w " To run the EWD Management Portal, point your browser at http://"_ip_cr,!! + g startVMFin +startVMFail + w "Unfortunately the Virtual Appliance was unable to acquire an IP"_cr,! + w "address. Please consult the readme file for what to do next"_cr,! +startVMFin + w "======================================================="_cr,! + QUIT + ; +startMDBVM + ; + n cr,ip + s cr=$c(13) + d startMGWSI + w cr,! + d setClock + s ip=$$getIP() + w cr,! + w "======================================================="_cr,! + w " Welcome to the M/DB Virtual Appliance "_cr,! + w " -- Version "_$$version()_": "_$$buildDate()_" --"_cr,! + ; + i ip=""!(ip="127.0.0.1") g startVMFail + w ! + w " System clock set to "_$$inetDate^%zewdAPI($h)_cr,!! + w " The M/DB Virtual Appliance is now ready for use!"_cr,! + w " To run the M/DB Management Portal, point your browser at http://"_ip_cr,!! + g startVMFin + ; +httpGET(url,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort) + ; + n dev,host,HTTPVersion,io,port,rawURL,ssl,urllc + ; + k rawResponse,html + s HTTPVersion="1.0" + s rawURL=url + s ssl=0 + s port=80 + s urllc=$$zcvt^%zewdAPI(url,"l") + i $e(urllc,1,7)="http://" d + . s url=$e(url,8,$l(url)) + . s sslHost=$p(url,"/",1) + . s sslPort=80 + . i sslHost[":" d + . . s sslPort=$p(sslHost,":",2) + . . s sslHost=$p(sslHost,":",1) + e i $e(urllc,1,8)="https://" d + . s url=$e(url,9,$l(url)) + . s ssl=1 + . s sslHost=$g(sslHost) + . i sslHost="" s sslHost="127.0.0.1" + . s sslPort=$g(sslPort) + . i sslPort="" s sslPort=89 + e QUIT "Invalid URL" + s host=$p(url,"/",1) + i host[":" d + . s port=$p(host,":",2) + . s host=$p(host,":",1) + s url="/"_$p(url,"/",2,5000) + i $g(timeout)="" s timeout=20 + ; + s io=$io + i $g(test)'=1 d + . s dev=$$openTCP(sslHost,sslPort,timeout) + . u dev + i ssl d + . w "GET "_rawURL_" HTTP/"_HTTPVersion_$c(13,10) + e d + . w "GET "_url_" HTTP/"_HTTPVersion_$c(13,10) + w "Host: "_host + i port'=80 w ":"_port + w $c(13,10) + w "Accept: */*"_$c(13,10) + ; + i $d(headerArray) d + . n n + . s n="" + . f s n=$o(headerArray(n)) q:n="" d + . . w headerArray(n)_$c(13,10) + ; + w $c(13,10),! + ; + ; That's the request sent ! + ; +httpResponse ; + ; + i $g(test)=1 QUIT "" + n c,dlim,header,i,no,pos,rlen,stop,str + ; + k respHeaders + s stop=0,no=1 + f i=1:1 d q:stop + . i i=1 + . r c#1 + . i c=$c(13) q + . i c'=$c(10) s respHeaders(no)=$g(respHeaders(no))_c + . i c=$c(10),$g(respHeaders(no))="" s stop=1 q + . i c=$c(10) s no=no+1 + ; + s rlen=999999 + f i=1:1:(no-1) d + . s header=$$zcvt^%zewdAPI(respHeaders(i),"l") + . i header["content-length" d + . . s rlen=$p(header,":",2) + . . s rlen=$$stripSpaces^%zewdAPI(rlen) + ; + i rlen<999999 d + . r str#rlen + e d + . s str="" + . f pos=1:1 r str#rlen:timeout g:'$t httpTimeout q:str="" s str(pos)=str q:($l(str)<999999) + i $g(test)'=1 c dev + s dlim=$c(10) + i str[$c(13,10) s dlim=$c(13,10) + s rlen=$l(str,dlim) + f i=1:1:rlen s html(i)=$p(str,dlim,i) + s rawResponse="" + f i=1:1:(no-1) s rawResponse=rawResponse_respHeaders(i)_dlim + s rawResponse=rawResponse_dlim_str + ; + u io + QUIT "" + ; +httpTimeout + QUIT "Timed out waiting for response" + ; +httpPOST(url,payload,mimeType,html,headerArray,timeout,test,rawResponse,respHeaders,sslHost,sslPort) + ; + n contentLength,dev,host,HTTPVersion,io,port,rawURL,ssl,urllc + ; + k rawResponse,html + s HTTPVersion="1.0" + s rawURL=url + s ssl=0 + s port=80 + s urllc=$$zcvt^%zewdAPI(url,"l") + i $e(urllc,1,7)="http://" d + . s url=$e(url,8,$l(url)) + . s sslHost=$p(url,"/",1) + . s sslPort=80 + e i $e(urllc,1,8)="https://" d + . s url=$e(url,9,$l(url)) + . s ssl=1 + . s sslHost=$g(sslHost) + . i sslHost="" s sslHost="127.0.0.1" + . s sslPort=$g(sslPort) + . i sslPort="" s sslPort=89 + e QUIT "Invalid URL" + s host=$p(url,"/",1) + i host[":" d + . s port=$p(host,":",2) + . s host=$p(host,":",1) + s url="/"_$p(url,"/",2,5000) + i $g(timeout)="" s timeout=20 + ; + s io=$io + i $g(test)'=1 d + . s dev=$$openTCP(sslHost,sslPort,timeout) + . u dev + i ssl d + . w "POST "_rawURL_" HTTP/"_HTTPVersion_$c(13,10) + e d + . w "POST "_url_" HTTP/"_HTTPVersion_$c(13,10) + w "Host: "_host + i port'=80 w ":"_port + w $c(13,10) + w "Accept: */*"_$c(13,10) + ; + i $d(headerArray) d + . n n + . s n="" + . f s n=$o(headerArray(n)) q:n="" d + . . w headerArray(n)_$c(13,10) + ; + s mimeType=$g(mimeType) + i mimeType="" s mimeType="application/x-www-form-urlencoded" + s contentLength=0 + i $d(payload) d + . n no + . s no="" + . f s no=$O(payload(no)) q:no="" D + . . s contentLength=contentLength+$l(payload(no)) + . s contentLength=contentLength + . w "Content-Type: ",mimeType + . i $g(charset)'="" w "; charset=""",charset,"""" + . w $c(13,10) + . w "Content-Length: ",contentLength,$c(13,10) + ; + w $c(13,10) + i $D(payload) d + . n no + . s no="" + . f s no=$O(payload(no)) q:no="" d + . . w payload(no) + ; + w $c(13,10),! + ; + ; That's the request sent ! + ; + g httpResponse + ; +parseURL(url,docName) + ; + n getPath,ok,server + ; + i url["http://" s url=$p(url,"http://",2) + s server=$p(url,"/",1) + s getPath=$p(url,"/",2,1000) + s ok=$$parseURL^%zewdHTMLParser(server,getPath,docName) + QUIT ok + ; +smtpSend(domain,from,displayFrom,to,displayTo,ccList,subject,message,dialog,authType,username,password,timeout,gmtOffset,port) + ; + n attach,boundary,crlf,date,dev,error,io,mess,rcpt,resp,sent,toList + ; + s timeout=$g(timeout) i timeout="" s timeout=10 + s domain=$g(domain) + s port=$g(port) i port="" s port=25 + s from=$g(from) + s to=$g(to) + s subject=$g(subject) + s gmtOffset=$g(gmtOffset) i gmtOffset="" s gmtOffset="GMT" + ; + s error="" + i domain="" QUIT "No SMTP Domain specified" + i from="" QUIT "No sender's email address specified" + i to="" QUIT "No recipient's email address specified" + i '$d(message) QUIT "No Email content specified" + ; + s date=$$inetDate^%zewdAPI($h)_" "_gmtOffset + s mess($increment(mess))="Date: "_date + i $g(displayFrom)'="" d + . s mess($increment(mess))="From: """_displayFrom_"""<"_from_">" + e d + . s mess($increment(mess))="From: "_from + i $g(displayTo)'="" d + . s mess($increment(mess))="To: """_displayTo_"""<"_to_">" + e d + . s mess($increment(mess))="To: "_to + s toList(to)="" + i $d(ccList) d + . n name + . s mess($increment(mess))="Cc: " + . i $g(ccList)'="" d + . . s toList(ccList)="" + . . s mess(mess)=mess(mess)_ccList + . s name="" + . f s name=$o(ccList(name)) q:name="" d + . . i mess(mess)'="Cc: " s mess(mess)=mess(mess)_", " + . . s mess(mess)=mess(mess)_name + . . s toList(name)="" + s mess($increment(mess))="Subject: "_subject + s mess($increment(mess))="X-Priority: 3 (Normal)" + s mess($increment(mess))="X-MSMail-Priority: Normal" + s mess($increment(mess))="X-Mailer: "_$$version^%zewdAPI() + s mess($increment(mess))="MIME-Version: 1.0" + s mess($increment(mess))="Content-Type: text/plain; charset=""us-ascii""" + s mess($increment(mess))="Content-Transfer-Encoding: 7bit" + s mess($increment(mess))="" + ; + s message=$g(message) + i message'="" d + . s mess($increment(mess))=message + e d + . n mlno + . s mlno="" + . f s mlno=$o(message(mlno)) q:mlno="" d + . . s mess($increment(mess))=message(mlno) + ; + k dialog + s io=$io + s crlf=$c(13,10) + s dev=$$openTCP(server,port,timeout) + i dev=0 QUIT "Unable to connect to SMTP server: "_server + u dev + r resp:timeout e d close QUIT "Unable to initiate connection with SMTP server" + s resp=$p(resp,crlf,1) + s dialog($increment(dialog))=resp + s error="" + s authType=$g(authType) + i authType="LOGIN PLAIN"!(authType="LOGIN") d i error'="" d close QUIT error + . n context,decode,passB64,str,userB64 + . s context=1 + . i $d(^zewd("config","MGWSI")) s context=0 + . u dev w "EHLO "_domain_crlf,! s resp=$$read(.dialog) + . i resp'["250",resp'["AUTH",resp'["LOGIN" s error="Authentication type LOGIN/LOGIN PLAIN not supported on this server" q + . u dev w "AUTH LOGIN"_crlf,! s resp=$$read(.dialog) + . i resp'["334" s error="No username authentication challenge from server" q + . s str=$p(resp," ",2,1000) + . s decode=$$DB64^%ZMGWSIS(str,context) + . s resp="(decoded as : "_decode_")" + . s dialog($increment(dialog))=resp + . s userB64=$$B64^%ZMGWSIS(username,context) + . u dev w userB64_crlf,! s resp=$$read(.dialog) + . i resp'["334" s error="No password authentication challenge from server" q + . s str=$p(resp," ",2,1000) + . s decode=$$DB64^%ZMGWSIS(str,context) + . s resp="(decoded as : "_decode_")" + . s dialog($increment(dialog))=resp + . s passB64=$$B64^%ZMGWSIS(password,context) + . u dev w passB64_crlf,! s resp=$$read(.dialog) + . i resp'["235 " s error=resp q + e d i error'="" d close QUIT error + . u dev w "HELO "_domain_crlf,! s resp=$$read(.dialog) + . i resp'["250" s error=resp + ; + u dev w "MAIL FROM: "_from_crlf,! s resp=$$read(.dialog) + i resp'["250" d close QUIT resp + ; + s rcpt="" + f s rcpt=$o(toList(rcpt)) q:rcpt="" d i resp'[250 q + . u dev w "RCPT TO: <"_rcpt_">"_$c(13,10),! + . s resp=$$read(.dialog) + i resp'[250 d close QUIT resp + ; + u dev w "DATA",crlf,! s resp=$$read(.dialog) + i resp'["250",resp'["354" d close QUIT resp + ; + s message=$g(message) + i message'="" d message(message,dev) + e d + . n line,lineNo + . s lineNo="" + . f s lineNo=$o(mess(lineNo)) q:lineNo="" d + . . s line=mess(lineNo) + . . d message(line,dev) + u dev w crlf,".",crlf,! s resp=$$read(.dialog) + i resp'["250" d close QUIT resp + u dev w "QUIT",crlf,! s resp=$$read(.dialog) + d close + QUIT "" + ; +read(dialog) + n resp + r resp + s resp=$p(resp,$c(13,10),1) + s dialog($increment(dialog))=resp + QUIT resp +close ; + c dev + u io + QUIT + ; +message(line,dev) + n buf,p1 + s buf=$g(line) + i buf="" u dev w $c(13,10),! QUIT + f q:buf="" d + . s p1=$e(buf,1,254),buf=$e(buf,255,$l(buf)) + . i $e(p1)="." s p1="."_p1 + . i $l(p1) u dev w p1,! + u dev w $c(13,10),! + QUIT + ; +smtpTest + s server="relay.xxxx.net" + s from="rtweed@xxxxx.com" + s displayFrom="Rob Tweed" + s displayTo=displayFrom + s to="rtweed@xxxx.co.uk" + s ccList("rtweed@yyyy.co.uk")="" + s ccList("rtweed@zzzz.com")="" + s message(1)="Test Message" + s message(2)="This is line 2" + s message(3)="And here is line 3" + s authType="LOGIN PLAIN" + s user="xxxxxxxxx" + s pass="yyyyyyyyy" + s subject="Test email 2" + s ok=$$smtpSend(server,from,displayFrom,to,displayTo,.ccList,subject,.message,.dialog,authType,user,pass) + QUIT + ; +getFileInfo(path,ext,info) ; Get list of files with specified extension + ; + n date,dlim,%file,%io,lineNo,ok,os,%p1,result,time,%x,%y + ; + k info + s dlim="/" + i $e(ext,1)'="." s ext="."_ext + i $e(path,$l(path))=dlim s path=$e(path,1,$l(path)-1) + ; + d shellCommand("ls -l """_path_"""",.result) + ; + ; we now have directory listing in result array + s lineNo="" + f s lineNo=$o(result(lineNo)) q:lineNo="" d + . s %file=result(lineNo) + . s %p1=$P(%file," ",1) + . i $e(%p1,1)'="d" d + . . n %e1,%e2,%rfile,%p9,%len,%name,size + . . s %rfile=$re(%file) + . . s %rfile=$$replaceAll^%zewdAPI(%rfile," "," ") + . . s %p9=$p(%rfile," ",1) + . . s time=$p(%rfile," ",2) + . . s date=$p(%rfile," ",3,4) + . . s size=$p(%rfile," ",5) + . . s %p9=$re(%p9) + . . s time=$re(time) + . . s date=$re(date) + . . ;i $$zcvt^%zewdAPI(%p9,"l")=$$zcvt^%zewdAPI(%tofile,"l") q ; ignore temp file + . . i ext=".*" s info(%p9)=date_$c(1)_time_$c(1)_size q + . . s %e1="."_$$getFileExtension^%zewdHTMLParser(%p9) + . . i %e1'=ext q + . . s info(%p9)=date_$c(1)_time_$c(1)_size + QUIT + ; +shellPipe ; Pipe output from shell commands to scratch global + ; + n i,x + ; + k ^%mgwPipe + f i=1:1:200 r x q:((i>20)&(x="")) s ^%mgwPipe(i)=x + QUIT + ; +deletePipe + k ^%mgwPipe + QUIT + ; +lockPipe + l +^%mgwPipe + QUIT + ; +unlockPipe + l -^%mgwPipe + QUIT + ; +shellCommand(command,result) ; + n lineNo + k result + d lockPipe + zsystem command_" |mumps -run shellPipe^%zewdGTM" + m result=^%mgwPipe + d deletePipe + d unlockPipe + s lineNo="" + f s lineNo=$o(result(lineNo),-1) q:lineNo="" q:result(lineNo)'="" k result(lineNo) + QUIT + ; +fileInfo(path,info) + n line,temp + k info + s temp="temp"_$p($h,",",2)_".txt" + i '$$fileExists^%zewdAPI(path) QUIT + zsystem "ls -l "_path_">"_temp + o temp:(readonly:exception="g fileDateNotExists") + u temp + r line + s info("date")=$p(line," ",6,8) + s info("size")=$p(line," ",5) + c temp + s ok=$$deleteFile^%zewdAPI(temp) + QUIT +fileDateNotExists + s $zt="" + i $p($zs,",",1)=2 QUIT + QUIT +shell(command,result) + n i,io,temp + k result + s io=$io + s temp="temp"_$p($h,",",2)_".txt" + zsystem command_">"_temp + o temp:(readonly) + u temp:exception="g eoshell" + f i=1:1 r result(i) +eoshell ; + c temp + u io + s ok=$$deleteFile^%zewdAPI(temp) + QUIT i-1 + ; +testGlobal() + s start=$h + f i=1:1:1000 d fileInfo^%zewdAPI("/usr/php/ewdMgr/user.php",.info) + s end=$h + s dur=$p(end,",",2)-$p(start,",",2) + QUIT dur + ; +testFile() + s start=$h + f i=1:1:1000 d fileInfo^%zewdGTM("/usr/php/ewdMgr/user.php",.info) + s end=$h + s dur=$p(end,",",2)-$p(start,",",2) + QUIT dur + ; +mySQL(sql,resultArray,username,password,database) + n nlines,str + ; + i $g(username)="" s username="root" + i $g(password)="" s password="1234567" + i $g(database)="" s database="test" + s str="mysql --xml -u "_username_" -p"_password_" "_database_" -e """_sql_"""" + s nlines=$$shell(str,.resultArray) + QUIT nlines + ; +encodeDate(dateString) + n %DN,%DS + s %DS=dateString + d INT^%DATE + QUIT $g(%DN) + ; +relink ; + s ^%zewd("relink")=1 k ^%zewd("relink","process") + QUIT + ; +install + n default,x + ; + w !,"Installing/Configuring "_$$version^%zewdAPI(),!! + w "Note: hit Esc to go back at any point",!! +install1 ; + s default=$g(^zewd("config","applicationRootPath")) + i default="" s default="/usr/ewdapps" + w !,"Application Root Path ("_default_"): " r x + i $zb=$c(27) w !," Installation aborted",!! QUIT + i x="" s x=default w x + s ^zewd("config","applicationRootPath")=x + ; +install2 ; + s default=$g(^zewd("config","routinePath","gtm")) + i default="" s default="/usr/local/gtm/ewd/" + w !,"Routine Path ("_default_"): " r x + i $zb=$c(27) w ! g install1 + i x="" s x=default w x + s ^zewd("config","routinePath","gtm")=x + ; +install3 ; + s default=$g(^zewd("config","jsScriptPath","gtm","outputPath")) + i default="" s default="/var/www/resources/" + w !,"Javascript and CSS File Output Path ("_default_"): " r x + i $zb=$c(27) w ! g install2 + i x="" s x=default w x + i $e(x,$l(x))'="/" s x=x_"/" + s ^zewd("config","jsScriptPath","gtm","outputPath")=x + ; +install4 ; + s default=$g(^zewd("config","jsScriptPath","gtm","path")) + i default="" s default="/resources/" + w !,"Javascript and CSS File URL Path ("_default_"): " r x + i $zb=$c(27) w ! g install3 + i x="" s x=default w x + i $e(x,$l(x))'="/" s x=x_"/" + s ^zewd("config","jsScriptPath","gtm","path")=x + ; + s ^zewd("config","backEndTechnology")="m" + i '$d(^zewd("config","defaultFormat")) s ^zewd("config","defaultFormat")="pretty" + s ^zewd("config","defaultTechnology")="gtm" + s ^zewd("config","frontEndTechnology")="gtm" + i '$d(^zewd("config","jsScriptPath","gtm","mode")) s ^zewd("config","jsScriptPath","gtm","mode")="fixed" + s ^zewd("config","sessionDatabase")="gtm" + w !!,$$version^%zewdAPI()_" is configured and ready for use",!! + QUIT + ; +leaveAsM ; + ;;_zewdCompiler11.m + ;;_zewdCompiler12.m + ;;_zewdCompiler14.m + ;;_zewdCompiler15.m + ;;_zewdCompiler17.m + ;;_zewdCompiler18.m + ;;_zewdCompiler21.m + ;;_zewdCompiler2.m + ;;_zewdCompiler9.m + ;;_zewdDemo.m + ;;_zewdDocumentation1.m + ;;_zewdDocumentation2.m + ;;_zewdDocumentation3.m + ;;_zewdDocumentation4.m + ;;_zewdEJSCData.m + ;;_zewdExtJSCode.m + ;;_zewdExtJSData.m + ;;_zewdExtJSDat2.m + ;;_zewdExtJSData3.m + ;;_zewdGTM.m + ;;_zewdGTMRuntime.m + ;;_zewdHTTP.m + ;;_zewdLAMP1.m + ;;_zewdMgr.m + ;;_zewdMgr2.m + ;;_zewdMgr3.m + ;;_zewdMgrAjax.m + ;;_zewdMgrAjax2.m + ;;_zewdSlideshow.m + ;;_zewdYUI1.m + ;;_zewdYUI2.m + ;;_zewdvaMgr.m + ;;***END***