;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;								;
	;	Copyright 2005, 2010 Fidelity Information Services, Inc	;
	;								;
	;	This source code contains the intellectual property	;
	;	of its copyright holder(s), and is made available	;
	;	under a license.  If you do not know the terms of	;
	;	the license, please stop and do not read further.	;
	;								;
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;
	; If invoked as "mumps -run v5cbsu", this is the V5 Certify Block Split Utility
	;	Reads scan phase output file from DBCERTIFY and processes level-0 GVT blocks.
	;	Rewrites the scan phase output file minus those blocks.
	;
	; If invoked as "mumps -run dump^v5cbsu", this is the DBCERTSCAN file dump utility.
	;	Reads scan phase output file from DBCERTIFY and prints the contents of the
	;	records that it finds. Does not touch the database or the scan file.
	;	Only dumps the contents.
	; On OpenVMS, "define gtm_v5cbsu dump" to invoke the dump utility.
	;
	; On OpenVMS, "define gtm_v5cbsu fix512" to remove zero padding
	; which may have been added during dbcertify scan runs on some
	; OpenVMS 7.3-1 systems.  This produces an output file with a
	; suffix of _FIX512 to be used as input to v5cbsu (after
	; deassigning gtm_v5cbsu) or dbcertify certify.  Both "dump" and
	; "fix512" can be specified in the value of gtm_v5cbsu for the same run.
	;
	; Note that our input and output files contain binary data in the file and
	; record headers. GT.M I/O does not deal with this type of data well so these binary
	; stream files are treated as fixed record length files so far as GT.M is concerned
	; and we do our own buffering of the read and write IOs. This is basically the same
	; approach that GDE uses.
	;
	; If additional M utility routines are used by V5CBSU.m, remember
	; to modify the gtmdckitinstal.com section which creates GTMDCBUILD.COM
	; and any OpenVMS test system scripts which link V5CBSU.
	;
