source: WorldVistAEHR/trunk/r/DATABASE_ADMIN_TOOLS-DBA/DBAGO.m@ 1259

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1DBAGO ;DUMP GLOBALS IN ZWR FORMAT
2 ;dump Cache globals to a file in GTM's ZWR format
3 ;mlp 18nov01 New routine
4 ;mlp 07jan02 Update to encode some chars > 127; limit $C args to 256.
5 ; Use LF instead of ! to end lines.
6 ;wb 20Sep02 save each global to a separate file in "/data/" %ZWRSEP
7 ;WB 19OCT03 INTEGRATE $$EXIST FROM EXTERNAL ROUTINE
8 ;wb 04Jan04 Add output directory query
9 ;
10 W !!,"DUMPS GLOBALS IN ZWR FORMAT",!!
11 ; D OUT^%IS Q:$G(IO)="" ;request output dev
12 r !,"Output directory? ",ZOUTDIR
13 D ^%SYS.GSET Q:$G(%G)<1 ;request globals to dump
14 ;
15ASK R !!,"Comment ? ",COM,! I COM?1"?".E D G ASK
16 . W "Enter a comment to save with the file. ",!
17 S H=$H,LF=$C(10),QT="""",C255=$C(255),SKIP=$T(SKIP)
18 S GN=0 F S GN=$O(^UTILITY("GLO",GN)) Q:GN="" D
19 . S GNN="^"_GN
20 . s IOP=GN_".zwr",IOPAR="WNS"
21 . I SKIP[(";"_GNN_";") w "Skipping ",IOP," - in exclusion set",! Q
22 . ;i $$exist(IOP) w "Skipping ",IOP," - already exists",! Q
23 . w "Opening ",IOP,!
24 . d OPEN^%ZISH("OUTFILE",ZOUTDIR,IOP,"W")
25 . I POP W !,"Failed to open" Q
26 . U IO
27 . W COM,LF
28 . W "Cache "_$TR($ZD(H,2)," ","-")_" "_$ZT($P(H,",",2))_" ZWR",LF
29 . s cnt=0
30 . D WALK(GNN)
31 . d CLOSE^%ZISH("OUTFILE")
32 W !,"Done.",!
33 Q
34 ;
35WALK(G) ;walk through global G, convert subscripts and values as necessary, dump out
36 Q:'$D(@G) Q:G["(" ; chk if @G defined, and must be a top-level name
37 I $D(@G)#2 D ; handle case where top-level node has data
38 . S NAME=$NA(@G)
39 . S VAL=$$CGV(@G)
40 . W NAME_"="_VAL,LF
41 F S G=$Q(@G) Q:G="" D ;handle rest of global G
42 . S NAME=$NA(@G)
43 . S NAME=$$RCC(NAME) D
44 . . N P ;Remove initial ""_ or final _""
45 . . S P=$F(NAME,"(") I P,$E(NAME,P,P+2)="""""_" S $E(NAME,P,P+2)=""
46 . . S P=$L(NAME) S:$E(NAME,P-3,P-1)="_""""" $E(NAME,P-3,P-1)=""
47 . S VAL=$$CGV(@G)
48 . W NAME_"="_VAL,LF
49 . s cnt=cnt+1
50 . i cnt#10000=0 u $p w "." u IO
51 Q
52 ;
53RCC(NA) ;Replace control chars in NA with $C( ). Returns encoded string.
54 Q:'$$CCC(NA) NA ;No embedded ctrl chars
55 N OUT S OUT="" ;holds output name
56 N CC S CC=0 ;count ctrl chars in $C(
57 N C ;temp hold each char
58 F I=1:1:$L(NA) S C=$E(NA,I) D ;for each char C in NA
59 . I C'?1C,C'=C255 D S OUT=OUT_C Q ;not a ctrl char
60 . . I CC S OUT=OUT_")_""",CC=0 ;close up $C(... if one is open
61 . I CC D
62 . . I CC=256 S OUT=OUT_")_$C("_$A(C),CC=0 ;max args in one $C(
63 . . E S OUT=OUT_","_$A(C) ;add next ctrl char to $C(
64 . E S OUT=OUT_"""_$C("_$A(C)
65 . S CC=CC+1
66 . Q
67 Q OUT
68 ;
69CGV(V) ;Convert Global Value.
70 ;If no encoding required, then return as quoted string.
71 ;Otherwise, return as an expression with $C()'s and strings.
72 I $F(V,QT) D ;chk if V contains any Quotes
73 . S P=0 ;position pointer into V
74 . F S P=$F(V,QT,P) Q:'P D ;find next "
75 . . S $E(V,P-1)=QT_QT ;double each "
76 . . S P=P+1 ;skip over new "
77 I $$CCC(V) D Q V
78 . S V=$$RCC(QT_V_QT)
79 . S:$E(V,1,3)="""""_" $E(V,1,3)=""
80 . S L=$L(V) S:$E(V,L-2,L)="_""""" $E(V,L-2,L)=""
81 Q QT_V_QT
82 ;
83CCC(S) ;test if S Contains a Control Character or $C(255).
84 Q:S?.E1C.E 1
85 Q:$F(S,$C(255)) 1
86 Q 0
87SKIP ;;^%ZOSF;^CacheTempNodes;^ROUTINE;^TMP;^UTILITY;^XTMP;^XUTL;^mcq;^mterm;^oddDEF;^rINDEX;rINDEXCLASS;^rOBJ;
88
89exist(fn)
90 n %
91 s %=$zu(140,4,fn)
92 q (%=0)
93 ;
Note: See TracBrowser for help on using the repository browser.