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