v5cbsu
	If ($data(dumpmode)=0) set dumpmode=0
	Set p1outfile=$ZCMDLINE
	If p1outfile="" Use $P Write "Must specify the name of the SCAN phase output file",! Halt
	D init
	Do doopen(.p1outfile,readflg)
	D readp1hd
	If p1tag'=p1tagread  Do  Quit
	. Use $P
	. Write "%GTM-E-DBCBADFILE, Source file ",p1outfile
	. Write " does not appear to have been generated by DBCERTIFY SCAN - rerun SCAN or specify correct file",!
	set quitnow=0
	If 'dumpmode&'fix512mode  Do  If quitnow Quit
	. If (0=gvtleafc) Use $P Write "There are no GVT leaf (level 0) blocks to process in this database",! Set quitnow=1 Quit
	. If (version="V4.4-004")!(version]"V4.4-004") View "GVDUPSETNOOP":0
	. Set dbfname=$View("GVFILE",regnameP)
	. If dbfnP'=dbfname  Do  Quit
	. . Use $P
	. . Write "Database for region ",regnameP,"(",dbfname,") does not match the recorded name from the scan phase (",dbfnP,")",!
	. . Set quitnow=1
	. ;
	. ; Process the input file. Any records we do not handle are rewritten to tmpfile1.
	. ;
	. Do doopen(.tmpfile1,writeflg)
	. Set outrecs=0,byprecs=0,prorecs=0,releaf=0
	If fix512mode Do
	. Set tmpfile1=p1outfile_"_FIX512"	; File without zero padding
	. Use $P Write "V5CBSU: FIX512 mode, use "_tmpfile1_" for real v5cbsu or dbcertify certify input",!
	. Do doopen(.tmpfile1,writeflg)
	. Do dowrite(.tmpfile1,p1hdr)	; copy header as is
	If dumpmode Do
	. Use $P
	. Write !!,"Database referenced: ",dbfnP,!
	. ;
	. ; Process the input file.
	. ;
	. Write "  BlkNum   BlkType    BlkLevl   BlkKey",!!
	For rec=1:1:blkcnt Do
	. If $TLevel Use $P Zshow "*" Write "V5CBSU - GTMASSERT: $TLEVEL non zero at top of processing loop",! Halt
	. Do readp1rc(.p1outfile)
	. If dumpmode Do
	. . Use $P
	. . Write $$FUNC^%DH(blknum,8),"   ",blktypes(blktype)," ",$J(blklevl,6),"   "
	. . If akeylen'=0 Write reckey
	. . Write !
	. If fix512mode Do
	. . Set p1rec=p1rec_reckey
	. . Do dowrite(.tmpfile1,p1rec)		; copy record header and key
	. If 'dumpmode&'fix512mode Do
	. . TStart ():TRANSACTION="BATCH" ; BATCH needed to avoid hardening wait in case of journaling
	. . Set processed=0
	. . If ""'=reckey Do
	. . . Set exist=$DATA(@reckey)
	. . . If (1=exist)!(11=exist) Set value=$Get(@reckey) Set @reckey=value  Set processed=1
	. . TCommit
	. . If processed=1 Set prorecs=prorecs+1
	. . Else  Do
	. . . If ""'=reckey Set byprecs=byprecs+1  Set p1rec=p1rec_reckey
	. . . Do dowrite(.tmpfile1,p1rec)
	. . . Set outrecs=outrecs+1
	. . . If gvtleaf=blktype Set releaf=releaf+1	; This is a leaf block we did not process
	;
	; If in dump    mode, close input file and we are done.
	; If in fix512  mode, close input and output file and we are done.
	; If in regular mode, close input and output file. Also open new output file
	;	that will include the fileheader with the correct record count
	;
	Do doclose(.p1outfile)
	If dumpmode&'fix512mode quit
	Do doclose(.tmpfile1)
	If fix512mode Quit
	Set newp1hdr=p1tag_$$num2bin(hdrtn)_$$num2bin(outrecs)_$$num2bin(totblks)_$$num2bin(dtleafc)_$$num2bin(dtindxc)
	Set newp1hdr=newp1hdr_$$num2bin(releaf)_$$num2bin(gvtindxc)_regname_$Char(0)_dbfn_$Char(0)_$$num2bin(uidlen)_uniqueid
	Set $Piece(hdrpad,$C(0),33-$Length(uniqueid)+filBufSz-360)="" ; create zero padding of correct length to fill fixed size hdr
	Set newp1hdr=newp1hdr_hdrpad
	If $Length(newp1hdr)'=p1hdrlen  Do
	. Use $P
	. Zshow "*"
	. Write "V5CBSU - GTMASSERT: New fileheader not expected size. Size is ",$Length(newp1hdr)," - Expecting ",p1hdrlen,!
	. Halt
	Do doopen(.tmpfile1,readflg)
	Do doopen(.tmpfile2,writeflg)
	Do dowrite(.tmpfile2,newp1hdr)
	For recs=1:1:outrecs Do
	. Do readp1rc(.tmpfile1)
	. If ""'=reckey Set p1rec=p1rec_reckey
	. Do dowrite(.tmpfile2,p1rec)
	;
	; New version of dbcertp1 file is written to tmpfile2. Close both files and effect the proper name change.
	;
	Do doclose(.tmpfile1)
	Do doclose(.tmpfile2)
	If VMS Set rename="RENAME" Set renamever=";" Set delete="DELETE" Set delver=".*"
	Else   Set rename="mv"     Set renamever=""  Set delete="rm -f"  Set delver=""
	If 'VMS ZSystem delete_" "_p1outfile_"_orig"	; in VMS multiple versions would be automatically created
	ZSystem rename_" "_p1outfile_renamever_" "_p1outfile_"_orig"_renamever
	ZSystem rename_" "_tmpfile2_renamever_" "_p1outfile_renamever
	ZSystem delete_" "_tmpfile1_delver

	Use $P
	Write "Scan phase records read:      ",blkcnt,!
	Write "Scan phase records bypassed:  ",byprecs,!
	Write "Scan phase records processed: ",prorecs,!
	Write "Scan phase records left:      ",outrecs,!
	Quit

	;
	; Entry point for DUMP mode operation (dump contents of scan file)
	;
dump	;
	set dumpmode=1
	Do v5cbsu
	quit

	;
	; Read in scan phase file header
	;
