source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/ZISHGUX.m@ 1326

Last change on this file since 1326 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 6.7 KB
Line 
1%ZISH ;ISF/AC,RWF - GT.M for UNIX Host file Control ;01/04/2005 08:13
2 ;;8.0;KERNEL;**275,306**;Jul 10, 1995;
3 ; for GT.M for Unix/VMS, version 4.3
4 ;
5OPENERR ;
6 Q 0
7 ;
8OPEN(X1,X2,X3,X4,X5,X6) ;SR. Open file
9 ;D OPEN^%ZISH([handlename],[directory],filename,[accessmode],[recsize])
10 ;X1=handle name
11 ;X2=directory, X3=filename, X4=access mode
12 ;X5=new file max record size, X6=Subtype
13 ;
14 N %,%1,%2,%IO,%I2,%P,%T,X,Y,$ETRAP
15 S $ETRAP="D OPNERR^%ZISH"
16 S U="^",X2=$$DEFDIR($G(X2)),X4=$$UP^XLFSTR(X4)
17 S Y=$S(X4["A":"append",X4["R":"readonly",X4["W":"newversion",1:"readonly")
18 S Y=Y_$S(X4["B":":fixed:nowrap:recordsize=512",$G(X5)&(X4["W"):":WIDTH="_+X5,1:"")
19 S:$E(Y)=":" Y=$E(Y,2,999) S %IO=X2_X3,%I2="%IO:"_$S($L(Y):"("_Y_")",1:"")_":3"
20 O @%I2 S %T=$T
21 I '%T S POP=1 Q
22 S IO=%IO,IO(1,IO)="",IOT="HFS",POP=0 D SUBTYPE^%ZIS3($G(X6))
23 I $G(X1)]"" D SAVDEV^%ZISUTL(X1)
24 U IO U $P ;Enable use of $ZA to test EOF condition.
25 Q
26OPNERR ;error on open
27 S POP=1,$ECODE=""
28 U:$G(%P)]"" %P
29 Q
30 ;
31CLOSE(X) ;SR. Close HFS device not opened by %ZIS.
32 ;X1=Handle name, IO=device
33 I IO]"" C IO K IO(1,IO)
34 I $G(X)]"" D RMDEV^%ZISUTL(X)
35 D HOME^%ZIS
36 Q
37DEL(%ZX1,%ZX2) ;ef,SR. Del fl(s)
38 ;S Y=$$DEL^%ZISH("dir path",$NA(array))
39 N %ZISH,%ZISHLGR,%ZX,X,%ZXDEL
40 S %ZX1=$$DEFDIR($G(%ZX1)),%ZXDEL=1,%ZISH=""
41 F S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH="" D
42 . N $ETRAP,$ESTACK S $ETRAP="D DELERR^%ZISH"
43 . I %ZISH["*" S %ZXDEL=0 Q ; Wild card not allowed.
44 . S %ZX=$ZSEARCH(%ZX1_%ZISH)
45 . Q:%ZX']"" ; File doesn't exist - not an error, just quit.
46 . O %ZX:READONLY:0
47 . I '$T S %ZXDEL=0 Q ; Can't open it.
48 . C %ZX:DELETE
49 . I $ZSEARCH(%ZX)]"" S %ZXDEL=0 ; Delete was not successful.
50 Q %ZXDEL
51DELERR ;Trap any $ETRAP error, unwind and return.
52 S $ETRAP="D UNWIND^%ZTER"
53 S %ZXDEL=0
54 D UNWIND^%ZTER
55 Q
56 ;
57LIST(%ZX1,%ZX2,%ZX3) ;ef,SR. Set local array holding fl names
58 ;S Y=$$LIST^ZISH("/dir/","list_root","return_root")
59 ;list_root can have XX("A*"), XX("test.com")...
60 ;Both arrays passed as $NA values (closed roots).
61 N %IO,%X,%ZISH,%ZISH1,%ZISHIO,%ZX,POP,X,%ZISHDL1,%ZISHDL2,%ZISHDN1,%ZISHDN2
62 N $ETRAP,$ESTACK S $ETRAP="G LSTEOF^%ZISH",%ZX1=$$DEFDIR($G(%ZX1))
63 S %IO=$I,%ZISHDN1="_ZISH"_$J_".TMPA",%ZISHDN2="ZISH"_$J_".TMPB"
64 S %ZISHDL1=%ZX1_%ZISHDN1,%ZISHDL2=%ZX1_%ZISHDN2
65 S $ZT="G SPAWNERR^%ZISH"
66 ;Init %ZISHDL1, %ZISHDL2 by deleteing them
67 ;I $ZSEARCH(%ZISHDL1)["ZISH" ZSYSTEM "rm "_%ZISHDL1
68 ;I $ZSEARCH(%ZISHDL2)["ZISH" ZSYSTEM "rm "_%ZISHDL2_";*"
69 ;Get fls, Build listing in %ZISHDL1 with ls
70 S %ZISH1=0,%ZISH=""
71 F S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH="" D
72 . S X=$$LIST1(%ZX1_%ZISH,%ZX1)
73LSTEOF S $ZT=""
74 I $L(%IO) U:$D(IO(1,%IO)) IO
75 ;C %ZISHDL1 ;:DELETE
76 ;I $L($ZSEARCH(%ZISHDL2)) ZSYSTEM "DEL "_%ZISHDL2
77 ;I $L($ZSEARCH(%ZISHDL1)) ZSYSTEM "DEL "_%ZISHDL1_";*"
78 S $ECODE=""
79 Q ($Q(@%ZX3)]"")
80 ;
81LIST1(%ZX,%ZD) ;Get one part of the list
82 N $ET,$ES S $ET="D LSTERR^%ZISH"
83 ;ZSYSTEM "ls -1 "_%ZX_" > "_%ZISHDL1
84 ;O %ZISHDL1:readonly:1 U %ZISHDL1
85 ;F R %X:1 Q:$ZEOF S @%ZX3@(%X)=""
86 ;C %ZISHDL1:DELETE
87 N %ZY,%ZI,%ZJ
88 S %ZY=$ZSEARCH("*.X") ;Clear vector
89 S %ZY=$P(%ZX,"*")
90 F S %ZI=$ZSEARCH(%ZX) Q:'$L(%ZI)!(%ZI'[%ZY) S %ZJ=$P(%ZI,%ZD,2),@%ZX3@(%ZJ)=""
91 Q 1
92LSTERR ;Error in list
93 I $ZSEARCH(%ZISHDL2)["ZISH" ZSYSTEM "DEL "_%ZISHDL2_";*"
94 Q 0
95 ;
96SPAWNERR ;TRAP ERROR OF SPAWN
97 O %ZISHDL1:READONLY:1 I $T C %ZISHDL1:DELETE
98 S $ECODE=""
99 Q 0
100 ;
101MV(X1,X2,Y1,Y2) ;ef,SR. Rename a fl
102 ;S Y=$$MV^ZISH("/dir/","fl","/dir/","fl")
103 N X,Y,%ZISHDL1
104 S %ZISHDL1="ZISH"_$J_".TMPA",X1=$$DEFDIR($G(X1)),Y1=$$DEFDIR($G(Y1))
105 S $ZT="SPAWNERR^%ZISH"
106 ;Pbv or qit
107 I (X2="")!(Y2="") Q 0
108 ZSYSTEM "mv "_X1_X2_" "_Y1_Y2 ;Use system command
109 S Y=$ZSEARCH(Y1_Y2)
110 Q $L(Y)>0
111 ;
112PWD() ;ef,SR. Print working directory
113 N Y
114 S Y=$$DEFDIR("")
115 S:Y="" Y=$ZDIR
116 Q Y
117 ;
118DEFDIR(DF) ;ef. Default Dir and frmt
119 S DF=$G(DF) Q:DF="." "" ;Special way to get current dir.
120 S:DF="" DF=$G(^XTV(8989.3,1,"DEV"))
121 ;Check syntax, VMS needs : or [ ]
122 I ^%ZOSF("OS")["VMS" D Q DF ;***EXIT FOR VMS/GTM
123 . N P1,P2
124 . I DF[":" S P1=$P(DF,":")_":",P2=$P(DF,":",2)
125 . E S P1="",P2=DF
126 . I P1="",P2["$" S DF=P2 Q ;Assume a logical
127 . I $L(P2) S:P2'["[" P2="["_P2 S:P2'["]" P2=P2_"]"
128 . S DF=P1_P2
129 . Q
130 ;
131 ;Check syntax, Unix check leading & trailing "/"
132 I "./"'[$E(DF) S DF="/"_DF
133 I $E(DF,$L(DF))'="/" S DF=DF_"/"
134 Q DF
135STATUS() ;ef,SR. Return EOF status
136 U $I
137 Q $ZEOF
138 ;
139EOF(X) ;Eof flag, Pass in $ZA
140 Q X
141QL(X) ;Qlfrs
142 Q:X=""
143 S:$E(X)'="-" X="-"_X
144 Q
145FL(X) ;Fl len
146 N ZOSHP1,ZOSHP2
147 S ZOSHP1=$P(X,"."),ZOSHP2=$P(X,".",2)
148 I $L(ZOSHP1)>14 S X=4 Q
149 I $L(ZOSHP2)>8 S X=4 Q
150 Q
151 ;
152MAKEREF(HF,IX,OVF) ;Internal call to rebuild global ref.
153 ;Return %ZISHF,%ZISHO,%ZISHI,%ZISUB
154 N I,F,MX
155 S OVF=$G(OVF,"%ZISHOF")
156 S %ZISHI=$$QS^DDBRAP(HF,IX),MX=$$QL^DDBRAP(HF) ;
157 S F=$NA(@HF,IX-1) ;Get first part
158 I IX=1 S %ZISHF=F_"(%ZISHI" ;Build root, IX=1
159 I IX>1 S %ZISHF=$E(F,1,$L(F)-1)_",%ZISHI" ;Build root
160 S %ZISHO=%ZISHF_","_OVF_",%OVFCNT)" ;Make overflow
161 F I=IX+1:1:MX S %ZISHF=%ZISHF_",%ZISUB("_I_")",%ZISUB(I)=$$QS^DDBRAP(HF,I)
162 S %ZISHF=%ZISHF_")"
163 Q
164FTG(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;ef,SR. Unload contents of host file into global
165 ;p1=host file directory
166 ;p2=host file name
167 ;p3= $NAME REFERENCE INCLUDING STARTING SUBSCRIPT
168 ;p4=INCREMENT SUBSCRIPT
169 ;p5=Overflow subscript, defaults to "OVF"
170 N %ZA,%ZB,%ZC,%ZL,X,%OVFCNT,%CONT
171 N I,%ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHLGR,%ZISHOF,%ZISHOX,%ZISHS,%ZX,%ZISHY,POP,%ZISUB,%EXIT
172 S %ZX1=$$DEFDIR($G(%ZX1)),%ZISHOF=$G(%ZX5,"OVF")
173 D MAKEREF(%ZX3,%ZX4,"%ZISHOF")
174 D OPEN^%ZISH(,%ZX1,%ZX2,"R")
175 I POP Q 0
176 N $ETRAP S %EXIT=0,$ETRAP="S %ZA=1,%EXIT=1,$ECODE="""" Q"
177 U IO F K %XX D READNXT(.%XX) Q:$$EOF(%ZA) D
178 . S @%ZISHF=%XX
179 . I $D(%XX)>2 F %OVFCNT=1:1 Q:'$D(%XX(%OVFCNT)) S @%ZISHO=%XX(%OVFCNT)
180 . S %ZISHI=%ZISHI+1
181 . Q
182 D CLOSE() ;Normal exit
183 Q '%EXIT
184 ;
185ERREOF D CLOSE() ;Got error Reading file
186 Q 0
187 ;
188READNXT(REC) ;
189 N T,I,X,%
190 U IO R X:2 S %ZA=$ZEOF,REC=$E(X,1,255)
191 Q:$L(X)<256
192 S %=256 F I=1:1 Q:$L(X)<% S REC(I)=$E(X,%,%+254),%=%+255
193 Q
194GTF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Load contents of global to host file.
195 ;Previously name LOAD
196 ;p1=$NAME of global reference
197 ;p2=incrementing subscript
198 ;p3=host file directory
199 ;p4=host file name
200 N %ZISHY,%ZISHLGR,%ZISHOX
201 S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"W")
202 Q %ZISHY
203 ;
204GATF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Append to host file.
205 ;
206 ;p1=$NAME of global reference
207 ;p2=incrementing subscript
208 ;p3=host file directory
209 ;p4=host file name
210 N %ZISHY
211 S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"A")
212 Q %ZISHY
213 ;
214MGTF(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;
215 ;p1=$NAME of global reference
216 ;p2=incrementing subscript
217 ;p3=host file directory
218 ;p4=host file name
219 N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHLGR,%ZISHS,%ZISHOX,IO,%ZX,Y
220 D MAKEREF(%ZX1,%ZX2)
221 D OPEN^%ZISH(,%ZX3,%ZX4,%ZX5) ;Default dir set in open
222 I POP Q 0
223 N X
224 N $ETRAP S $ETRAP="",X="ERREOF^%ZISH",@^%ZOSF("TRAP")
225 F Q:'($D(@%ZISHF)#2) S %ZX=@%ZISHF,%ZISHI=%ZISHI+1 U IO W %ZX,!
226 D CLOSE() ;Normal Exit
227 Q 1
228 ;
Note: See TracBrowser for help on using the repository browser.