Merge lp:~jontai/openvista-gtm-integration/bug370653 into lp:openvista-gtm-integration

[Jon Tai]

[lp:~jontai/openvista-gtm-integration/bug370653]

65. By Jon Tai on 2009-06-25

bump last-modified date

[jeff.apple (jeff-apple)]

I don't see anything wrong, though I haven't tested.
One small note: some of the new labels used by the switch are 9 characters long. SAC (2.2.4) only allows for 8. However, since this is a GT.M only module I would think it's OK since GT.M will never have a problem with it.

review: Approve

=== modified file 'mumps/ZCD.m'
--- mumps/ZCD.m	2009-05-21 00:49:08 +0000
+++ mumps/ZCD.m	2009-06-25 00:10:38 +0000
@@ -1,4 +1,4 @@
-ZCD	; MSC/JKT,JDS ; "Namespace" utilities for GT.M/Unix ; 01/30/2009
+ZCD	; MSC/JKT,JDS ; "Namespace" utilities for GT.M/Unix ; 16JUN2009
 	;;8.0;KERNEL;**MSC**;April 21 2009
 	; This routine assumes that your global directory file exists one 
 	; directory below the root of the instance, e.g., 
@@ -12,163 +12,128 @@
 	; The actual file name of the global directory file and the actual name
 	; of the parent directory are never checked, so their names do not 
 	; matter.
