source: cprs/branches/tmg-cprs/m_files/TMGXPDIL.m@ 1099

Last change on this file since 1099 was 796, checked in by Kevin Toppenberg, 15 years ago

Initial upload
File size: 10.3 KB
RevLine 
[796]1TMGXPDIL ;TMG/kst/Custom version of XPDIL ;09/17/08
2 ;;1.0;TMG-LIB;**1**;09/17/08
3
4 ;"Original header....
5 ;"XPDIL ;SFISC/RSD - load Distribution Global ;05/28/99 09:41
6 ;" ;;8.0;KERNEL;**15,44,58,68,108**;Jul 10, 1995
7
8 ;
9 ;"Kevin Toppenberg MD
10 ;"GNU General Public License (GPL) applies
11 ;"9/17/08
12
13
14EN1(Option,Msg)
15 ;"Purpose: Provide an API for KIDS load a distribution
16 ;"Input: Option -- PASS BY REFERENCE. Entries are required unless marked optional
17 ;" Option("HFSNAME")=FilePathNameOnHFS
18 ;" Option("FORCE CONT LOAD")=1 <-- if not given, then load won't continue
19 ;" Option("DO ENV CHECK")=# 1=do check, 0=don't do check
20 ;" Option("VERBOSE")=1 for output
21 ;" Msg -- PASS BY REFERANCE, an OUT PARAMETER
22 ;" Errors are stored in Msg("ERROR",x)=Message
23 ;" Msg("ERROR")=count of last error
24 ;" Message are store in Msg(x)=Message
25 ;" Msg=count of last message+1
26 ;"Output: Option -- Option("INSTALL NAME")=Name to use to install package
27
28 N POP,XPDA,XPDST,XPDIT,XPDT,XPDGP,XPDQUIT,XPDREQAB,XPDSKPE
29 S:'$D(DT) DT=$$DT^XLFDT S:'$D(U) U="^"
30 S XPDST=0
31 set Msg=+$get(Msg,1)
32
33 new temp set temp=$$ST(.Option,.Msg) ;"Load in patch
34 if (temp=0)!($G(XPDQUIT)) do goto EnDone
35 . D ABRTALL^TMGXPDI(1,,.Msg) ;"(not interactive)
36 . do AddMsg^TMGPAT2("**NOTHING LOADED**",1,.Msg)
37
38 ;"XPDST= starting Build
39 ;"XPDT("DA",ien)=seq # to install
40 ;"XPDT("NM",build name)=seq #
41 ;"XPDT(seq #)=ien^Build name
42 ;"XPDT("GP",global)= 1-replace, 0-overwrite^ien
43 ;"XPDGP=globals from a Global Package
44 ;"XPDSKPE=1 don't run Environment Check^has question been asked
45 S XPDIT=0,XPDSKPE="0^0"
46 F S XPDIT=$O(XPDT(XPDIT)) Q:'XPDIT D Q:'$D(XPDT)
47 . S XPDA=+XPDT(XPDIT)
48 . if $$CheckLocal^TMGPAT4($name(^XTMP("XPDI",XPDA)),.Option)=1 do
49 . . ;"if $get(Option("VERBOSE"))'=1 quit
50 . . write "WARNING. This code overwrites local mods!",!
51 . . do PressToCont^TMGUSRIF
52 . ;"Check if this Build has an Envir. Check
53 . I $G(^XTMP("XPDI",XPDA,"PRE"))]"" D
54 . . ;"Quit if we already asked this question
55 . . Q:$P(XPDSKPE,U,2)
56 . . S $P(XPDSKPE,U,2)=1
57 . . set Y=$get(Option("DO ENV CHECK"))
58 . . if Y'=1 set XPDSKPE="1^1"
59 . I $G(XPDQUIT) D ABRTALL^TMGXPDI(1,,.Msg) Q
60 . D PKG^TMGXPDL1(XPDA,.Option,.Msg)
61
62 ;"Global Package
63 G:$D(XPDGP) ^XPDIGP
64 I $D(XPDT),$D(^XPD(9.7,+XPDST,0)) do
65 . do AddMsg^TMGPAT2("Use INSTALL NAME: "_$P(^(0),U)_" to install this Distribution.",0,.Msg)
66 . set Option("INSTALL NAME")=$P(^(0),U)
67EnDone
68 Q
69
70
71ST(Option,Msg)
72 ;"Purpose: 'global input'
73 ;"Input: Option -- PASS BY REFERENCE. Entries are required unless marked optional
74 ;" Option("HFSNAME")=FilePathNameOnHFS
75 ;" Option("FORCE CONT LOAD")=1 <-- if not given, then load won't continue
76 ;" Option("INTERACTIVE")=1 if 1 then direct user input asked if needed
77 ;" Msg -- PASS BY REFERENCE, an OUT PARAMETER.
78 ;" Errors are stored in Msg("ERROR",x)=Message
79 ;" Msg("ERROR")=count of last error
80 ;" Message are store in Msg(x)=Message
81 ;" Msg=count of last message+1
82 ;"Results: 1=success, 0=error
83 new result set result=1
84 N DIR,DIRUT,GR,IOP,X,Y,Z,%ZIS
85 I '$D(^%ZIS(1,"B","HFS")) do goto STDone
86 . do AddMsg^TMGPAT2("You must have a device called 'HFS' in order to load a distribution!",1,.Msg)
87 . S XPDQUIT=1
88 D HOME^%ZIS
89 set Y=$get(Option("HFSNAME"))
90 if (Y="")&($get(Option("INTERACTIVE"))=1) do
91 . set DIR("A")="Enter a Host File",DIR("?")="Enter a filename and/or path to input Distribution."
92 . set Y=$$GetFName^TMGIOUTL(DIR("?"),"/tmp/","","","","",DIR("A")_": ")
93 if Y="" do goto STDone
94 . do AddMsg^TMGPAT2("No host file system filename provided!",1,.Msg)
95 . S XPDQUIT=1
96 S %ZIS="",%ZIS("HFSNAME")=Y,%ZIS("HFSMODE")="R",IOP="HFS"
97 D ^%ZIS
98 I POP do
99 . do AddMsg^TMGPAT2("Couldn't open file or HFS device!!",1,.Msg)
100 . set result=0
101 ;"don't close device if we have a global package, we need to bring in the globals now
102 D GI(.Option,.Msg) ;"Get file loaded in
103 do ^%ZISC:'$D(XPDGP)!$G(XPDQUIT)
104STDone
105 if $get(XPDQUIT)=1 set result=0
106 Q result
107
108
109GI(Option,Msg) ;"Get In
110 ;"Purpose: Open file and load in.
111 ;"Input: Option -- PASS BY REFERENCE. Entries are required unless marked optional
112 ;" Option("HFSNAME")=FilePathNameOnHFS
113 ;" Option("FORCE CONT LOAD")=1 <-- if not given, then load won't continue
114 ;" Msg -- PASS BY REFERENCE, an OUT PARAMETER.
115 ;" Errors are stored in Msg("ERROR",x)=Message
116 ;" Msg("ERROR")=count of last error
117 ;" Message are store in Msg(x)=Message
118 ;" Msg=count of last message+1
119
120 N X,XPDSEQ,Y,Z
121 U IO ;"open KIDS text file for input
122 do DoRead(.X,1)
123 do DoRead(.Y,1)
124
125 do AddMsg^TMGPAT2(X,0,.Msg)
126 do AddMsg^TMGPAT2("Comment: "_Y,0,.Msg)
127 S XPDST("H")=Y
128 if Y="Extracted from mail message" do
129 . S XPDST("H1")=X
130 else do
131 . S XPDST("H1")=Y_" ;Created on "_$P(X,"KIDS Distribution saved on ",2)
132 ;"Z is the string of Builds in this file
133 F X=1:1 do Q:Z=""
134 . do DoRead(.Z,1)
135 . S Z=$P(Z,"**KIDS**",2,99)
136 . Q:Z=""
137 . S X(X)=Z
138 U IO(0)
139 I $G(X(1))="" do goto GIDone
140 . do AddMsg^TMGPAT2("This is not a Distribution HFS File!",1,.Msg)
141 . S XPDQUIT=1
142
143 ;"global package, set XPDGP=flag;global^flag;global^... flag=1 replace
144 I $P(X(1),":")="GLOBALS" S XPDGP=$P(X(1),U,2,99),X(1)=$P(X(1),U)
145 S XPDIT=0,X(1)=$P(X(1),":",2,99)
146
147 do AddMsg^TMGPAT2("This Distribution contains Transport Globals for the following Package(s):",0,.Msg)
148 kill XPDQUIT
149 F X=1:1:X-1 do Q:$get(XPDQUIT)=1
150 . F Z=1:1 do Q:(Y="")!($get(XPDQUIT)=1)
151 . . S Y=$P(X(X),U,Z)
152 . . Q:Y=""
153 . . ;"can't install if global exist, that means Build never finish install
154 . . ;"INST will show name
155 . . S XPDIT=XPDIT+1
156 . . new temp set temp=$$INST^TMGXPDL1(Y,.Option,.Msg)
157 . . ;" //kt removed I temp=0 S XPDQUIT=1 Q
158 if $G(XPDQUIT) goto GIDone
159
160 do AddMsg^TMGPAT2("Distribution OK",0,.Msg)
161
162 if $D(XPDGP) do DISP^TMGXPDIG(Msg)
163 if $get(Option("FORCE CONT LOAD"))'=1 do goto GIDone
164 . do AddMsg^TMGPAT2("Option(""FORCE CONT LOAD"")=1 not found in passed options.",1,.Msg)
165 . S XPDQUIT=1
166 do AddMsg^TMGPAT2("Loading Distribution...",0,.Msg)
167
168 ;"reset expiration date to T+7 on transport global
169 S ^XTMP("XPDI",0)=$$FMADD^XLFDT(DT,7)_U_DT
170 ;"start reading the HFS again
171 U IO
172 do DoRead(.X,0)
173 do DoRead(.Y,0)
174 ;"R X:0,Y:0
175 ;"the next read must be the INSTALL NAME
176 I X'="**INSTALL NAME**"!'$D(XPDT("NM",Y)) do goto GIDone
177 . do AddMsg^TMGPAT2("ERROR in HFS file format!",1,.Msg)
178 . S XPDQUIT=1
179
180 ;"XPDSEQ is the disk sequence number
181 S %=XPDT("NM",Y)
182 set GR="^XTMP(""XPDI"","_+XPDT(%)_","
183 set XPDSEQ=1
184 ;"X=global ref, Y=global value.
185 F do DoRead(.X,0) Q:X="**END**" D I $D(DIRUT) S XPDQUIT=1 Q
186 . do DoRead(.Y,0)
187 . I X="**INSTALL NAME**" D Q
188 . . S %=+$G(XPDT("NM",Y))
189 . . set GR="" ;"//kt added Allows ignoring parts of multipatch not needed
190 . . ;"I '% S DIRUT=1 Q ;"//kt
191 . . I '% Q ;"//kt
192 . . S GR="^XTMP(""XPDI"","_+XPDT(%)_","
193 . if GR'="" S @(GR_X)=Y
194 U IO(0)
195GIDone
196 Q
197
198DoRead(S,timeOut)
199 ;"Purpose: Do Read, but strip trailling #13 if needed.
200 ;"Input: S -- pass by reference, and OUT PARAMETER
201 ;" timeOut -- time out var to pass to READ command
202 ;"Results: none
203 read S:timeOut
204 new l set l=$length(S)
205 new ch set ch=$ascii($extract(S,l))
206 if ch=13 set S=$extract(S,1,l-1)
207 quit
208
209
210NEXTD I ^%ZOSF("OS")'["MSM" U IO(0) W !!,"Error in disk, ABORTING load!!" S XPDQUIT=1 Q
211 N DIR
212 ;"close current device
213 C IO U IO(0)
214 S XPDSEQ=XPDSEQ+1,DIR(0)="E"
215 S DIR("A")="Insert the next diskette, #"_XPDSEQ_", and Press the return key"
216 S DIR("?")="This distribution is continued on another diskette"
217 D ^DIR Q:$D(DIRUT)
218 W " OK",!
219 ;MSM specific code to open HFS
220 O @(""""_IO_""":"_IOPAR) U IO
221 ;"R X:0,Y:0
222 do DoRead(.X,1)
223 do DoRead(.Y,1)
224
225 ;"quit if comments are not the same on each diskette
226 G:Y'=XPDST("H") NEXTQ
227 ;"quit if not the expected sequence, Z is for the blank line
228 ;"R Y:0,Z:0
229 do DoRead(.Y,1)
230 do DoRead(.Z,1)
231 G:Y'=("**SEQ**:"_XPDSEQ) NEXTQ
232 Q
233 ;
234NEXTQ U IO(0) W !!,"This is NOT the correct diskette!! The comment on this diskette is:",!,X,!!
235 S XPDSEQ=XPDSEQ-1
236 G NEXTD
237 ;
238NONE W !!,"**NOTHING LOADED**",!
239 Q
240
241
242USER
243 ;"Purpose: Ask user questions questions before running silent EN1^TMGXPDIL
244
245 new Options
246 new Option,Msg
247 new DIR
248 set DIR("A")="Enter a Host File"
249 set DIR("?")="Enter a filename and/or path to input Distribution."
250 if $get(TMGPATNM)'="" set Y=TMGPATNM ;"allow preset file name
251 set Option("HFSNAME")=$$GetFName^TMGIOUTL(DIR("?"),"/tmp/","","","","",DIR("A")_": ")
252
253 new %
254 set %=2
255 write "Do Environmental check" do YN^DICN write !
256 if %=-1 goto UDone
257 set Option("DO ENV CHECK")=(%=1)
258
259 set %=1
260 write "Force continue load" do YN^DICN write !
261 if %=-1 goto UDone
262 set Option("FORCE CONT LOAD")=(%=1)
263
264 do EN1(.Option,.Msg)
265 if $data(Msg) zwr Msg
266
267UDone
Note: See TracBrowser for help on using the repository browser.