JRNSWTCH	;Switch journalling - HYY196 08/21/98  ; Compiled March 6, 2000 19:36:09
	; +--------------------------------------------------------+
	; | Copyright 1986-2000 by InterSystems Corporation,       |
	; | Cambridge, Massachusetts, U.S.A.                       |
	; | All rights reserved.                                   |
	; |                                                        |
	; | Confidential, unpublished property of InterSystems.    |
	; |                                                        |
	; | This media contains an authorized copy or copies       |
	; | of material copyrighted by InterSystems and is the     |
	; | confidential, unpublished property of InterSystems.    |
	; | This copyright notice and any other copyright notices  |
	; | included in machine readable copies must be reproduced |
	; | on all authorized copies.                              |
	; +--------------------------------------------------------+
	;%system.INC ; DAS280 06/29/99 
	;%ST.INC DAS309 11/08/99 
	; %system.inc: compiled for NETWIDENAMESPACE
	; %system.inc: compiled for DDPGROUPS
	; %system.inc: compiled for NETMOREDCPDMN
	; %system.inc: compiled for USECLUSTER
	; %system.inc: compiled for RTNINGBL
	; %system.inc: compiled for DBMSNSP
	; the user is given an option to reset current directory (to which
	; journalling will go) and an alternate directory.
	n oldfile,curdir,altdir,err
	s oldfile=$$curfile()
	i oldfile="" w !,"Not journaling now.  Please use JRNSTART." q
	S curdir=$$basename(oldfile)
	S altdir=$G(^%SYS("JOURNAL","ALTDIR"))
	D ASKSET("Current journal directory:",.curdir)        
	D ASKSET("Alternate journal directory:",.altdir)
	s switched=$$INT(curdir,altdir,.err,0)
	i 'switched w !,"Problems during journal switch. Journaling not switched."
	w:$g(err)'="" !,"ERROR: ",err  ;there may still be an error even if switched        
	q
INT(curdir,altdir,err,io)	
	s $zt="etINT"
	n switched,oldfile,newfile,glo s switched=0,oldfile=$$curfile()
	i $d(io),$e(io)="^" s glo=io k io ;ideally I should try a SET on glo
	i $g(curdir)="" s curdir=$$basename(oldfile) 
	i $g(altdir)="" s altdir=curdir
	d FIXDIR(.curdir),FIXDIR(.altdir)
	i '$$VALIDIR(curdir)!'$$VALIDIR(altdir) s err=(-4_","_$$dirinvalidmsg(curdir,altdir)) q 0
	s $zt="etINT1"
	L +^%SYS("JOURNAL"):1  e  s err=(-2_",unable to lock "_$s(""="":"^%SYS(""JOURNAL"")",1:"")) q 0
	i '$zu(78,22) s err=(-3_",Not journaling") L -^%SYS("JOURNAL") q 0
	; a sanity check to make sure last journal history START record is complete
	i +$g(^%SYS("JOURNAL")) d  ;journal started, but record incomplete
	. d log^JRNSTART(),loginfo("Last journal history log is completed with "_$name(^%SYS("TMPJRN")))
	s switched=$zu(78,1,curdir,altdir,0,0)
	i switched s newfile=$$curfile() d log d
	. d loginfo("Switching from: "_oldfile)
	. d loginfo("To:             "_newfile)
	L -^%SYS("JOURNAL")
	q switched
etINT1	;
	s $zt=""
	L -^%SYS("JOURNAL")  ;fall through etINT
etINT	
	s $zt=""
	s err=(-1_","_$ze)
	q switched
log	
	d History^JRNUTIL("SWITCH",oldfile,newfile)
	d HISTORY^JRNUTIL("SWITCH",newfile,curdir,altdir)
	d PURGE^JRNPRG                                                          ;KLMxxx
	i $d(^%SYS("JOURNAL","a"))  ;to get naked indicator right
	s ^("CURRENT")=$P(^("LAST"),"^")_"^"_newfile
	s ^("LAST")=^("CURRENT")
	S curdir=$$basename(newfile) ;HYY062 -- curdir could be altdir
	S:^("CURDIR")'=curdir ^("CURDIR")=curdir
	S:^("ALTDIR")'=altdir ^("ALTDIR")=altdir
	s ^%SYS("JOURNAL")=0    ;log complete
	q
curfile()	S $zt="etcurfile" Q $p($zu(78,4)_","_$zu(78,3),",",2)
etcurfile	Q ""
loginfo(msg)	;must be called from within INT (JRNSTART, JRNSWTCH)
	i $d(glo) s @glo=$g(@glo)+1,@glo@(@glo)=msg
	i $d(io) u io w !,msg
	q