-	G CD
-	;
-CURRENT()	
-	; return the name of the current OpenVista instance
-	Q $P($ZG,"/",$L($ZG,"/")-2)
-	;
-PATH()	
-	; return the path to the current OpenVista instance
-	N I,X S X=""
-	S X=$P($ZG,"/",1,$L($ZG,"/")-2)
-	Q X
-	;
-ROOT()	
-	; return the path where all OpenVista instances live
-	N I,X S X=""
-	S X=$P($ZG,"/",1,$L($ZG,"/")-3)
-	Q X
-	;
-LIST()	
-	; returns an array (Y) of OpenVista instances on this system
-	;
-	; FIXME: a "user friendly" version of this list should screen out the 
-	;        current instance name and any instances that the current user 
-	;        should not be allowed to switch to (they must have access 
-	;        code and primary menu option in the target instance to switch)
-	;
-	; FIXME: this routine currently requires GT.M V5.3003 because it uses 
-	;        PIPE I/O.  We many want to make it compatible with older 
-	;        versions of GT.M by falling back to using temporary files, 
-	;        but on versions of GT.M V5.3003 and later, we definitely want 
-	;        to use PIPEs to avoid temporary files moving forward.
-	N P,I,X
-	K Y
-	S P="ls"
-	O P:(COMMAND="ls --color=none -1 "_$$ROOT():READONLY)::"PIPE"
-	U P
-	N ROOT,GT S ROOT=$$ROOT,GF=$P($P($ZG,ROOT,2),"/",3,99)
-	F I=1:1 R X Q:X=""  I $ZSEARCH(ROOT_"/"_X_"/"_GF)'="" S Y(I)=X,Y("B",X)=""
-	U $P 
-	C P
-	Q
-	;
-GTMPATH(INSTANCE)	
-	; return the path to the version of GT.M this instance uses
-	;
-	; FIXME: handle the case when INSTANCE is bogus
-	; 
-	N P,X
-	S P="readlink"
-	O P:(COMMAND="readlink "_$$ROOT()_"/"_INSTANCE_"/gtm":READONLY)::"PIPE"
-	U P
-	R X
-	U $P
-	C P
-	Q X
-	;
-SWITCH(INSTANCE)	
-	; switch to another OpenVista instance by setting $ZG and $ZRO
-	;
-	; there are several ways to do this; try them in order until 
-	; one succeeds
-	;
-	; FIXME: we may want to allow this entry point to be called using DO
-	Q:$$SWITCH1(INSTANCE) 1
-	Q:$$SWITCH2(INSTANCE) 1
-	Q:$$SWITCH3(INSTANCE) 1
-	Q 0
-	;
-SWITCH1(INSTANCE)	
-	; private entry point
-	;
-	; look for new values of $ZG and $ZRO in env directory of 
-	; target instance
-	N ZG,ZRO,G,RO
-	;
-	; FIXME: if file does not exist or is unreadable (permission 
-	;        denied), Q 0
-	;S G=$$ROOT()_"/"_INSTANCE_"/env/gtmgbldir"
-	;O G:READONLY U G R ZG U $P C G
-	N I,A S A="/"_$$CURRENT()_"/",ZG=""
-	F I=1:1:$L($ZG,A) S ZG=ZG_$P($ZG,A,I)_$S(I=$L($ZG,A):"",1:"/"_INSTANCE_"/")
-	;
-	; FIXME: if file does not exist or is unreadable (permission 
-	;        denied), Q 0
-	;S RO=$$ROOT()_"/"_INSTANCE_"/env/gtmroutines"
-	;O RO:READONLY U RO R ZRO U $P C RO
-	S ZRO=""
-	F I=1:1:$L($ZRO,A) S ZRO=ZRO_$P($ZRO,A,I)_$S(I=$L($ZRO,A):"",1:"/"_INSTANCE_"/")
-	;
-	S $ZG=ZG,$ZRO=ZRO
-	;
-	;zlink the buffer
-	X "Q"
-	N I
-	S I=$view("rtnnext","")
-NEXT	F  S I=$VIEW("rtnnext",I) Q:I=""  I I'="GTM$DMOD" D
-	.I I="ZCD" Q
-	.I $E(I)="%" Q:($E(I,2)'="Z")
-	.K %ZR D SILENT^%RSEL(I) I $D(%ZR(I)) S A=$TR(I,"%","_") N $ET S $ET="G NEXT^ZCD" ZLINK A_".m" Q
-	.N DIE,X,B S X=I,B(1,0)=I_" ;",B(2,0)=" ZMESSAGE 150374338:$PIECE($ZPOSITION,""^"",2)",B(3,0)=" QUIT"
-	.S DIE="B(",XCN=0 N I D SAVE(X)
-	; FIXME: do we need to set $ZINTERRUPT and $PATH?
-	Q 1
-	;
-SWITCH2(INSTANCE)	
-	; private entry point
-	;
-	; look for new values of $ZG and $ZRO in env file of target instance
-	;
-	; if the env file does not exist or is unreadable (permission denied) 
-	; or unparsable, Q 0 without setting $ZG and $ZRO
-	;
-	; FIXME: implement this
-	;
-	; FIXME: do we need to set $ZINTERRUPT and $PATH?
-	Q 0
-	;
-SWITCH3(INSTANCE)	
-	; private entry point
-	;
-	; get new values of $ZG and $ZRO by replacing $$PATH() with 
-	; $$ROOT()_"/"_INSTANCE.  Q 0 without setting $ZG and $ZRO if the 
-	; resulting paths don't actually exist or we do not have permission to
-	; access them
-	;
-	; FIXME: implement this
-	;
-	; FIXME: do we need to set $ZINTERRUPT and $PATH?
-	Q 0
-	;
-CD	;Interactive
+	;
+CD ; interactive
 	N Y,DIR
-	R !,"Namespace: ",DIR
+	S:'$D(DTIME) DTIME=300
+	R !,"Namespace: ",DIR:DTIME
 	I DIR["^"!(DIR="") Q
-	D LIST()
+	D LIST
 	I DIR["?" G HELP
 	I '$D(Y("B",DIR)) W !,"Invalid Namespace" G CD
 	I $$GTMPATH($$CURRENT())'=$$GTMPATH(DIR) W !,"Inconsistent GTM versions",! G CD
-	S $ZPROMPT=DIR_">"
-	S A=$$SWITCH1(DIR)
+	S A=$$SWITCH(DIR)
 	Q
+	;
 HELP	N A S A=""
 	F  S A=$O(Y("B",A)) Q:A=""  W !,A
 	W ! G CD
 	Q
-SAVE(RN)	;Save a routine
-	N %,%F,%I,%N,SP,$ETRAP
-	S $ETRAP="S $ECODE="""" Q"
-	S %I=$I,SP=" ",%F="/tmp/"_$J_"/"_RN_".m"
-	ZSYSTEM "mkdir /tmp/"_$J
-	O %F:(newversion:noreadonly:blocksize=2048:recordsize=2044) U %F
-	F  S XCN=$O(@(DIE_XCN_")")) Q:XCN'>0  S %=@(DIE_XCN_",0)") Q:$E(%,1)="$"  I $E(%)'=";" W $P(%,SP)_$C(9)_$P(%,SP,2,99999),!
-	C %F ;S %N=$$NULL
-	S ZR=$ZRO,$ZRO=$ZRO_" /tmp/"_$J_"/"
-	ZLINK RN
-	ZSYSTEM "rm -r /tmp/"_$J
-	S $ZRO=ZR
-	;C %N
-	U %I
+	;
+ROOT()	; return path where all OpenVista instances live
+	Q $P($ZG,"/",1,$L($ZG,"/")-3)
+	;
+CURRENT() ; return name of the current OpenVista instance
+	Q $P($ZG,"/",$L($ZG,"/")-2)
+	;
+PATH(INSTANCE) ; return path to an OpenVista instance
+	Q $$ROOT()_"/"_INSTANCE
+	;
+GTMPATH(INSTANCE) ; return the path to the version of GT.M this instance uses
+	N %PIPE,%I S %PIPE="readlink",%I=$I
+	O %PIPE:(COMMAND="readlink "_$$PATH(INSTANCE)_"/gtm":READONLY)::"PIPE" U %PIPE
+	N %PATH R %PATH
+	U %I
+	C %PIPE
+	Q %PATH
+	;
+LIST	; return an array (Y) of OpenVista instances on this system
+	N %PIPE,%I S %PIPE="ls",%I=$I
+	O %PIPE:(COMMAND="ls --color=none -1 "_$$ROOT():READONLY)::"PIPE" U %PIPE
+	N I,%NAME K Y
+	F I=1:1 R %NAME Q:%NAME=""  I $$GTMPATH(%NAME)'="" S Y(I)=%NAME,Y("B",%NAME)=""
+	U %I
+	C %PIPE
+	Q
+	;
+SWITCH(INSTANCE) ; switch to another OpenVista instance
+	;
+	; don't allow switching if GT.M versions aren't the same
+	Q:$$GTMPATH($$CURRENT())'=$$GTMPATH(INSTANCE) 0
+	;
+	; there are several ways to determine new values of $ZG and $ZRO
+	; try each method until one succeeds
+	N %ZG,%ZRO,%METHOD S %ZG="",%ZRO=""
+	F %METHOD="ENV","CAT","REP" Q:$$@("SWITCH"_%METHOD)(INSTANCE)
+	I %ZG="",%ZRO="" Q 0
+	;
+	; FIXME: set gtm_dist="$root/$instance/gtm"
+	N %TEMPDIR S %TEMPDIR=$$MKTEMP() S $ZG=%ZG,$ZRO=%ZRO_" "_%TEMPDIR
+	N X,Y S X=INSTANCE X ^%ZOSF("UPPERCASE") S $ZPROMPT=Y_">"
+	; FIXME: set GTMXC_openvista="$root/$instance/gtm/openvista.xc"
+	; FIXME: set PATH="$PATH:$root/$instance/gtm"
+	;
+	; re-ZLINK routines that have been loaded in our current image
+	X "Q" ; equivalent to ZGOTO so that you can recompile a routine you are using
+	N %ROUTINE,%FILENAME S %ROUTINE=""
+NEXT	F  S %ROUTINE=$VIEW("rtnnext",%ROUTINE) Q:%ROUTINE=""  D
+	. Q:%ROUTINE="GTM$DMOD"
+	. Q:%ROUTINE="ZCD"
+	. ;
+	. ; The only % routines that we ship start with %Z other % routines are allocated to the 
+	. ; vendor (GTM) and do not need to be recompiled (and may only have object code)
+	. Q:$E(%ROUTINE)="%"&($E(%ROUTINE,2)'="Z")
+	. ;
+	. ; If the routine exists in the target instance, ZLINK it.  This replaces the 
+	. ; old version in our current image with the new version from the target instance.
+	. ; If the routine does not exist in the target instance, we have to "kill" the routine 
+	. ; in our current image by creating a dummy routine that throws a GTM-E-FILENOTFND error 
+	. ; and ZLINKing the dummy routine.  See http://groups.google.com/group/Hardhats/msg/a213981e1503db79
+	. S %FILENAME=$TR(%ROUTINE,"%","_")_".m"
+	. K %ZR D SILENT^%RSEL(%ROUTINE) I '$D(%ZR(%ROUTINE)) D WRITEROU(%TEMPDIR_"/"_%FILENAME,%ROUTINE)
+	. ZLINK %FILENAME
+	;
+	; cleanup and return
+	S $ZRO=%ZRO ; remove temporary directory from $ZRO
+	ZSY "rm -rf "_%TEMPDIR
+	Q:'$Q
+	Q 1
+	;
+SWITCHENV(INSTANCE) ; private entry point to be used by $$SWITCH only
+	; set new $ZG and $ZRO by parsing env file in target instance
+	;
+	; FIXME: implement this
+	Q 0
+	;
+SWITCHCAT(INSTANCE) ; private entry point to be used by $$SWITCH only
+	; set new $ZG and $ZRO by concatenating conventional names to $$ROOT
+	;
+	S %ZG=$$PATH(INSTANCE)_"/globals/mumps.gld"
+	S %ZRO=$$PATH(INSTANCE)_"/objects("_$$PATH(INSTANCE)_"/routines) "_$$PATH(INSTANCE)_"/gtm"
+	;
+	; FIXME: check that %ZG actually exists and that all pieces of %ZRO exist
+	Q 1
+	;
+SWITCHREP(INSTANCE) ; private entry point to be used by $$SWITCH only
+	; set new $ZG and $ZRO by replacing $$PATH($$CURRENT()) with $$PATH(INSTANCE)
+	;
+	; FIXME: implement this
+	Q 0
+	;
+MKTEMP() ; create a secure temporary directory, returns path to new directory
+	N %PIPE,%I S %PIPE="mktemp",%I=$I
+	O %PIPE:(COMMAND="mktemp -d -t .zcd.XXXXXXXXXX":READONLY)::"PIPE" U %PIPE
+	N %TEMPDIR R %TEMPDIR
+	U %I
+	C %PIPE
+	Q %TEMPDIR
+	;
+WRITEROU(PATH,ROUTINE) ; write out dummy routine
+	N %I S %I=$I
+	O PATH:(NEWVERSION:NOREADONLY:VARIABLE) U PATH
+	W ROUTINE,!
+	W " ZMESSAGE 150374338:$PIECE($ZPOSITION,""^"",2)",!
+	W " QUIT",!
+	U %I
+	C PATH
 	Q