Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ZWR1MOD

ZWR1MOD.m

Go to the documentation of this file.
  1. ZWR1MOD ;DUMP GLOBALS IN ZWR FORMAT ;12:48 PM  19 Jan 2011; Compiled November 18, 2007 01:33:38
  1.  ;dump Cache globals to a file in GTM's ZWR format
  1.  ;mlp 18nov01 New routine
  1.  ;mlp 07jan02 Update to encode some chars > 127; limit $C args to 256.
  1.  ;            Use LF instead of ! to end lines.
  1.  ;wb  20Sep02 save each global to a separate file in "/data/" %ZWRSEP
  1.  ;WB  19OCT03 INTEGRATE $$EXIST FROM EXTERNAL ROUTINE
  1.  ;wb  04Jan04 Add output directory query
  1.  ;NEA 9-13-06 Ask if you want to exclude lower case globals
  1.  ;JEG fixed the GSET problem 6-16-07`
  1.  ;RCR Allow pickup of ^%ZIS 3070815
  1.  ;mlp 18nov07 %SYS.GSET uses ^CacheTempJ not ^UTILITY, and other clean-ups.
  1.  W !!,"DUMPS GLOBALS IN ZWR FORMAT",!!
  1.  ; D OUT^%IS Q:$G(IO)=""  ;request output dev
  1.  r !,"Output directory? ",ZOUTDIR
  1.  D ^%SYS.GSET Q:$G(%G)<1    ;request globals to dump (Cache 5.1+)
  1.  ;
  1.  ; Should globals with lower case in their names be excluded?
  1.  NEW GLOYN
  1. ASKLC R !!, "Exclude globals with lower case letters in the name? (N) ",GLOYN
  1.  I GLOYN="" S GLOYN="N" W "N"
  1.  I GLOYN?1"?".E D  G ASKLC
  1.  . W !,"Cache specific globals may contain lower case letters.",!
  1.  . W "You may choose to exclude them if you are exporting the globals ",!
  1.  . W "to use with another M implementation such as GT.M."
  1.  I "YyNn"'[$E(GLOYN) W "   Answer Y, N or ?" G ASKLC
  1.  S CASEFLTR=(GLOYN?1"Y".E)!(GLOYN?1"y".E)
  1.  ;
  1. ASK R !!,"Comment ? ",COM,! I COM?1"?".E D  G ASK
  1.  . W "Enter a comment to save with the file. ",!
  1.  S H=$H,LF=$C(10),QT="""",C255=$C(255),SKIP=$T(SKIP)
  1.  S GN=""
  1.  S ZFLG=0
  1.  S FILE=0
  1.  F  S FILE=$O(^DIC(FILE)) Q:'FILE  I $D(^DIC(FILE,0,"GL")) S X=$P(^("GL"),"^",2),X=$P(X,"("),TMP(X)=""
  1.  F  S GN=$O(^CacheTempJ($J,GN)) Q:GN=""  D
  1.  . I CASEFLTR,GN?.E1L.E Quit
  1.  . S GNN="^"_GN
  1.  . I SKIP[(";"_GNN_";") U $P W GN_"  "_"Skipped",! Q
  1.  . I 'ZFLG s IOP=ZOUTDIR_"\SEARCH.txt",IOPAR="WNS" ;;JEG; Add Path
  1.  . i 'ZFLG,$$exist(IOP) w "Skipping ",IOP," - already exists",! Q
  1.  . I 'ZFLG w "Opening ",IOP,!
  1.  . I 'ZFLG S IO=IOP O IO:("WNS"):10 E  S IO="" ;;JEG;Cache Open
  1.  . I 'ZFLG,$G(IO)="" u $p w "error opening "_IOP,! r "Waiting for user...",junk q
  1.  . ;d OUT^%IS i $G(IO)="" u $p w "error opening "_IOP,! r "Waiting for user...",junk q  ;;JEG;Disabled
  1.  . U $P W GN_$S('$D(TMP(GN)):"  Non-FileMan Global",1:""),!
  1.  . U IO
  1.  . I 'ZFLG W COM,!
  1.  . I 'ZFLG W "Cache "_$TR($ZD(H,2)," ","-")_" "_$ZT($P(H,",",2))_" SEARCH FOR:"_SVAL,!
  1.  . s cnt=0
  1.  . S ZFLG=1
  1.  . D WALK(GNN)
  1.  . ;C IO U $P
  1.  C IO U $P
  1.  W !,"Done.",!
  1.  K FILE,TMP
  1.  Q
  1.  ;
  1. WALK(G) ;walk through global G, convert subscripts and values as necessary, dump out
  1.  Q:'$D(@G)  Q:G["("    ; chk if @G defined, and must be a top-level name
  1.  I $D(@G)#2 D          ; handle case where top-level node has data
  1.  . S NAME=$NA(@G),NAME=$$UP^XLFSTR(NAME)
  1.  . S VAL=$$CGV(@G),VAL=$$UP^XLFSTR(VAL)
  1.  . I NAME'[SVAL,VAL'[SVAL Q
  1.  . W NAME_"=",!,VAL,!
  1.  F  S G=$Q(@G) Q:G=""  D   ;handle rest of global G
  1.  . S NAME=$NA(@G),NAME=$$UP^XLFSTR(NAME)
  1.  . ;S NAME=$$RCC(NAME) D
  1.  . . N P                      ;Remove initial ""_ or final _""
  1.  . . S P=$F(NAME,"(") I P,$E(NAME,P,P+2)="""""_" S $E(NAME,P,P+2)=""
  1.  . . S P=$L(NAME) S:$E(NAME,P-3,P-1)="_""""" $E(NAME,P-3,P-1)=""
  1.  . S VAL=$$CGV(@G),VAL=$$UP^XLFSTR(VAL)
  1.  . I NAME'[SVAL,VAL'[SVAL Q
  1.  . W NAME_"=",!,VAL,!
  1.  . Q
  1.  . s cnt=cnt+1
  1.  . i cnt#10000=0 u $p w "." u IO
  1.  Q
  1.  ;
  1. RCC(NA) ;Replace control chars in NA with $C( ). Returns encoded string.
  1.  Q:'$$CCC(NA) NA                         ;No embedded ctrl chars
  1.  N OUT S OUT=""                          ;holds output name
  1.  N CC S CC=0                             ;count ctrl chars in $C(
  1.  N C                                     ;temp hold each char
  1.  F I=1:1:$L(NA) S C=$E(NA,I) D           ;for each char C in NA
  1.  . I C'?1C,C'=C255 D  S OUT=OUT_C Q      ;not a ctrl char
  1.  . . I CC S OUT=OUT_")_""",CC=0          ;close up $C(... if one is open
  1.  . I CC D
  1.  . . I CC=256 S OUT=OUT_")_$C("_$A(C),CC=0  ;max args in one $C(
  1.  . . E  S OUT=OUT_","_$A(C)              ;add next ctrl char to $C(
  1.  . E  S OUT=OUT_"""_$C("_$A(C)
  1.  . S CC=CC+1
  1.  . Q
  1.  Q OUT
  1.  ;
  1. CGV(V) ;Convert Global Value.
  1.  ;If no encoding required, then return as quoted string.
  1.  ;Otherwise, return as an expression with $C()'s and strings.
  1.  I $F(V,QT) D     ;chk if V contains any Quotes
  1.  . S P=0          ;position pointer into V
  1.  . F  S P=$F(V,QT,P) Q:'P  D  ;find next "
  1.  . . S $E(V,P-1)=QT_QT        ;double each "
  1.  . . S P=P+1                  ;skip over new "
  1.  I $$CCC(V) D  Q V
  1.  . S V=$$RCC(QT_V_QT)
  1.  . S:$E(V,1,3)="""""_" $E(V,1,3)=""
  1.  . S L=$L(V) S:$E(V,L-2,L)="_""""" $E(V,L-2,L)=""
  1.  Q QT_V_QT
  1.  ;
  1. CCC(S) ;test if S Contains a Control Character or $C(255).
  1.  Q:S?.E1C.E 1
  1.  Q:$F(S,$C(255)) 1
  1.  Q 0
  1. SKIP ;;^CacheTemp;^ROUTINE;^mtemp;^mtemp0;^mtemp1;^oddCOM;^oddDEF;^oddMAC;^oddMAP;^oddPROC;^rINC;^rOBJ;^%utility;^%UTILITY;^TMP;^XUTL;^UTILITY;
  1. exist(fn) 
  1.  n %
  1.  s %=$zu(140,4,fn)
  1.  q (%=0)
  1.  ;