TMGIOUTL ;TMG/kst/IO Utilities ;03/25/06 ;;1.0;TMG-LIB;**1**;07/12/05 ;"TMG IO UTILITIES ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"7-12-2005 ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"$$FNameExtract^TMGIOUTL(FullNamePath,NodeDiv) ;"$$PathExtract^TMGIOUTL(FullNamePath,NodeDiv) ;"$$UpPath^TMGIOUTL(Path,NodeDiv) -- return a path that is one step up from current path ;"SplitFNamePath^TMGIOUTL(FullNamePath,OutName,OutPath,NodeDiv) ;"$$GetFName^TMGIOUTL(Msg,DefPath,DefFName,NodeDiv,OutPath,OutName,Prompt) ;"$$GetDirName(Msg,DefPath,NodeDiv,OutPath,Prompt) -- query user for a directory name ;"$$IsDir^TMGIOUTL(Path) ;DEPRECIATED .. moved to ^TMGKERNL ;"$$Move^TMGIOUTL(Source,Dest) ;DEPRECIATED .. moved to ^TMGKERNL ;"$$FileExists^TMGIOUTL(FullNamePath) ;"$$Dos2Unix^TMGIOUTL(FullNamePath) ;DEPRECIATED .. moved to ^TMGKERNL ;"$$WP2HFS^TMGIOUTL(GlobalP,path,filename) ;"$$WP2HFSfp^TMGIOUTL(GlobalP,pathfilename) ;"$$HFS2WP^TMGIOUTL(path,filename,GlobalP) ;"$$HFS2WPfp^TMGIOUTL(pathfilename,GlobalP) ;"$$DelFile^TMGIOUTL(pathfilename) ;"$$EnsureTrailDiv^TMGIOUTL(path) ;"======================================================================= ;"Dependancies ;"TMGUSRIF for showing dialogs. ;"TMGDEBUG ;"TMGSTUTL ;"TMGMISC ;"======================================================================= ;"======================================================================= FNameExtract(FullNamePath,NodeDiv) ;"SCOPE: Public ;"Purpose: to extract a file name from a full path+name string ;"Input: FullNamePath: String to process. ;" e.g.: "/tmp/myfilename.txt" ;" NodeDiv: [OPTIONAL] -- the character that separates folders (e.g. "/") ;" if not supplied, then default value is "/" ;"Result: the filename, or "" if not found ;" e.g.: "myfilename.txt" new OutPath,OutName do SplitFNamePath(.FullNamePath,.OutPath,.OutName,.NodeDiv) quit $get(OutName) PathExtract(FullNamePath,NodeDiv) ;"SCOPE: Public ;"Purpose: to extract a file name from a full path+name string ;"Input: FullNamePath: String to process. ;" e.g.: "/usr/local/myfilename.txt" ;" NodeDiv: [OPTIONAL] -- the character that separates folders (e.g. "/") ;" if not supplied, then default value is "/" ;"Result: the path, or "" if not found ;" e.g.: "/usr/local/" new OutPath,OutName do SplitFNamePath(.FullNamePath,.OutPath,.OutName,.NodeDiv) quit $get(OutPath) UpPath(Path,NodeDiv) ;"SCOPE: Public ;"Purpose: To return a path that is one step up from current path ;"Input: Path -- NOTE: **MUST NOT** have a file name ;" e.g. RIGHT --> '/var/local/' ;" WRONG --> '/var/MyFile.txt' <-- 'MyFile.txt' would be treated as path node ;" '/var/MyFile.txt' = '/var/MyFile.txt/' ==> UP ==> '/var/' ;" NodeDiv: [OPTIONAL] -- the character that separates folders (e.g. "/") ;" if not supplied, then default value is "/" ;"Results: Returns resulting path. E.g. '/var/local/' --> '/var/' ;" Note: '/' --> '/' (i.e. can't go higher than root) set NodeDiv=$get(NodeDiv,"/") new tempPath set tempPath=$$EnsureTrailDiv($get(Path),NodeDiv) new result set result=NodeDiv if tempPath'=NodeDiv do . set result=$piece(tempPath,"/",1,$length(tempPath,"/")-2)_NodeDiv else set result=NodeDiv quit result ExtExtract(FullNamePath,NodeDiv) ;"Purpose: to return the extension of the file name from full path+name string ;" This will be everything after the last '.' ;"Input: FullNamePath: String to process. ;" e.g.: "/usr/local/myfilename.txt" ;" NodeDiv: [OPTIONAL] -- the character that separates folders (e.g. "/") ;" if not supplied, then default value is "/" ;"Result: the extension or "" if not found ;" e.g.: "txt" (doesn't include '.' new result set result=$piece(FullNamePath,".",$length(FullNamePath,".")) quit result SplitFNamePath(FullNamePath,OutPath,OutName,NodeDiv) ;"SCOPE: Public ;"Purpose: Take FullNamePath, and split into name and path. ;"Input: FullNamePath: String to process. ;" e.g.: "/tmp/myfilename.txt" ;" NOTICE: IF PASSED BY REFERENCE, WILL BE CHANGED TO FILENAME! ;" OutName: MUST BE PASSED BY REFERENCE. This is an OUT parameter ;" OutPath: MUST BE PASSED BY REFERENCE. This is an OUT parameter ;" NodeDiv: [OPTIONAL] -- the character that separates folders (e.g. "/") ;" if not supplied, then default value is "/" ;"Output: The resulting file name is put into OutName, ;" e.g.: "myfilename.txt" ;" and the path is put into OutPath. ;" e.g.: "/tmp/" ;"Result: None. set OutPath="" set OutName="" new PathNode set NodeDiv=$get(NodeDiv,"/") set FullNamePath=$get(FullNamePath) SPN1 if (FullNamePath[NodeDiv)=0 set OutName=FullNamePath goto SPNDone set PathNode=$piece(FullNamePath,NodeDiv,1) set OutPath=OutPath_PathNode_NodeDiv set $piece(FullNamePath,NodeDiv,1)="" set FullNamePath=$extract(FullNamePath,2,255) goto SPN1 SPNDone quit GetFName(Msg,DefPath,DefFName,NodeDiv,OutPath,OutName,Prompt) ;"SCOPE: PUBLIC ;"Purpose: To query the user, to get a filename back ;" Supplies optional directory listing. ;"Input: Msg. [OPTIONAL] A message to show user prior to name prompt. ;" May contain "\n" character for line wrapping. ;" DefPath: [OPTIONAL] The default path to offer user. ;" DefFName:[OPTIONAL] The default filename to offer user. ;" NodeDiv: [OPTIONAL] -- the character that separates folders (e.g. "/") ;" if not supplied, then default value is "/" ;" OutPath: [OPTIONAL] Pass by reference, filled with selected path ;" //no --> Note: Will return like this: '/home/test' not '/home/test/' ;" (6-5-05: I think this because $$FTG^%ZISH wants the path like this) ;" OutName: [OPTIONAL] Pass by reference, filled with selected name ;" Prompt: [OPTIONAL] Prompt for user to enter filename/directory name ;"Result: returns user specified filename (with path), or "" if aborted ;"5/16/09 -- Code changed to use newer, more GUI, file browser. new Option new result set result="" set Option("MSG")=$get(Msg) set Option("PATH")=$get(DefPath) set Option("NAME")=$get(DefFName) set Option("NodeDiv")=$get(NodeDiv) set Option("PROMPT")=$get(Prompt) set result=$$FBrowse^TMGIOUT2(.Option,.OutPath,.OutName) quit result ;"------- older code below --------------- if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetFName^TMGIOUTL") set Prompt=$get(Prompt,"Enter File Name (? for help): ") if $data(Msg) do . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Calling PopupBox") . do PopupBox^TMGUSRIF("Message:",$get(Msg)_"\nEnter ? for help.") set DefFName=$get(DefFName) if $get(NodeDiv)="" kill NodeDiv set NodeDiv=$get(NodeDiv,"/") set DefPath=$get(DefPath) new StackCaller set StackCaller=$$Caller^TMGMISC if DefPath="" set DefPath=$get(^TMG("TMP","SETTINGS","GetFName",StackCaller)) ;"Default to the path used last time by caller if DefPath="" set DefPath=NodeDiv set OutPath=$get(OutPath) set OutName=$get(OutName) new UserName new result set result="" new loop set loop=0 if $$IsDir^TMGKERNL(DefPath)=0 do . ;"write "Default directory ["_DefPath_"] doesn't exist.",! . set DefPath=NodeDiv GFN1 write Prompt ;"hello if $extract(DefPath,$length(DefPath))'=NodeDiv do . set DefPath=DefPath_NodeDiv write DefPath_DefFName,"" set UserName=$$Read^TMGUSRIF("rt",$get(DTIME,3600),,DefPath_DefFName) write ! set UserName=$$Trim^TMGSTUTL(UserName) if (UserName["..") do goto GFN1 . new temp1 . ;"anything missing on this line? Was blank... . if ($extract(DefPath,$length(DefPath))=NodeDiv)&(DefPath'="/") do . set DefPath=$extract(DefPath,1,$length(DefPath)-1) . do SplitFNamePath(DefPath,.DefPath,.temp,1) else if UserName="" do goto GFNDone . set OutPath=DefPath . set OutName=DefFName . set result=DefPath_DefFName else if ($$UP^XLFSTR(UserName)["??") do goto GFN1 . new TMGMask,UserMask . set UserMask=$piece(UserName,"?? ",2) . if UserMask="" set UserMask=$piece(UserName,"?? ",2) . if UserMask="" set UserMask="*" . set TMGMask(UserMask)="" . new TMGFiles . if $$IsDir^TMGKERNL(DefPath)=0 write "?? invalid directory",! quit . if $$LIST^%ZISH(DefPath,"TMGMask","TMGFiles")=1 do . . write "Directory Listing",! . . write "-----------------",! . . new col set col=3 . . new index set index="" . . for set index=$order(TMGFiles(index)) quit:(index)="" do . . . set col=(col+1)#4 . . . write ?(col*20)+1," " . . . new testDir set testDir=$$EnsureTrailDiv(DefPath,NodeDiv) . . . set testDir=testDir_index . . . if $$IsDir^TMGKERNL(testDir) write "<",index,">" . . . else write index . . . if col=3 write ! . . write ! else if UserName["^" do goto GFNDone . set result="" . set OutPath="" . set OutName="" else if UserName["?" do goto GFN1 . write " Current directory: [",DefPath,"]",! . write " Default file name: [",DefFName,"]",! . write " Example input: ",NodeDiv,"Data",NodeDiv,"Office",NodeDiv,"myfile.txt",! . write " DELETE (with backspace) parts of path not wanted.",! . write " Enter ^ to abort",! . write " Enter ?? for directory listing (?? a* to show files starting with a)",! . write " Enter .. to move up one directory level",! . write " NOTE: If a partial name is entered then [ENTER] or [TAB], it will be autofinished.",! else if $extract(UserName,$length(UserName))=NodeDiv do goto GFN1 . new tempPath set tempPath=DefPath . if $extract(UserName,1,1)=NodeDiv set DefPath="" . if $$IsDir^TMGKERNL(DefPath_UserName) set DefPath=DefPath_UserName . else write "?? invalid directory",! set DefPath=tempPath else for do quit:(loop'=1) . if loop=0 do . . if $extract(UserName,1,1)=NodeDiv do SplitFNamePath(UserName,.DefPath,.UserName) . . set OutPath=DefPath . . set OutName=UserName . . set result=OutPath_OutName . else set loop=0 . if $$IsDir^TMGKERNL(result) do quit . . set DefPath=result . . set DefName="" . . set result="" . . do CUU^TMGTERM(1) ;"cursor up 1 VT100 esc sequence. . if result["*" do . . set result=$$PickOneFile(result) . if '$$FileExists(result) do . . new tempresult set tempresult=result . . set result=$$PickOneFile(result_"*") . . if result="^" set loop=0 quit . . if result'="" set loop=1 quit . . new UseAnyway . . write !,"File name """,tempresult,""" doesn't exist.",! . . read "Use name anyway? NO// ",UseAnyway:$get(DTIME,3600),! . . set UseAnyway=$$UP^XLFSTR(UseAnyway) . . if '(UseAnyway["Y") set result="" . . else set result=tempresult if result="" goto GFN1 GFNDone if (result'=UserName)&(UserName'="^") do . write "Using file: ",result,! do SplitFNamePath(result,.OutPath,.OutName,NodeDiv) set ^TMG("TMP","SETTINGS","GetFName",StackCaller)=OutPath ;"store for future use. quit result GetDirName(Msg,DefPath,NodeDiv,Prompt) ;"SCOPE: PUBLIC ;"Purpose: To query the user, to get a directory name back ;"Input: Msg. [OPTIONAL] A message to show user prior to name prompt. ;" May contain "\n" character for line wrapping. ;" DefPath: [OPTIONAL] The default path to offer user. ;" NodeDiv: [OPTIONAL] -- the character that separates folders (e.g. "/") ;" if not supplied, then default value is "/" ;" Prompt: [OPTIONAL] Prompt for user to enter filename/directory name ;"Result: returns user specified filename (with path), or "" if aborted ; new Option new result set result="" set Option("MSG")=$get(Msg) set Option("PATH")=$get(DefPath) set Option("NodeDiv")=$get(NodeDiv) set Option("PROMPT")=$get(Prompt) set Option("SELECT DIR")=1 set result=$$FBrowse^TMGIOUT2(.Option) quit result IsDir(Path) ;"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/" ;"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. ;"Moved to ^TMGKERNL quit $$IsDir^TMGKERNL(.Path) 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 ;"Moved to ^TMGKERNL quit $$Move^TMGKERNL(.Source,.Dest) FileExists(FullNamePath) ;"To determine if file exists. ;"Input: FullNamePath -- the full name and path of file to test, e.g. "/tmp/myfiles/a/test.txt" ;"Results: 1 if file exists (and is unique), 0 if not ;"Note: If FullNamePath indicates a directory, then 0 is returned. ;" Note if FullNamePath contains a * pattern, that would cause multiple ;" files to be returned, then filename is not unique, and function ;" will RETURN THAT IT IS NOT A (unique) FILE new JustName,JustPath new TMGMask new TMGFiles new result set result=0 do SplitFNamePath(FullNamePath,.JustPath,.JustName) set TMGMask(JustName)="" if $$LIST^%ZISH(JustPath,"TMGMask","TMGFiles")=1 do . if $$ListCt^TMGMISC("TMGFiles")=1 do . . set result='$$IsDir^TMGKERNL(FullNamePath) quit result PickOneFile(PartNamePath) ;"To take a name like "MyFil*", and display all matches and allow user to pick one ;"Input: PartNamePath -- the partial name and path of file to test, e.g. "/tmp/myfiles/a/tes*" ;"Results: The FullNamePath of the chosen file (or "" if none, or canceled) ;" 12-14-05, if user enters "^", this is returned. new JustName,JustPath new TMGMask new TMGFiles new result set result="" do SplitFNamePath(PartNamePath,.JustPath,.JustName) set TMGMask(JustName)="" if $$LIST^%ZISH(JustPath,"TMGMask","TMGFiles")=1 do . new count set count=$$ListCt^TMGMISC("TMGFiles") . if count=1 set result=$order(TMGFiles("")) quit . write count," matches to ",PartNamePath," found. Pick one:",! . new part,fName,Num . set fName=$order(TMGFiles("")) . set Num=1 . set part=1 . if fName'="" for do quit:(fName="")!(result="^") . . write " ",Num,". ",JustPath,fName . . if $$IsDir^TMGKERNL(JustPath_fName) write "/" . . write ! . . set TMGFiles(Num)=fName . . set fName=$order(TMGFiles(fName)) . . if (part=10)!(fName="") do . . . new choice . . . set part=1 . . . write "Choose file (1-",Num,"), '^' to cancel, or [Enter] to continue: " . . . read choice:$get(DTIME,3600),!! . . . if choice="^" set fName="",result="^" quit . . . if (+choice>0)&(+choice0 if error ;"Notice!!!! The return code here is DIFFERENT from usual ;"Moved to ^TMGKERNL quit $$Dos2Unix^TMGKERNL(FullNamePath) WP2HFS(GlobalP,path,filename) ;"Purpose: To write a WP field to a Host-File-System file ;"Input: GlobalP -- The reference to the header node (e.g. ^TMG(22702,99,1) in example below) ;" path: for the output file, the path up to, but not including, the filename ;" filename -- the filename to save to in the host file system. If file already exists, it will be overwritten. ;"Note: The format of a WP field is as follows: ;" e.g. ^TMG(22702,99,1,0) = ^^4^4^3050118^ ;" ^TMG(22702,99,1,1,0) = Here is the first line of text ;" ^TMG(22702,99,1,2,0) = And here is another line ;" ^TMG(22702,99,1,3,0) = ;" ^TMG(22702,99,1,4,0) = And here is a final line ;" And the format of the 0 node is: ^^^^^^ ;"Result: 0 if failure, 1 if success ;"Assumptions: That GlobalP is a valid reference to a WP field new result set result=0 ;"default to failure if $data(GlobalP)&($data(path))&($data(filename)) do . new TMGWP . merge TMGWP=@GlobalP . set result=$$GTF^%ZISH("TMGWP(1,0)",1,path,filename) quit result WP2HFSfp(GlobalP,pathfilename) ;"Purpose: To provide an interface to WP2HFS for cases when filename is not already separated from path ;"Result: 0 if failure, 1 if success new path,filename,result do SplitFNamePath(.pathfilename,.path,.filename) set result=$$WP2HFS(.GlobalP,.path,.filename) quit result HFS2WP(path,filename,GlobalP) ;"Purpose: To read a WP field from a Host-File-System file ;"Input: path: for the output file, the path up to, but not including, the filename ;" filename -- the filename to save to in the host file system. If file already exists, it will be overwritten. ;" GlobalP -- The reference to the header node (e.g. ^TMG(22702,99,1) in example below) ;"Note: The format of a WP field is as follows: ;" e.g. ^TMG(22702,99,1,0) = ^^4^4^3050118^ ;" ^TMG(22702,99,1,1,0) = Here is the first line of text ;" ^TMG(22702,99,1,2,0) = And here is another line ;" ^TMG(22702,99,1,3,0) = ;" ^TMG(22702,99,1,4,0) = And here is a final line ;" And the format of the 0 node is: ^^^^^^ ;"Result: 0 if failure, 1 if success ;"Assumptions: That GlobalP is a valid reference to a WP field new result set result=0 ;"default to failure if $data(GlobalP)&($data(path))&($data(filename)) do . new TMGWP,WP . set result=$$FTG^%ZISH(path,filename,"TMGWP(1,0)",1) . ;"zwr TMGWP(*) . ;"new temp read "press enter to continue",temp:$get(DTIME,3600),! . if result=0 quit . ;"Scan for overflow nodes, and integrate into main body . new i set i=$order(TMGWP("")) . if i'="" for do quit:(i="") . . if $data(TMGWP(i,"OVF")) do . . . new j set j=$order(TMGWP(i,"OVF","")) . . . if j'="" for do quit:(j="") . . . . new n set n=i+(j/10) . . . . set TMGWP(n,0)=TMGWP(i,"OVF",j) . . . . set j=$order(TMGWP(i,"OVF",j)) . . . kill TMGWP(i,"OVF") . . set i=$order(TMGWP(i)) . ;"Now copy into another variable, renumbering lines (in case there were overflow lines) . set i=$order(TMGWP("")) . set j=0 . if i'="" for do quit:(i="") . . set j=j+1 . . set WP(j,0)=TMGWP(i,0) . . set i=$order(TMGWP(i)) . ;"now create a header node . do NOW^%DTC ;"returns result in X . set WP(0)="^^"_j_"^"_j_"^"_X_"^^" . ;"now put WP into global reference. . ;"zwr WP(*) . ;"new temp read "press enter to continue",temp:$get(DTIME,3600),! . kill @GlobalP . merge @GlobalP=WP quit result HFS2WPfp(pathfilename,GlobalP) ;"Purpose: To provide an interface to HFS2WP for cases when filename is not already separated from path ;"Result: 0 if failure, 1 if success new path,filename,result do SplitFNamePath(.pathfilename,.path,.filename) set result=$$HFS2WP(.path,.filename,.GlobalP) quit result DelFile(pathfilename) ;"Purpose: to delete one file on host file system ;"Results: returns 1 if success, 0 if failure ;"Note: 2/22/2006 -- if deletion is blocked by OS, then 1 may be returns but file is not deleted. new path,filename,result new TMGFile do SplitFNamePath(.pathfilename,.path,.filename) set TMGFile(filename)="" set result=$$DEL^%ZISH(path,"TMGFile") quit result EnsureTrailDiv(Path,NodeDiv) ;"Purpose: to ensure that a path ends with a node divider. ;" e.g. /var/local --> /var/local/ ;" and /var/local/ --> /var/local/ ;"Input: Path -- the path to convert ;" NodeDiv: [OPTIONAL] -- the character that separates folders (e.g. "/") ;" if not supplied, then default value is "/" ;"Result: the converted/verified path. ; set Path=$get(Path) set NodeDiv=$get(NodeDiv,"/") new result set result=Path if $extract(Path,$length(Path))'=NodeDiv do . set result=Path_NodeDiv ; quit result