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/XPDZHFS.m@ 1693

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

initial load of WorldVistAEHR

File size: 4.6 KB
RevLine 
[613]1XPDZHFS ;WV/TOAD-KIDS HFS Tools ;11/30/2005 15:42
2 ;;8.0;KERNEL;**L34**;Jul 10,1995
3 ;
4 ; This routine is a development toolkit for a new KIDS option that
5 ; compares the checksums for routines being brought in by a patch to
6 ; those currently installed on the system. It contains subroutines
7 ; used during development to try out APIs and draft preliminary
8 ; steps toward the final draft. These are all programmer-mode tools,
9 ; none supported.
10 ;
11 ; calls
12 ; this routine and XPDZSUM call each other
13 ;
14 ; history
15 ;
16 ; 2005 11 29 Rick Marshall developed this to try out algorithms for
17 ; routine XPDZSUM
18 ; 2005 11 30 Rick Marshall finished the experiments and moved the
19 ; relevant subroutines back to XPDZSUM
20 ;
21 ; contents
22 ;
23 ; ISHEAD. return whether a line is a routine table header line
24 ; DRIVEIH. test ISHEAD
25 ; PRINTDIR. list the files in a directory (PATH)
26 ; DRIVEPD. test PRINTDIR
27 ; DIRSUMS. find checksums & patch lists in a KIDS directory
28 ; DRIVEDS. test DIRSUMS
29 ;
30 ;
31ISHEAD(LINE,DEBUG) ; given a line from a KIDS description, return whether it
32 ; is the header line of a routine checksum table
33 ;
34 ; I1. quickly screen out poor candidates
35 ;
36 I LINE'[" " Q 0 ; unless there are columns, it's not a header line
37 S LINE=$$UP^XLFSTR(LINE) ; convert to upper case
38 ; better be checksums:
39 I LINE'["CHECKSUM",LINE'["BEFORE",LINE'["OLD",LINE'["CHKSUM" Q 0
40 I LINE["(V)" Q 0 ; associated patches lines contain "BEFORE"
41 I LINE["CHECK^XTSUMBLD" Q 0 ; extra header line contains "CHECKSUM"
42 I LINE["VERIFY CHECKSUMS IN TRANSPORT GLOBAL" Q 0 ; install step line
43 ;
44 ; I2. extract columns
45 ;
46 N COLUMNS S COLUMNS=$$COLUMNS^XPDZSUM(LINE) ; extract columns
47 N LENGTH S LENGTH=$L(COLUMNS,U) ; how many columns?
48 I $G(DEBUG) W !,LENGTH ; for debugging
49 I LENGTH<2!(LENGTH>4) Q 0 ; unless there are 2-4 columns, it's not
50 ;
51 S COLUMNS=$TR(COLUMNS," AEIOUC") ; condense by extracting spaces, vowels, & C
52 ; C because of all the variations of CHCKSUM/CHKSUM
53 N R S R=$P(COLUMNS,U) ; routine name
54 N B S B=$P(COLUMNS,U,2) ; checksum before patch
55 N A S A=$P(COLUMNS,U,3) ; checksum after patch
56 N P S P=$P(COLUMNS,U,4) ; patch list after patch
57 I LENGTH=2 S A=B,B="" ; if only two columns, it's name and after
58 ; rarely, 3 cols is after & patch list:
59 I LENGTH=3,A="PTHLST"!(A="2NDLN") S P=A,A=B,B=""
60 ;
61 W !,R,?12,B,?27,A,?42,P ; for debugging
62 ;
63 ; I3. decide whether they look like routine table header columns
64 ;
65 N HEADER S HEADER=0 ; assume it is not a header line
66 D ; change that to no unless a pattern is met
67 . ;
68 . I "^NM^RTN^RTNNM^RNT^NM^RNTNM^PRGRM^"'[(U_R_U) D Q ; routine name
69 . . I $G(DEBUG) W "R: [",R,"] ",$L(R)
70 . I "^BFR^LD^HKSM^HKSMBFR^BFRPTH^^BFRHKSM^"'[(U_B_U) D Q
71 . . I $G(DEBUG) W "B: [",B,"] ",$L(B)
72 . I "^FTR^NW^HKSM^HKSMFTR^^FTRPTH^NWHKSM^FTRHKSM^"'[(U_A_U) D Q
73 . . I $G(DEBUG) W "A: ",A,"[ ",$L(A)
74 . I "^PTHLST^2NDLN^NDTR^LST^^"'[(U_P_U) D Q ; patch list after patch
75 . . I $G(DEBUG) W "P: ",P,"[ ",$L(P)
76 . ;
77 . S HEADER=1
78 ;
79 QUIT HEADER ; end of ISHEAD, return answer
80 ;
81 ;
82DRIVEIH ; test ISHEAD
83 ;
84 N LINE S LINE=" Routine ChkSum 2nd Line"
85 N ISHEAD S ISHEAD=$$ISHEAD(LINE,1)
86 W !!,ISHEAD
87 QUIT ; end of DRIVEIH
88 ;
89 ;
90PRINTDIR(PATH) ; list the files in a directory (PATH)
91 ;
92 ; P1. transfer directory listing to ^TMP
93 ;
94 K ^TMP("XPDZHFS")
95 D
96 . N FILES S FILES("*")=""
97 . N ROOT S ROOT=$NA(^TMP("XPDZHFS",$J))
98 . N SUCCESS S SUCCESS=$$LIST^%ZISH(PATH,"FILES",ROOT)
99 ;
100 ; P2. print directory listing
101 ;
102 N FILE S FILE="" F D Q:FILE=""
103 . S FILE=$O(^TMP("XPDZHFS",$J,FILE)) Q:FILE=""
104 . W !,FILE
105 ;
106 QUIT ; end of PRINTDIR
107 ;
108 ;
109DRIVEPD ; test PRINTDIR
110 ;
111 D PRINTDIR("c:\voe\patches\XU\")
112 QUIT ; end of DRIVEPD
113 ;
114 ;
115DIRSUMS(PATH,START) ; find checksums & patch lists in a KIDS directory
116 ;
117 ; P1. transfer directory listing to ^TMP
118 ;
119 K ^TMP("XPDZHFS","DIRSUMS")
120 D
121 . N FILES S FILES("*")=""
122 . N ROOT S ROOT=$NA(^TMP("XPDZHFS","DIRSUMS",$J))
123 . N SUCCESS S SUCCESS=$$LIST^%ZISH(PATH,"FILES",ROOT)
124 ;
125 ; P2. print listing of KIDS description files
126 ;
127 N FILE S FILE=$G(START) F D Q:FILE=""
128 . S FILE=$O(^TMP("XPDZHFS","DIRSUMS",$J,FILE)) Q:FILE=""
129 . N UP S UP=$$UP^XLFSTR(FILE)
130 . Q:UP'?1.AN1"-"1.(1N,1"P")1"_SEQ-"1.N1"_PAT-"1.N1".TXT"
131 . ; e.g., XU-8_SEQ-133_PAT-152.txt
132 . W !!?12,FILE,": ",!
133 . D FINDSUMS^XPDZSUM(PATH,FILE)
134 . ;
135 . ; P3. prompt after each listing to allow check/escape
136 . ;
137 . N Y D I 'Y S FILE="" Q ; allow escape
138 . . N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X
139 . . S DIR(0)="EA" ; end-of-page read
140 . . S DIR("A")=""
141 . . D ^DIR ; FileMan Reader
142 ;
143 QUIT ; end of DIRSUMS
144 ;
145 ;
146DRIVEDS ; test DIRSUMS
147 ;
148 D DIRSUMS("c:\voe\patches\XU\","")
149 QUIT ; end of DRIVEDS
150 ;
151 ;
152 ; end of routine XPDZSUM
Note: See TracBrowser for help on using the repository browser.