1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
ZCD ; MSC/JKT,JDS ; "Namespace" utilities for GT.M/Unix ; 5DEC2009
;;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.,
;
; /opt/openvista/instance/globals/mumps.gld
;
; or
;
; /home/vista/instance/g/default.gld
;
; 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.
;
CD ; interactive
N Y,DIR
S:'$D(DTIME) DTIME=300
R !,"Namespace: ",DIR:DTIME
I DIR["^"!(DIR="") Q
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 A=$$SWITCH(DIR)
Q
;
HELP N A S A=""
F S A=$O(Y("B",A)) Q:A="" W !,A
W ! G CD
Q
;
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 %PATH,%PIPE,%I
S %I=$I
S %PIPE="ovgetvar"
O %PIPE:(COMMAND="ovgetvar "_INSTANCE_" gtm_path 2> /dev/null":READONLY)::"PIPE" U %PIPE
R %PATH
C %PIPE
I %PATH'="" U %I Q %PATH
S %PIPE="readlink"
O %PIPE:(COMMAND="readlink "_$$PATH(INSTANCE)_"/gtm":READONLY)::"PIPE" U %PIPE
R %PATH
C %PIPE
U %I 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
N %ZG,%ZRO D NEWZGZRO(INSTANCE) I %ZG="",%ZRO="" Q 0
;
N %TEMPDIR S %TEMPDIR=$$MKTEMP() S $ZG=%ZG,$ZRO=%ZRO_" "_%TEMPDIR
N X,Y S X=INSTANCE X ^%ZOSF("UPPERCASE") S $ZPROMPT=Y_">"
;
; 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
. I "^GTM$DMOD^ZCD^MSCXUS3A^XQ1^XUP^%MSCXUCI^%ZMSCXUCI^"[("^"_%ROUTINE_"^") Q ;do not try to recompile these
. ;
. ; 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
;
NEWZGZRO(INSTANCE) ; determine new values of $ZG and $ZRO
S %ZG="",%ZRO=""
;
; don't allow switching if GT.M versions aren't the same
Q:$$GTMPATH($$CURRENT())'=$$GTMPATH(INSTANCE)
;
; there are several ways to determine new values of $ZG and $ZRO
; try each method until one succeeds
N %METHOD F %METHOD="ENV","CAT","REP" D @("SWITCH"_%METHOD)(INSTANCE) Q:%ZG'=""&(%ZRO'="")
Q
;
SWITCHENV(INSTANCE) ; private entry point
; set new $ZG and $ZRO by parsing env file in target instance
;
N %PIPE,%I
S %I=$I
S %PIPE="ovgetvar_gtmgbldir"
O %PIPE:(COMMAND="ovgetvar "_INSTANCE_" gtmgbldir 2> /dev/null":READONLY)::"PIPE" U %PIPE
R %ZG
C %PIPE
S %PIPE="ovgetvar_gtmroutines"
O %PIPE:(COMMAND="ovgetvar "_INSTANCE_" gtmroutines 2> /dev/null":READONLY)::"PIPE" U %PIPE
R %ZRO
C %PIPE
U %I
;
; FIXME: check that %ZG actually exists and that all pieces of %ZRO exist
Q
;
SWITCHCAT(INSTANCE) ; private entry point
; set new $ZG and $ZRO by concatenating conventional names to $$ROOT.
; NOTE: this code makes assumptions about the directory layout of the
; OpenVista instance.
;
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
;
SWITCHREP(INSTANCE) ; private entry point
; set new $ZG and $ZRO by replacing $$PATH($$CURRENT()) with $$PATH(INSTANCE)
;
; FIXME: implement this
Q
;
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
|