TMGKERNL ;TMG/kst/OS Specific functions ;11/01/04 ;;1.0;TMG-LIB;**1**;04/24/09 ;"TMG KERNEL FUNCTIONS ;"I.e. functions that are OS specific. ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"7-12-2005 ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"$$Dos2Unix^TMGKERNL(FullNamePath) ;"$$IsDir^TMGKERNL(Path) ;"$$Move^TMGKERNL(Source,Dest) ;"$$Copy^TMGKERNL(Source,Dest) ;"$$mkdir(Dir) -- provide a shell for the Linux command 'mkdir' ;"$$rmdir(Dir) -- provide a shell for the Linux command 'rmdir' ;"$$Convert^TMGKERNL(FPathName,NewType) -- convert a graphic image to new type ;"$$XLTLANG(Phrase,langPair) -- execute a linux OS call to convert a phrase into another spoken language ;"$$GetPckList(PckInit,Array,NeedsRefresh,PckDirFName) -- launch special linux script to get patch file list from ftp.va.gov ;"$$DownloadFile^TMGKERNL(URL,DestDir) -- Interact with Linux to download a file with wget ;"$$EditHFSFile^TMGKERNL(FilePathName) -- interact with Linux to edit a file on the host file system ;"ZSAVE -- to save routine out to HFS ;"MAKEBAKF^TMGKERNL(FilePathName,NodeDiv) ;Make Backup File if original exists ;"IOCapON -- redirect IO to a HFS file, so that it can be captured. ;"IOCapOFF(pOutArray) -- restore IO channel to that prior IOCapON was called, and return captured output in OutArray ;"KillPID(JobNum) -- send message to MUPIP to kill Job ;"MJOBS(array) -- execute a linux OS call to get list of all 'mumps' jobs using: 'ps -C mumps' ;"$$GetScrnSize(ROWS,COLS) --query the OS and get the dimensions of the terminal window. ;"======================================================================= ;"Dependancies ;"======================================================================= ;"======================================================================= Dos2Unix(FullNamePath) ;"Purpose: To execute the unix command Dos2Unix on filename path ;"FullNamePath: The filename to act on. ;"Result: 0 if no error; >0 if error ;"Notice!!!! The return code here is DIFFERENT from usual new result set result=0 if $get(FullNamePath)="" goto DUDone new spec set spec(" ")="\ " set FullNamePath=$$REPLACE^XLFSTR(FullNamePath,.spec) new HookCmd set HookCmd="dos2unix -q "_FullNamePath zsystem HookCmd set result=$ZSYSTEM&255 ;"get result of execution. (low byte only) DUDone quit result FileSize(FullNamePath) ;"Purpose: To return the size of the file, in bytes. ;"Input: FullNamePath: The filename to act on. ;"Result: -1 if error, or returns size in bytes new result set result=-1 new p set p="myTerm" open p:(COMMAND="stat --format=%s "_FullNamePath:readonly)::"pipe" use p new x read x close p use $p ;"write "reply was :",x,! if x'["cannot stat" set result=+x quit result IsDir(Path,NodeDiv) ;"Purpose: To determine if Path is a path to a directory (i.e. are there sub files) ;"Input: Path to test, e.g. "/home/user" or "/home/user/" ;" NodeDiv: [OPTIONAL] -- the character that separates folders (e.g. "/") ;" if not supplied, then default value is "/" ;"Result: 1 filepath is actually a directory ;"Note: NEW! Will now return 1 if Path is a valid path to a directory, but there are no files in directory set Path=$get(Path) set NodeDiv=$get(NodeDiv,"/") if $extract(Path,$length(Path))'=NodeDiv set Path=Path_NodeDiv new p set p="myTerm" open p:(COMMAND="stat --format=%F "_Path:readonly)::"pipe" use p new x read x close p use $p quit (x="directory") ;" ==== old code/method below (slower) === ;"Old results ;"Result: 1 if there are files in path, 0 otherwise ;"Note: if Path is a valid path to a directory, but there are no files in directory, 0 returned. new TMGMask set TMGMask("*")="" new TMGFiles new result set result=0 new spec set spec(" ")="\ " set Path=$$REPLACE^XLFSTR(Path,.spec) ;"Note: I can't seem to get this to work with names containing spaces. if $$LIST^%ZISH(Path,"TMGMask","TMGFiles")=1 do . new index set index=$order(TMGFiles("")) . if index'="" set result=1 quit result Move(Source,Dest) ;"Purpose to provide a shell for the Linux command 'mv' ;" This can serve to move or rename a file ;"Note: a platform independant version of the this could be constructed later... ;"Result: 0 if no error; >0 if error ;"Notice!!!! The return code here is DIFFERENT from usual new HookCmd,result new Srch set Srch(" ")="\ " set Source=$$REPLACE^XLFSTR(Source,.Srch) set Dest=$$REPLACE^XLFSTR(Dest,.Srch) set HookCmd="mv "_Source_" "_Dest zsystem HookCmd set result=$ZSYSTEM&255 ;"get result of execution. (low byte only) quit result Copy(Source,Dest) ;"Purpose to provide a shell for the Linux command 'cp' ;" This can serve to move or rename a file ;"Note: a platform independant version of the this could be constructed later... ;"Result: 0 if no error; >0 if error ;"Notice!!!! The return code here is DIFFERENT from usual new HookCmd,result new Srch set Srch(" ")="\ " set Source=$$REPLACE^XLFSTR(Source,.Srch) set Dest=$$REPLACE^XLFSTR(Dest,.Srch) set HookCmd="cp "_Source_" "_Dest zsystem HookCmd set result=$ZSYSTEM&255 ;"get result of execution. (low byte only) quit result mkdir(Dir) ;"Purpose to provide a shell for the Linux command 'mkdir' ;"Note: a platform independant version of the this could be constructed later... ;"Result: 0 if no error; >0 if error ;"Notice!!!! The return code here is DIFFERENT from usual new HookCmd,result new Srch set Srch(" ")="\ " set Dir=$$REPLACE^XLFSTR(Dir,.Srch) set HookCmd="mkdir "_Dir zsystem HookCmd set result=$ZSYSTEM&255 ;"get result of execution. (low byte only) quit result rmdir(Dir) ;"Purpose to provide a shell for the Linux command 'rmdir' ;"Note: a platform independant version of the this could be constructed later... ;"Result: 0 if no error; >0 if error ;"Notice!!!! The return code here is DIFFERENT from usual new HookCmd,result new Srch set Srch(" ")="\ " set Dir=$$REPLACE^XLFSTR(Dir,.Srch) set HookCmd="rmdir "_Dir zsystem HookCmd set result=$ZSYSTEM&255 ;"get result of execution. (low byte only) quit result Convert(FPathName,NewType) ;"Purpose: to convert a graphic image on the linux host to new type ;" i.e. image.jpg --> image.png. This is more than a simple renaming. ;"Input: FPathName -- full path, filename and extention. E.g. "\tmp\image.jpg" ;" NewType -- the new image type (without '.'), ;" E.g. "jpg", or "JPG", or "TIFF", or "pcd" (NOT ".jpg" etc) ;"Output: New FPathName (with new extension) to new image file, or "" if problem ;" ;"Note: If the conversion is successful, then the original image will be deleted ;"Note: This function depends on the ImageMagick graphic utility "convert" to be ;" installed on the host linux system, and in the path so that it can be ;" launched from any directory. new newFPathName set newFPathName="" set NewType=$get(NewType) if NewType="" goto ConvDone new FName,FPath,FileSpec do SplitFNamePath^TMGIOUTL(FPathName,.FPath,.FName,"/") set FileSpec(FName)="" set newFPathName=$piece(FPathName,".",1)_"."_NewType ;"Setup and launch linux command to execute convert new CmdStr set CmdStr="convert "_FPathName_" "_newFPathName do . ;"new $ETRAP,$ZTRAP . ;"set $ETRAP="S $ECODE=""""" . zsystem CmdStr ;"Launch command ;"get result of execution. (low byte only) -- if wanted new CmdResult set CmdResult=$ZSYSTEM&255 if CmdResult'=0 do goto ConvDone . set newFPathName="" ;"Delete old image file ;"**** temp!!!!! REMOVE COMMENTS LATER ;"new temp set temp=$$DEL^%ZISH(FPath,"FileSpec") ConvDone quit newFPathName XLTLANG(Phrase,langPair) ;"Purpose: To execute a linux OS call to convert a phrase into another ;" spoken language ;"Input: Phrase -- The text to be translated. ;" LangPair -- a language pair (as allowed by Google translater) ;" for now, tested pairs are: ;" "en-es" -- english -> spanish ;" "en-fr" -- english --> french ;" "en-da" -- english --> ? ;"Result: The translated text, or "" if error. ;"Note: This depends on the "tw" package be installed in the host OS ;" I got this on 7/11/08 from: http://savannah.nongnu.org/projects/twandgtw/ ;"Note: This is not working for some reason..... new result set result="" set langPair=$get(langPair,"en-es") set Phrase=$get(Phrase,"?? Nothing Provided ??") new msgFName set msgFName=$$UNIQUE^%ZISUTL("/tmp/TransLang.txt") ;"Setup and launch linux command to execute tw command new CmdStr set CmdStr="tw translate.google.com."_langPair_" """_Phrase_""" > """_msgFName_"""" ;"write "About to execute zsystem command:",!,CmdStr,! zsystem CmdStr ;"Launch command in linux OS ;"write "Back from zsystem",! ;"get result of execution. (low byte only) -- if wanted new CmdResult set CmdResult=$ZSYSTEM&255 if CmdResult'=0 goto TLDone new FName,FPath do SplitFNamePath^TMGIOUTL(msgFName,.FPath,.FName,"/") new resultArray if $$FTG^%ZISH(FPath,FName,"resultArray(0)",1)=0 goto TLDone set result=$get(resultArray(0)) TLDone quit result TestTrans set langPair=$get(langPair,"en-es") set Phrase=$get(Phrase,"Hello friend") new msgFName set msgFName=$$UNIQUE^%ZISUTL("/tmp/TransLang.txt") new CmdStr new qtChar set qtChar="'" set CmdStr="sh /var/local/OpenVistA_UserData/twlang.sh "_qtChar_langPair_qtChar_" "_qtChar_Phrase_qtChar_" "_msgFName write "About to execute zsystem command:",!,CmdStr,! zsystem CmdStr ;"Launch command in linux OS write "Back from zsystem",! set qtChar="""" set CmdStr="sh /var/local/OpenVistA_UserData/twlang.sh "_qtChar_langPair_qtChar_" "_qtChar_Phrase_qtChar_" "_msgFName write "About to execute zsystem command:",!,CmdStr,! zsystem CmdStr ;"Launch command in linux OS write "Back from zsystem",! quit GetPckList(PckInit,Array,NeedsRefresh,PckDirFName) ;"Purpose: Call Linux, launching special script to get patch file list from ftp.va.gov ;" This is a support function for automating the KIDS installation of patches. ;"Input: PckInit -- this is the namespace of the package to get patches for, e.g. 'DI' for fileman ;" Array -- PASS BY REFERENCE. An OUT parameter. Format: ;" Array(0)=1st line ;" Array(1)=2nd line etc. ;" NeedsRefresh -- if 0 then no refresh needed, just set PckDirFName (but ensure file exists) ;" PckDirFName -- Optional. PASS BY REFERNCE, an OUT PARAMETER. Filled with HFS filename of file ;"Result : 1=success, 0=failure new result set result=1 ;"success kill Array if $get(PckInit)="" set result=0 goto GPLDone ;"Results will be stored in //ftp.va.gov-dirFor-'PckInit' new FName,FPath ;"Fix this.... check if path exists..... set FPath=$get(^TMG("KIDS","PATCH DIR")) if (FPath="")!($$IsDir^TMGKERNL(FPath)=0) do . new Msg set Msg="Please choose a file path for storing VA patches in." . set FPath=$$GetDirName^TMGIOUTL2(Msg,DefPath,"/","Pick directory") if FPath="" set result=0 goto GPLDone set FName="ftp.va.gov-dirFor-"_PckInit set PckDirFName=FPath_FName if ($get(NeedsRefresh)'>0)&($$FileExists^TMGIOUTL(PckDirFName)) goto GPLDone new FPScript set FPScript=$get(^TMG("KIDS","VA FTP Script")) if (FPScript'=""),($$FileExists^TMGIOUTL(FPScript)=0) do . kill ^TMG("KIDS","VA FTP Script") . set FPScript="" if FPScript="" do . new msg set msg="Linux script needed: vaftp_launcher.sh\n" . set msg=msg_"Please browse to this script and select it after the pause." . set FPScript=$$GetFName^TMGIOUTL(msg,"/","vaftp_launcher.sh") . if $$FileExists^TMGIOUTL(FPScript) do . . set ^TMG("KIDS","VA FTP Script")=FPScript . else do . . write "ERROR: Choice of "_FPScript_" is invalid. Aborting." . . set FPScript="" if FPScript="" set result=0 goto GPLDone new CmdStr set CmdStr=FPScript_" "_PckInit_" "_FPath zsystem CmdStr ;"Launch command in linux OS ;"get result of execution. (low byte only) -- if wanted new CmdResult set CmdResult=$ZSYSTEM&255 if CmdResult'=0 do . ;"Failed, so get log file instead of results . set FName="ftp.va.gov_log" . set result=1 ;"success GPL2 ;"Get results file (or log file if problem) if $$FTG^%ZISH(FPath,FName,"Array(0)",1)=0 set result=0 goto GPLDone GPLDone quit result DownloadFile(URL,DestDir,Verbose) ;"Purpose: Interact with Linux to download a file with wget ;"Input: URL -- this is the URL of the file to be downloaded, as to be passed to wget ;" if the server is an FTP server, then URL should start with 'ftp://' ;" NOTE: the URL will be enclosed in " ", so it may contain spaces etc, ;" but should NOT have escaped characters, i.e. "Not\ this" ;" Exception "April Fool'\''s Day" is proper ;" DestDir -- this is the destination directory, on the HFS, where file should be stored ;" Verbose -- OPTIONAL. If 1, then output from wget is shown. Default is 0 ;"result: 1 if success, 0 if failure ;"NOTE: This needs to be rewritten to use the vawget_launcher because wget it ;" hanging when the file doesn't exist, and the process has to be aborted... new CmdStr,qFlag ;"Setup and launch linux command to execute command if +$get(Verbose) set qFlag="" else set qFlag="-q " set CmdStr="wget "_qFlag_"-P """_DestDir_""" """_URL_"""" zsystem CmdStr ;"Launch command in linux OS ;"get result of execution. (low byte only) new CmdResult set CmdResult=$ZSYSTEM&255 new result set result=(CmdResult=0) quit result EditHFSFile(FilePathName) ;"Purpose: interact with Linux to edit a file on the host file system ;"Input: FilePathName -- the full path of the file to edit. ;"result: 1 if success, 0 if failure ;"Setup and launch linux command to execute command new CmdStr set CmdStr="nano "_FilePathName zsystem CmdStr ;"Launch command in linux OS ;"get result of execution. (low byte only) new CmdResult set CmdResult=$ZSYSTEM&255 new result set result=(CmdResult=0) quit result ZSAVE ;"Purpose: to save routine out to HFS ;"Input: globally scoped variable X should hold routine name ;"NOTE: this was moved out of ^DD("OS",19,"ZS") ;"Original line there was (all three lines were one long line) ;"N %I,%F,%S S %I=$I,%F=$P($P($ZRO,")"),"(",2)_"/"_X_".m" O %F:(NEWVERSION) ;"U %F X "S %S=0 F S %S=$O(^UTILITY($J,0,%S)) Q:%S="""" Q:'$D(^(%S)) S %= ;"^UTILITY($J,0,%S) I $E(%)'="";"" W %,!" C %F U %I ;"NOTE: The KIDS system seems to be using X ^%ZOSF("SAVE") instead of this. new %I,%F,%S new % ;"//kt added -- not newing this caused problems in SAVE^DIKZ set %I=$I new %DIR set %DIR=$P($P($ZRO,")"),"(",2) set %DIR=$piece(%DIR," ",$length(%DIR," ")) set %F=%DIR_"/"_X_".m" open %F:(NEWVERSION) use %F set %S=0 for set %S=$O(^UTILITY($J,0,%S)) Q:%S="" Q:'$D(^(%S)) do . set %=^UTILITY($J,0,%S) . if $E(%)'=";" W %,! close %F use %I quit MAKEBAKF(FilePathName,NodeDiv) ;"Make Backup File if original exists ;"Purpose: to COPY existing File to File-ext_#.bak, creating a backup ;" e.g. /tmp/dir1/FName.txt --> /tmp/dir1/FName-txt_1.bak ;"Input: FilePathName -- the name, e.g. /tmp/dir1/filename.txt ;" NodeDiv -- OPTIONAL. Default is "/" ;" The node divider. "/" for unix, "\" for Microsoft ;"results: none ;"Note: This assumes that the HFS supports filenames like FName-txt_1.bak, ;" and length file name is not limited (e.g. not old 8.3 DOS style) ;" Also, if backup file, then number is incremented until a filename is found that doesn't exists ;" e.g. /tmp/dir1/FName-txt_1.bak ;" /tmp/dir1/FName-txt_2.bak ;" /tmp/dir1/FName-txt_3.bak set NodeDiv=$get(NodeDiv,"/") if $$FileExists^TMGIOUTL(FilePathName) do ;"backup file if it exists . new count set count=0 . new FName,FPath,done . do SplitFNamePath^TMGIOUTL(FilePathName,.FPath,.FName,NodeDiv) . for do quit:done . . set count=count+1 . . new bakName set bakName=FName_"_"_count . . set bakName=FPath_$translate(bakName,".","-")_".bak" . . if $$FileExists^TMGIOUTL(bakName) set done=0 quit . . else do . . . set done=1 . . . if $$Copy(FilePathName,bakName) quit IOCapON ;"Purpose: to redirect IO to a HFS file, so that it can be captured. ;"NOTE: CAUTION: If this is called, and then a routine asks for user input, ;" then the program will appear to hang, because the message asking ;" for input has gone to the output channel. set TMGIOCAP=IO set TMGIOCPT="/tmp/" set TMGIOCFN="io-capture-"_$J_".txt" set IO=TMGIOCPT_TMGIOCFN open IO:(REWIND) use IO quit IOCapOFF(pOutArray) ;"Purpose: To restore IO channel to that prior IOCapON was called, and return ;" captured output in OutArray ;"NOTE: MUST call IOCapON prior to calling this function ;"Input: Globally-scoped TMGIOCAP is used. ;" pOutArray -- PASS BY NAME, an OUT PARAMETER. Prior contents are killed. ;"results: none close IO if $get(TMGIOCAP)="" use $P goto IOCDone set IO=TMGIOCAP use IO if $get(pOutArray)="" goto IOCDone kill @pOutArray if ($get(TMGIOCPT)="")!($get(TMGIOCFN)="") goto IOCDone if $$FTG^%ZISH(TMGIOCPT,TMGIOCFN,$name(@pOutArray@(0)),1) new TMGA set TMGA(TMGIOCFN)="" if $$DEL^%ZISH(TMGIOCPT,"TMGA") IOCDone quit KillPID(JobNum) ;"Purpose: send message to MUPIP to kill Job new CmdStr set CmdStr="mupip stop "_JobNum zsystem CmdStr ;"Launch command in linux OS ;"do PressToCont^TMGUSRIF quit TEST new array new p set p="temp" open p:(COMMAND="ps -C mumps":readonly)::"pipe" use p new lineIn for do quit:($zeof) . read lineIn . new ch for do quit:(ch'=" ") . . set ch=$extract(lineIn,1,1) . . if ch=" " set lineIn=$extract(lineIn,2,40) . if +lineIn=0 quit . set array(+lineIn)=lineIn close p use $p zwr array quit MJOBS(array) ;"Purpose: To execute a linux OS call to get list of all 'mumps' jobs ;" using: 'ps -C mumps' ;"Input: array -- PASS BY REFERNCE, an OUT PARAMETER. ;"Output: array is filled as follows: (Prior data is killed) ;" array(job#)=InfoLineFromOS ;" array(job#)=InfoLineFromOS ;" e.g. array(4483)=' 4883 pts/8 00:00:00 mumps' ;" e.g. array(19308)='19308 ? 00:00:00 mumps' ;" e.g. array(27454)='27454 pts/5 00:00:53 mumps' ;"Result: none new p set p="temp" open p:(COMMAND="ps -C mumps":readonly)::"pipe" use p new lineIn,ch for do quit:($zeof) . read lineIn . for do quit:(ch'=" ") . . set ch=$extract(lineIn,1,1) quit:(ch'=" ") . . set lineIn=$extract(lineIn,2,40) . if +lineIn=0 quit . set array(+lineIn)=lineIn close p use $p quit ;"====== old method below ============== kill array new msgFName set msgFName=$$UNIQUE^%ZISUTL("/tmp/mjobslist.txt") new CmdStr set CmdStr="ps -C mumps > """_msgFName_"""" zsystem CmdStr ;"Launch command in linux OS ; ;"get result of execution. (low byte only) -- if wanted new CmdResult set CmdResult=$ZSYSTEM&255 if CmdResult'=0 goto MJDone ; new FName,FPath do SplitFNamePath^TMGIOUTL(msgFName,.FPath,.FName,"/") new resultArray if $$FTG^%ZISH(FPath,FName,"resultArray(0)",1)=0 goto TLDone ; ;"Delete temp info file new FileSpec set FileSpec(FName)="" new temp set temp=$$DEL^%ZISH(FPath,"FileSpec") ; ;"Format resulting array new i set i=0 for set i=$order(resultArray(i)) quit:(i'>0) do . new j set j=$extract(resultArray(i),1,5) . new ch for do quit:(ch'=" ") . . set ch=$extract(j,1,1) . . if ch=" " set j=$extract(j,2,40) . set array(+j)=resultArray(i) ; MJDone quit GetScrnSize(ROWS,COLS) ;"Purpose: To query the OS and get the dimensions of the terminal window ;"Input: ROWS,COLS -- Optional. PASS BY REFERENCE. Filled with results ;"Results: Row^Col e.g. '24^80', or '24^60' as a default if problem. ;"Note: thanks Bhaskar for figuring this out! new p set p="myTerm" open p:(COMMAND="stty -a -F "_$p_"|grep columns":readonly)::"pipe" ;"open p:(COMMAND="stty -a |grep columns":readonly)::"pipe" new x for use p read x quit:($zeof)!(x["columns") close p use $p set COLS=+$piece(x,"columns ",2) set ROWS=+$piece(x,"rows ",2) if (COLS=0)&(ROWS=0) do . set COLS=60,ROWS=24 quit ROWS_"^"_COLS