YN(P,D,t)	N R,X S P=$G(P),D=$E($G(D)_"?"),t=$G(t) ;ask Yes/No w/ Prompt,Default
	S D=$S("Yy"[D:"Yes => ","Nn"[D:"No => ",1:"") ;Yes, No or no default
	F  W !,P_"? "_D Read:t R:t Read:'t R DO  I "^YN"[R Q  ;timed or non-timed read
	. S X=R,R=$TR($E(R_D_"?"),"yn","YN") I "^YN"'[R W "  enter Yes or No, please"
	S POP=(R="^") W $E($S(R="N":"No",R="Y":"Yes",1:""),$L(X)+1,3) Q R
	; BITWISE.INC, DPB139 07/09/93
FIXDIR(dir)	;procedure, dir is passed by reference
	Q:dir=""
	i ($zv["VMS") d
	. n x
	. s x=$$ChkDirVALID(dir)
	. i x'="" s dir=x
	i '($zv["VMS") Q:$A(dir,$L(dir))=$A($s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:""))
	i '($zv["VMS") s dir=dir_$s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:"")
	Q
fixdir(dir)	;function
	Q:dir="" ""
	i ($zv["VMS") d  q dir
	. n x
	. s x=$$ChkDirVALID(dir)
	. i x'="" s dir=x
	Q:$A(dir,$L(dir))=$A($s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:"")) dir
	Q dir_$s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:"")
basename(f)	;similar to basename on UNIX
	Q $P(f,$s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:""),1,$L(f,$s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:""))-1)_$s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:"")
appdir(d1,d2)	;use $zu(12,d2) to append d2 to canonic dir
	i ($zv["VMS") S $E(d1,$L(d1))="."_d2_"]"
	i '($zv["VMS") S d1=d1_d2
	Q d1
VALIDIR(dir)	;validate directory dir and create it if dir doesn't exist
	new flag
	s flag=1
	g vdir2
validir(dir,flag)	;validate directory dir and optionally create it if it
vdir2	; VALIDIR(dir) comes here with flag set to 1
	quit:$$ChkDirOrSpecEXISTS(dir)'="" 1   ; dir is valid and exists
	quit:$$ChkDirVALID(dir)="" 0    ; dir is not valid
	i flag'=1 q 0  ; flag says don't create, return failure
	new x
	set x=$$mkdir(dir)  ; returns 0 for success, 1 for failure
	q:x=1 0  ; failed to create
	quit:$$ChkDirOrSpecEXISTS(dir)="" 0   ; it doesn't we failed
	q 1  ; success
mkdir(dir)	;create a new directory
	i '($zv["VMS") Q $ZF(-1,"mkdir "_$S($E(dir)=""""!($F(dir," ")=0):dir,1:""""_dir_""""))
	q:$$ChkDirVALID(dir)="" 1  ; dir is invalid, return failure
	n res
	s res=$ZF(-1,"create/directory "_dir)
	q '+($ZBOOLEAN(+(res),+(1),1)) 
jrnshort(jf,short)	;get/set short form of a journal file name
	N (jf,short)
	S len=$L($P(jf,";"))
	Q:$G(short)="" $E(jf,len-11,len) ;"GET" form
	S $E(jf,len-11,len)=short ;"SET" form
	Q jf
GJrnPrefix(jf)	;extract prefix from the journal file name jf
	N (jf)
	S fname=$P(jf,$s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:""),$L(jf,$s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:"")))       
	i '($zv["VMS") Q $E(fname,1,$L(fname)-12)
	S fname=$P(fname,";")
	Q $E(fname,1,$L(fname)-12)
dirinvalidmsg(dir1,dir2)	
	n valid1,valid2,cnt,msg
	s valid1=$$VALIDIR(dir1),valid2=$$VALIDIR(dir2)
	s cnt=valid1+valid2 ; cnt = 0 if both invalid, 1 if one is valid
	s msg="The following journaling "
	s:cnt msg=msg_"directory is" 
	s:'cnt msg=msg_"directories are"
	s msg=msg_" not valid"_$C(13,10)
	s:'valid1 msg=msg_"     "_dir1_$C(13,10)
	s:'valid2 msg=msg_"     "_dir2_$C(13,10)
	q msg
ChkDirVALID(R)	N N S $ZE="",$ZT="ChkBad",N=$ZU(12,R,1) Q N
ChkDirEXISTS(R)	N N S $ZE="",$ZT="ChkBad",N=$ZU(12,R,2) Q N
ChkDirOrSpecEXISTS(R)	N N S $ZE="",$ZT="ChkBad",N=$ZU(12,R,3) Q N
ChkDir(R)	N N S $ZE="",$ZT="ChkBad",N=$ZU(12,R,2) Q N
ChkBad	S $ZT="" W !,"<"_$P($P($ZE,"<",2),">")_"> error -- invalid directory"
	Q ""
ASKSET(prompt,val)	;procedure
	N x
	W !,$G(prompt)," ",$G(val)," =>" R x,!
	S:x'="" val=x
	Q