readp1hd
	Set p1hdr=$$doread(.p1outfile,p1hdrlen)
	Set p1tagread=$Extract(p1hdr,1,8)
	Set hdrtn=$$bin2num($Extract(p1hdr,9,12))
	Set blkcnt=$$bin2num($Extract(p1hdr,13,16))
	Set totblks=$$bin2num($Extract(p1hdr,17,20))
	Set dtleafc=$$bin2num($Extract(p1hdr,21,24))
	Set dtindxc=$$bin2num($Extract(p1hdr,25,28))
	Set gvtleafc=$$bin2num($Extract(p1hdr,29,32))
	Set gvtindxc=$$bin2num($Extract(p1hdr,33,36))
	Set regname=$Extract(p1hdr,37,67)
	; 1 byte of filler we don't care about
	Set dbfn=$Extract(p1hdr,69,323)
	; 1 byte of filler we don't care about
	Set uidlen=$$bin2num($Extract(p1hdr,325,328))
	; Size of field  varys (by platform) length unique id fields (we don't process them)
	Set uniqueid=$Extract(p1hdr,329,329+uidlen-1)
	; Eliminate trailing nulls
	Set regnameP=$Piece(regname,$Char(0),1)
	Set dbfnP=$Piece(dbfn,$Char(0),1)
	; Now that we have a region name, define our temps with regname embedded
	Set tmpfile1="dbcertp1"_regnameP_".tmp1"
	Set tmpfile2="dbcertp1"_regnameP_".tmp2"
	Quit

	;
	; Read in scan phase record (fixed size with optional varying length ascii key following)
	;
readp1rc(outfile)
	Set p1rec=$$doread(.outfile,p1reclen)
	Set tn=$$bin2num($Extract(p1rec,1,4))
	Set blknum=$$bin2num($Extract(p1rec,5,8))
	Set blktype=$$bin2num($Extract(p1rec,9,12))
	Set blklevl=$$bin2num($Extract(p1rec,13,16))
	Set akeylen=$$bin2num($Extract(p1rec,17,20))
	If fix512mode Do
	. Set padnum=filBufSz-p1reclen
	. Set nulls=$$doread(.outfile,padnum)
	. If $Length(nulls,$Char(0))'=(padnum+1) Do
	. . Use $P ZShow "*"
	. . Write "V5CSBU - GTMASSERT: FIX512: No padding when expected after record header",!
	. . Halt
	If (blktype=gvtleaf)&(0'=akeylen) Do
	. Set reckey=$$doread(.outfile,akeylen)
	. If fix512mode Do
	. . Set padnum=filBufSz-akeylen
	. . Set nulls=$$doread(.outfile,padnum)
	. . If $Length(nulls,$Char(0))'=(padnum+1) Do
	. . . Use $P ZShow "*"
	. . . Write "V5CSBU - GTMASSERT: FIX512: No padding when expected after key",!
	. . . Halt
	Else  Do
	.	Set reckey=""
	.	If (0'=akeylen)  do
	.	.	Use $P ZShow "*"
	.	.	Write "V5CBSU - GTMASSERT: Error with non-zero akeylen for non-gvtleaf record",!
	.	.	Halt
	Quit

	;
	; Open given file (1st arg MUST be passed by refence) in read or write mode according to flag. Record flag
	; in file(1) so close knows whether to flush buffer or not. Buffer for this file is kept in file(2)
	;
doopen(file,readflag)
	Set file(1)=readflag
	new chsetstr
	set chsetstr=$SELECT($ZV["OS390":":chset=""BINARY""",1:"")
	If readflag Open file:@("(Readonly:Fixed"_chsetstr_":RecordSize="_filBufSz_":Blocksize="_filBufSz_")")
	Else        Open file:@("(New:Fixed"_chsetstr_":RecordSize="_filBufSz_":Blocksize="_filBufSz_")")
	Set file(2)=""	; Buffer for this file
	Quit

	;
	; Read given length from given file. Buffer is kept in file(2). We are rebuffering filBufSz byte fixed records
	; at the real IO level for the reasons described in the module header.
	;
doread(file,len)
	New rec,br
	; A record with ZWR format key can be very long indeed so read more than enough blocks to cover that
	; possibility. The max is higher than needs to be but satisfies criteria of not leaving the loop unbounded.
	For br=1:1:mxzwrxpr Quit:$Length(file(2))'<len  Do
	. Use file
	. Read rec#filBufSz
	. Set file(2)=file(2)_rec
	If br'<10 Use $P Zshow "*" Write !!,"V5CBSU - GTMASSERT: Read length exceeds buffer length",! Halt
	Set rec=$Extract(file(2),1,len)
	Set file(2)=$Extract(file(2),len+1,mxrecsln)
	Quit rec

	;
	; Write data to given file. If length of buffer (in file(2)) does not exceed filBufSz bytes
	; after the write, no real write is made.
	;
dowrite(file,data)
	New rec
	Set file(2)=file(2)_data
	If ($Length(file(2))<filBufSz) Quit  ; Return
	; Write filBufSz byte chunk of data
	Use file
	Set rec=$Extract(file(2),1,filBufSz)
	Write rec
	Set file(2)=$Extract(file(2),513,mxrecsln)
	Quit

	;
	; Close given file and flush its output buffer if necessary
	;
doclose(file)
	If writeflg=file(1) Do
	. ; File was opened for write so flush buffer before we close file
	. Use file
	. Write file(2)
	Close file
	Quit

	;
	; Initialize arrays and such we will be using
	;
init
	Set FALSE=0
	Set TRUE=1
	Set readflg=1
	Set writeflg=0
	Set endian("AXP")=FALSE
	Set endian("x86")=FALSE
	Set endian("x86_64")=FALSE
	Set endian("HP-PA")=TRUE
	Set endian("IA64/B")=TRUE
	Set endian("IA64/L")=FALSE
	Set endian("SPARC")=TRUE
	Set endian("RS6000")=TRUE
	Set endian("S390")=TRUE
	Set endian("S390X")=TRUE
	Set endian=endian($Piece($ZVersion," ",4))
	Set HEX(0)=1
	For x=1:1:8 Set HEX(x)=HEX(x-1)*16
	Set VMS=$ZVersion["VMS"
	Set gvtleaf=5		; gdsblk_gvtleaf - defined in dbcertify.h
	Set blktypes(1)="GVT-Generic"
	Set blktypes(2)="DT-Generic "
	Set blktypes(3)="GVT-Root   "
	Set blktypes(4)="GVT-Index  "
	Set blktypes(5)="GVT-Leaf   "
	Set blktypes(6)="DT-Root    "
	Set blktypes(7)="DT-Index   "
	Set blktypes(8)="DT-Leaf    "
	Set blktypes(9)="Bitmap     "
	Set version=$Piece($ZVersion," ",2)
	Set p1hdrlen=512	; p1hdr struct defined in dbcertify.h
	Set p1reclen=20		; p1rec struct defined in dbcertify.h
	Set p1tag="GTMDBC01"	; P1HDR_TAG define in dbcertify.h
	Set filBufSz=p1hdrlen	; Real IO is done at this buffer size. Should coicide with size of header
	Set mxzwrxpr=10		; MAX_ZWR_EXP_RATIO - key can (in actuality) be much larger when using $C() notation
	Set mxrecsln=filBufSz*mxzwrxpr ; Rather than use 99999 for max rec len, use blocksize * MAX_ZWR_EXP_RATIO
	If ($data(fix512mode)=0) Set fix512mode=0	; Flag to fixup OpenVMS 7.3-1 CRTL problem
	If VMS Do
	. Set vmsflags=$ZTRNLNM("GTM_V5CBSU")
	. Set vmsflags=$$FUNC^%UCASE(vmsflags)
	. If vmsflags["FIX512" Set fix512mode=1
	. If vmsflags["DUMP" Set dumpmode=1
	Quit

	;
	; Conversion routine - binary number from file to GT.M usable number
	;
bin2num:(bin)
	New num,i
	Set num=0
	If endian=TRUE For i=$l(bin):-1:1 Set num=$Ascii(bin,i)*HEX($Length(bin)-i*2)+num
	Else  For i=1:1:$l(bin) Set num=$Ascii(bin,i)*HEX(i-1*2)+num
	Quit num

	;
	; Conversion routine - GT.M number to binary (4 byte) number for file
	;
num2bin:(num)
	If endian=TRUE Quit $Char(num/16777216,num/65536#256,num/256#256,num#256)
	Quit $Char(num#256,num/256#256,num/65536#256,num/16777216)