source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDZSUM.m@ 1076

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

initial load of WorldVistAEHR

File size: 8.8 KB
Line 
1XPDZSUM ;WV/TOAD-KIDS check Before checksums ;12/01/2005 10:40
2 ;;8.0;KERNEL;**L34**;Jul 10,1995
3 ;
4 ; This routine is the prototype for a new KIDS option that compares the
5 ; checksums for routines being brought in by a patch to those currently
6 ; installed on the system. It parses the patch description, extracts
7 ; the checksums from the table and records them in the Checksum subfile
8 ; of the Patch Record file (437016). It then uses ^%ZOSF("RSUM") to
9 ; compare the before values and warn of any potential collisions. It
10 ; also records the patch list for each routine and records that, too, in
11 ; the Checksum subfile, and compares it to the current routine's
12 ; patch list.
13 ;
14 ; history
15 ;
16 ; 2005 11 29 Rick Marshall wrote outline, then shifted to routine
17 ; XPDZHFS to explore the algorithm
18 ; 2005 11 30 Rick Marshall complete algorithm exploration, copied
19 ; relevant code back to this routine, then worked on the
20 ; checksum and patch list extract and compare
21 ; 2005 12 01 Rick Marshall continues refining the extract & compare
22 ;
23 ; contents
24 ;
25 ; 1. prompt for KIDS text file
26 ; 2. load description into ^TMP($J)
27 ; 3. find routine table
28 ; 4. extract checksums and patch list
29 ; ; 5. file them in the Checksum subfile
30 ; ; 6. clear ^TMP($J)
31 ; 5. compare to current routines
32 ;
33 ; XPDZSUM contents
34 ;
35 ; FINDSUMS. find checksums & patch lists in a KIDS description file
36 ; DRIVEFS. test FINDSUMS
37 ; ISHEAD. return whether a line is a routine table header line
38 ; DRIVEIH. test ISHEAD
39 ; COLUMNS. extract column values from floating multi-space delimiters
40 ; DRIVEC. test COLUMNS
41 ;
42 ;
43FINDSUMS(PATH,FILE) ; find checksums & patch lists in a KIDS description file
44 ; PATH_FILE = KIDS description file, input to $$FTG^%ZISH in F1
45 ;
46 ; called by DRIVEFS (tester), DIRSUMS^XPDZHFS
47 ; calls $$FTG^%ZISH, $$UP^XLFSTR, ANALYZE, $$COLUMNS
48 ;
49 ; FINDSUMS contents
50 ;
51 ; F1. transfer KIDS description file to ^TMP
52 ; F2. traverse description
53 ; F3. find routine table in description
54 ; F4. find end of routine table
55 ; F5. extract and display columns from the row
56 ; F6. compare before checksum & patch list to current routine
57 ;
58 ; F1. transfer KIDS description file to ^TMP
59 ;
60 K ^TMP("XPDZHFS",$J)
61 D
62 . N ROOT S ROOT=$NA(^TMP("XPDZHFS",$J,1,0))
63 . N SUB S SUB=3
64 . N SUCCESS S SUCCESS=$$FTG^%ZISH(PATH,FILE,ROOT,SUB)
65 . ; Device Handler: transfer a file to a global
66 ;
67 ; F2. traverse description
68 ;
69 N TABLE S TABLE=0 ; whether line is part of routine table
70 N ROUTINES ; to routine lines in table
71 N TYPE S TYPE=0 ; what type of routine table is this? (see ANALYZE)
72 N NUM S NUM=0 F D Q:'NUM
73 . S NUM=$O(^TMP("XPDZHFS",$J,NUM)) Q:'NUM
74 . ; W !,NUM,?5
75 . N LINE S LINE=$G(^TMP("XPDZHFS",$J,NUM,0))
76 . N UP S UP=$$UP^XLFSTR(LINE) ; Kernel: XLF library: upper case
77 . ;
78 . ; F3. find routine table in description
79 . ;
80 . I 'TABLE D Q:'TABLE ; find routine table header line
81 . . N ISHEAD ; whether it is a table header line
82 . . D ANALYZE(LINE,.ISHEAD,.TYPE) ; analyse the line
83 . . Q:'ISHEAD ; skip each line until we find the table
84 . . S TABLE=1 ; we have entered the routine table
85 . . S ROUTINES=-1 ; we have not yet seen the first routine lines
86 . I $TR(UP," -_=")'="" S ROUTINES=ROUTINES+1 ; count non-null table lines
87 . ; header line does not count (moves from -1 to 0)
88 . Q:'ROUTINES ; the rest of the loop only applies to routine lines
89 . ;
90 . ; F4. find end of routine table
91 . ;
92 . S TABLE=0 D Q:'TABLE ; assume it's the end, pass screens to continue
93 . . ; after first non-null routine line, next blank line is end:
94 . . Q:$TR(UP," -_=")="" ; I am concerned about whether this is too tight
95 . . Q:UP["LIST OF PRECEDING PATCHES"
96 . . Q:UP["NO ROUTINE"
97 . . Q:UP["CHECK^XTSUMBLD"
98 . . Q:UP["NOTE: "!(UP["NOTE ")
99 . . Q:UP["INSTALLATION"
100 . . S TABLE=1
101 . ;
102 . ; F5. extract and display columns from the row
103 . ;
104 . N COLUMNS S COLUMNS=$$COLUMNS(LINE) ; extract the columns
105 . ;
106 . N R S R=$P(COLUMNS,U) ; all four types start with routine
107 . W !?3,R ; routine
108 . ;
109 . N B,A,P S (B,P)="" ; order varies on the other 3 fields
110 . ;
111 . I TYPE>2 D ; for types 3 and 4, the before comes next
112 . . S B=$P(COLUMNS,U,2)
113 . . S A=$P(COLUMNS,U,3)
114 . . I TYPE=4 S P=$P(COLUMNS,U,4)
115 . E D ; for types 1 and 2, no before, after comes next
116 . . S A=$P(COLUMNS,U,2)
117 . . I TYPE=1 S P=$P(COLUMNS,U,3)
118 . ;
119 . W ?13,B,?28,A,?43,P ; sum before, sum after, patch list
120 . ;
121 . ; F6. compare before checksum & patch list to current routine
122 . ;
123 ;
124 QUIT ; end of FINDSUMS
125 ;
126 ;
127DRIVEFS ; test FINDSUMS
128 ;
129 D FINDSUMS("c:\voe\patches\XU\","XU-8_SEQ-120_PAT-135.TXT")
130 QUIT ; end of DRIVEFS
131 ;
132 ;
133ANALYZE(LINE,ISHEAD,TYPE,DEBUG) ; analyze a line from a KIDS description
134 ;
135 ; .ISHEAD = 1 if it is the routine table header line, else 0
136 ; .TYPE = set of codes: which type of routine table is it:
137 ; 1 = routine checksum after patch list
138 ; 2 = routine checksum after
139 ; 3 = routine checksum before checksum after
140 ; 4 = routine checksum before checksum after patch list
141 ;
142 ; and not yet handled:
143 ; 5 = routine sum & patches before sum & patches after
144 ; 6 = none (may have routines; consider how to handle later)
145 ; 7 = none (informational)
146 ; DEBUG (optional) = 1 to make ANALYZE write debugging info
147 ;
148 ; I1. quickly screen out poor candidates
149 ;
150 S ISHEAD=0 ; assume it is not a header line
151 I LINE'[" " Q ; unless there are columns, it's not a header line
152 S LINE=$$UP^XLFSTR(LINE) ; convert to upper case
153 ; better be checksums:
154 I LINE'["CHECKSUM",LINE'["BEFORE",LINE'["OLD",LINE'["CHKSUM" Q
155 I LINE["(V)" Q ; associated patches lines contain "BEFORE"
156 I LINE["CHECK^XTSUMBLD" Q ; extra header line contains "CHECKSUM"
157 I LINE["VERIFY CHECKSUMS IN TRANSPORT GLOBAL" Q ; install step line
158 ;
159 ; I2. extract columns
160 ;
161 N COLUMNS S COLUMNS=$$COLUMNS(LINE) ; extract columns
162 N LENGTH S LENGTH=$L(COLUMNS,U) ; how many columns?
163 I $G(DEBUG) W !,LENGTH ; for debugging
164 I LENGTH<2!(LENGTH>4) Q ; unless there are 2-4 columns, it's not
165 S TYPE=6 ; assume the routine table requires special handling
166 ;
167 S COLUMNS=$TR(COLUMNS," AEIOUC") ; condense: extract spaces, vowels, C
168 ; C because of all the variations of CHCKSUM/CHKSUM
169 ;
170 N R S R=$P(COLUMNS,U) ; routine name
171 N B S B=$P(COLUMNS,U,2) ; checksum before patch
172 N A S A=$P(COLUMNS,U,3) ; checksum after patch
173 N P S P=$P(COLUMNS,U,4) ; patch list after patch
174 ;
175 I LENGTH=2 D ; if only two columns, it's name and checksum after
176 . S A=B,B="" ; set checksum after and clear before
177 . S TYPE=2
178 E I LENGTH=3 D ; two different types have three columns
179 . S TYPE=3 ; assume it is name, before, and after
180 . I "^PTHLST^2NDLN^NDTR^LST^^"'[(U_A_U) D ; if patch list, it's type 1
181 . . S P=A,A=B,B="" ; set after & patches, clear before
182 . . S TYPE=1
183 E S TYPE=4 ; the preferred type, all four columns
184 ;
185 I $G(DEBUG) W !?3,R,?13,B,?28,A,?43,P ; for debugging
186 ;
187 ; I3. decide whether they look like routine table header columns
188 ;
189 D ; change that to no unless a pattern is met
190 . ;
191 . I "^NM^RTN^RTNNM^RNT^NM^RNTNM^PRGRM^"'[(U_R_U) D Q ; routine name
192 . . I $G(DEBUG) W "R: [",R,"] ",$L(R)
193 . I "^BFR^LD^HKSM^HKSMBFR^BFRPTH^^BFRHKSM^"'[(U_B_U) D Q
194 . . I $G(DEBUG) W "B: [",B,"] ",$L(B)
195 . I "^FTR^NW^HKSM^HKSMFTR^^FTRPTH^NWHKSM^FTRHKSM^"'[(U_A_U) D Q
196 . . I $G(DEBUG) W "A: ",A,"[ ",$L(A)
197 . I "^PTHLST^2NDLN^NDTR^LST^^"'[(U_P_U) D Q ; patch list after patch
198 . . I $G(DEBUG) W "P: ",P,"[ ",$L(P)
199 . ;
200 . S ISHEAD=1
201 Q:'ISHEAD
202 ;
203 ; I4. display canonical header
204 ;
205 W !,TYPE
206 W ?3,"routine"
207 I TYPE>2 W ?13,"sum before"
208 W ?28,"sum after"
209 I TYPE=1!(TYPE=4) W ?48,"patch list"
210 ;
211 QUIT ; end of ANALYZE
212 ;
213 ;
214DRIVEA ; test ANALYZE
215 ;
216 N LINE S LINE=" Routine ChkSum 2nd Line"
217 N ISHEAD
218 D ISHEAD(LINE,.ISHEAD,.TYPE,1)
219 W !!,ISHEAD
220 QUIT ; end of DRIVEIH
221 ;
222 ;
223COLUMNS(LINE) ; extract column values from floating multi-space delimiters
224 ; given a free text line containing floating columns of data
225 ; delimited by multiple spaces (2 or more), extract the columns and
226 ; return them ^-delimited. This could later be extended to choose the
227 ; delimiters (instead of spaces and ^s).
228 ;
229 ; we need to extend this tool to handle empty columns
230 ;
231 N COLUMNS S COLUMNS="" ; return value
232 S LINE=$$TRIM^XLFSTR(LINE,"LR") ; trim leading & trailing spaces
233 N COUNT ; count columns extracted
234 F COUNT=1:1 Q:LINE="" D ; continue until LINE reduced to empty
235 . N COLUMN S COLUMN=$P(LINE," ") ; copy first column
236 . S $P(COLUMNS,U,COUNT)=COLUMN ; place it into the return value
237 . S $P(LINE," ")="" ; remove it from LINE
238 . S LINE=$$TRIM^XLFSTR(LINE,"L") ; remove leading spaces from LINE
239 ;
240 QUIT COLUMNS ; end of COLUMNS, return extracted column values
241 ;
242 ;
243DRIVEC ; test COLUMNS
244 ;
245 N LINE S LINE=" Routine Old New 2nd Line "
246 W !,"Before: ",LINE
247 W !!,"After: ",$$COLUMNS(LINE)
248 QUIT ; end of DRIVEC
249 ;
250 ;
251 QUIT ; end of routine XPDZSUM
Note: See TracBrowser for help on using the repository browser.