johnblood/tldm-universe
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
main
tldm-universe/Ardent/UV/BP/BUILD.INDEX

1584 lines
50 KiB
Plaintext
Raw Permalink Normal View History

first push of universe files
2024-09-09 21:51:08 +00:00
******************************************************************************
*
* Load up a secondary key file
*
* Module %M% Version %I% Date %H%
*
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
* This is unpublished proprietary source code of Ardent Software Inc.
* The copyright notice above does not evidence any actual or intended
* publication of such source code.
*
*******************************************************************************
*
* Maintenence log - insert most recent change descriptions at top
*
* Date.... GTAR# WHO Description.........................................
* 06/02/99 25141 CSM don't Release Index after BuildIndex_raw
* 05/11/99 24742 GMH Release locks from GCI routine
* 04/30/99 24742 GMH Move RAW.UPDATE to GCI routine
* 04/26/99 24742 GMH Add support for new headers
* 03/31/99 24705 WSM/JSM Call SQLCMP for SQL indices.
* 10/14/98 23801 SAP Change copyrights.
* 08/04/98 22910 JBG Do not use RECORD LOCKS on file with FX LOCK
* 04/06/98 22721 JSM Changed the Itype used for correlatives when loc is 0
* 09/18/97 21484 NDP Initialize nlssavstatus variable.
* 07/06/97 20672 ECS The previous fix did not work all the time.
* This change shuts off RAW.UPDATE on NT
* 06/23/97 20672 ECS on NT check the filesize returned by status and
* call status again if it not good
* 06/20/97 19819 KAM Add support for UNIX filenames with special chars
* 06/02/97 20380 DTM Added info for NLS Locales stuff
* 11/07/96 19438 WSM Found another line where the COMPARE function
* 18480 should be used.
* 10/11/96 19438 GMH Correct justification comparison
* 18480
* 06/28/96 18571 HSB Allow identifiers with quotes as SQL indices
* 05/30/96 18438 JC Port to NT
* 05/14/96 18360 HSB Write SQL index info in proper hardware byte order
* 05/14/96 18045 DJL Correction for C-types with NO.NULLS
* 03/07/96 17832 HSB Recognize SQL type indices same as I-type.
* 01/16/96 17832 HSB Add code to read header to determine if SQL index.
* 12/04/95 16184 NQM Remove SAVE TO 1 to enable use of field named 'TO'
* 06/12/95 16638 EAP Change Index file NLS map to NONE if required
* 06/08/95 16638 EAP Open INDEX.MAP file with NLSmap of NONE
* 06/06/95 16638 EAP Change to use BYTE,BYTEVAL,BYTELEN for NLSsupport
* 04/24/95 16314 SHK Correct right justified comparisons
* 04/11/95 15563 GMH Phantoms now release themselves if the master cannot
* obtain a FILELOCK on the data file.
* 10/21/94 15137 GMH Correct writes/deletes for ISOMODE level 2
* 05/31/94 14102 GMH Correct fix of item.to.parse
* 01/14/94 12851 GMH Force use of left @id
* 12/14/93 12726 GMH Remove USING clause from DF's
* 12/14/93 12726 GMH Correct remote parsing
* 10/28/93 12436 GMH Correct parsing
* 10/15/93 12379 GMH Correct UPDATE.INDEX
* 09/07/93 11930 GMH Correct call
* 09/03/93 11930 GMH Add Distributed File support
* 09/02/93 12087 GMH Fix value comparison for numbers
* 06/10/93 11688 GMH Sort by-exp values
* 05/28/93 11622 GMH Create own @ID to insure Left justification
* 05/19/93 11532 GMH Correct select
* 05/11/93 10146 GMH Fix error message number
* 05/10/93 10146 GMH Handle LARGE items using raw update
* 05/03/93 11275 GMH Correct NO.NULLS and multi-values
* 02/28/93 11131 GMH Correct locking problem created by 11126
* 02/26/93 11126 GMH Fix file open problems
* 02/03/93 11007 PVW Fix problem with NULLS and NO.NULLS
* 02/01/93 10390 PVW Support multilevel data files.
* 10/28/92 10486 GMH Fix message
* 10/27/92 10475 GMH Allow UPDATE.INDEX TO function
* 10/26/92 8864 GMH Fix problem
* 10/23/92 8864 GMH Support build on correlatives
* 10/23/92 10435 GMH Fix build of @id
* 10/14/92 9293 GMH Handle use of reserved keywords
* 10/06/92 10102 JKW Build it unique when asked
* 06/23/92 9718 GMH Add NO.NULLS code
* 05/28/92 9507 GMH Move messages to sys.mess.u
* 05/20/92 9298 GMH Re-enter fix
* 04/14/92 9397 GMH Use PHANTOM keyword
* 03/17/92 9298 GMH Make TO work with q-pointers
* 03/12/92 9281 GMH Fix openseq
* 03/05/92 9262 GMH Clarified message on failure to create new.itype
* 02/28/92 9188 GMH Fixed error.
* 02/27/92 9188 GMH Rewrote as parallel, reentrant and FASTER.
* 04/25/91 8238 JWT allow Q pointers on command line
* 10/23/89 6419 JWT fix itype evaluation
* 10/16/89 6382 JWT detect file with no indices
* 09/20/89 6299 JWT Fix handling of null values
* 09/09/89 6253 JWT recognize keyword ALL in prompting mode
* 08/05/89 6197 JWT MULTI valued index fix
* 08/02/89 6191 JWT LIST.INDEX enhancements
* 07/27/89 6176 JWT Assume ALL if Update index
* 07/26/89 5126 JWT fix file open when DICT used
* 01/17/89 5249 JWT Fix bug for @ID alt index
* 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10.
*
*******************************************************************************
$OPTIONS DEFAULT
ID = "%W%"
!
* Declare functions
!
DECLARE GCI BYTEreplace
DECLARE GCI NLSsetseqmap
DECLARE GCI NLSfilemap
DECLARE GCI BuildIndexRaw
DEFFUN UVREADMSG(num,args) CALLING '*UVREADMSG'
!
* Define tunable equates
!
* Defines the maximum bytes written to a particular AK record using the
* dimensioned array/concatonate methode. Once this value is exceeded, the
* program transfers control to the RAW.UPDATE portion of the code for the
* remainder of values in the active SELECT list for that AK record. The
* initial value is 1 megabytes.
*EQU RAW.TRIP.VALUE TO 1024000
EQU RAW.TRIP.VALUE TO 8192
* Defines the initial number of elements within the dimensioned array. A
* table of keys for a particular AK record are kept in memory within the
* elements (one record ID per element).
EQU INIT.ELEMENTS TO 10000
* Defines the number of elements to increase the dimensioned array by when
* the number of record ID's surpasses the number of array elements. The
* array is enlarged in an attempt to use memory as much as possible.
EQU INCREMENT TO 5000
* Defines the maximum number of elements that the dimensioned array can
* have. Once this value has been surpassed, the array is converted into
* a dynamic array and concatenated onto the AK record. Once the AK record
* exceeds the value of RAW.TRIP.VALUE, control passes to RAW.UPDATE for the
* remainder of values in the active SELECT list for that AK record.
EQU ABSOLUTE.MAX TO 60000
!
* Declare keyword values
!
INCLUDE UNIVERSE.INCLUDE KEYWORD.H
INCLUDE UNIVERSE.INCLUDE MACHINE.NAME
INCLUDE UNIVERSE.INCLUDE FILEINFO.H
INCLUDE UNIVERSE.INCLUDE UVNLSLOC.H
INCLUDE UNIVERSE.INCLUDE OSDEF.H
!
* Declare general equates
!
EQU FALSE TO 0
EQU TRUE TO 1
EQU VOC.ENTRY TO 1
EQU UNIX.PATH TO 2
EQU WANT.DICT TO 100
EQU WANT.PDICT TO 200
!
* Define INDICES equates
!
EQU INDEX.TYPE LIT 'Index.info<1,1>'
EQU INDEX.NO.NULLS LIT 'Index.info<1,3>'
EQU INDEX.PATH LIT 'Index.info<1,5>'
EQU INDEX.JUST LIT 'Index.info<1,7>'
EQU INDEX.UNIQUE LIT 'Index.info<1,8>'
EQU INDEX.NLSLOCALE LIT 'Index.info<1,17>'
EQU INDEX.LOC LIT 'Index.info<2>'
EQU INDEX.CORR LIT 'Index.info<8>'
!
* Define multipliers
!
dim POWER(5)
POWER(1) = 1
POWER(2) = 256
POWER(3) = 65536
POWER(4) = 16777216
!
* Define UNIX equates
!
EQU getUNIXshort LIT "byteval(NODE,byte)*POWER(2) + byteval(NODE,byte+1)"
EQU getUNIXlong LIT "byteval(NODE,byte)*POWER(4) + byteval(NODE,byte+1)*POWER(3) + byteval(NODE,byte+2)*POWER(2) + byteval(NODE,byte+3)"
EQU UNIXinode TO 1
EQU UNIXlnode TO 2
EQU UNIXonode TO 8
!
* Define XINU equates
!
EQU getXINUshort LIT "byteval(NODE,byte+1)*POWER(2) + byteval(NODE,byte)"
EQU getXINUlong LIT "byteval(NODE,byte+3)*POWER(4) + byteval(NODE,byte+2)*POWER(3) + byteval(NODE,byte+1)*POWER(2) + byteval(NODE,byte)"
EQU XINUinode TO 256
EQU XINUlnode TO 512
EQU XINUonode TO 2048
!
* Define general btree equates
!
EQU NODEsize TO 8192
EQU OSrec TO 16384
EQU TWObytes TO 2
EQU FOURbytes TO 4
EQU TAGoffset TO 1
!
* Define inode specific equates
!
EQU INEXToffset TO 5
EQU IKCNToffset TO 1541
EQU IKEYoffset TO 1543
EQU ILENoffset TO 2311
EQU IDATAoffset TO 3079
!
* Define lnode specific equates
!
EQU LRIGHToffset TO 9
EQU LKCNToffset TO 13
EQU LKEYoffset TO 15
EQU LLENoffset TO 271
EQU LDATAoffset TO 527
!
* Define onode specific equates
!
EQU ONEXToffset TO 5
EQU OBCNToffset TO 9
EQU ODATAoffset TO 13
EQU ONODEbytes TO 8180
!
* Declare variables
!
Item.count = 0 ;* Counter for items processed
cur.elements = 0 ;* Number of elements used
Index.info = "" ;* Secondary Index information
Index.file = "" ;* Secondary Index file descriptor
MFLG = "" ;* Multi-value flag
Is.phantom = FALSE ;* Is process a phantom
The.master = TRUE ;* Is this process the originator
ALL.INDICES = FALSE ;* Process ALL
SPECIAL.INDEX = "@INDEX." ;* New itype prefix
KEYWORD.INDEX = "@Ak." ;* New dict prefix
DATAKEY.NAME = "@Ak.ID" ;* Default name for data key
DKEY = 0 ;* DICT on command line
FILE = '' ;* Name of FILE
UDICT = '' ;* Dict file descriptor
UDATA = '' ;* Data file descriptor
NAME = '' ;* List of indices to build
PROCESSED = UVREADMSG(85322,"") ;* processed message
max.elements = INIT.ELEMENTS ;* Number of elements used
INDEX.LOCKED = FALSE ;* Was index locked
INDEX.OPENED = FALSE ;* Was index opened
CHECK.DICT = TRUE ;* Don't compare index to dict
USING.CLAUSE = FALSE ;* USING clause
USING.DICT = 0 ;* USING DICT clause
USING.NAME = '' ;* File for USING clause
process.status= 0 ;* return value to set @system.return.code
KEEP.DICTS = 0 ;* don't delete temp dict items created
SHOW.DETAIL = 0 ;* shows more detailed output
DISPLAY.TICK = TRUE ;* shows asterisk progress
nlssavstatus = '' ;* save NLS locale state
!
* Set up command and data matrix
!
DIM COMMAND(100) ;* Command line arguments
DIM elements(max.elements) ;* AK elements
ASSIGN 0 TO SYSTEM(1005)
!
* Open VOC file
!
OPEN 'VOC' TO VOC.FILE ELSE
** "Unable to open VOC file."
PRINT;CALL *UVPRINTMSG(1720,"")
process.status = -1
GOTO EXIT.OUT:
END
!
* Parse out COMMAND line
!
WORK = TRIM(@SENTENCE)
MATPARSE COMMAND FROM WORK , ' '
ALL.INDICES = IF COMMAND(1) = "UPDATE.INDEX" THEN TRUE ELSE FALSE
TOKENS = INMAT()
!
* Look at all TOKENS on the command line
!
FOR I = 2 TO TOKENS
* See if word is in VOC
READ VDESC FROM VOC.FILE, COMMAND(I) ELSE
* Check for multi-level data file
IF INDEX(COMMAND(I),",",1) THEN
MAINFILE = FIELD(COMMAND(I),",",1)
READ VDESC FROM VOC.FILE,MAINFILE ELSE
PRINT;CALL *UVPRINTMSG(85300,COMMAND(I))
process.status = -1
GOTO EXIT.OUT:
END
END ELSE
* Add as possible index
VDESC=""
END
END
!
* Examine for Keywords
!
BEGIN CASE
CASE VDESC[1,1] = 'K'
BEGIN CASE
* See if DICT is on command line
CASE VDESC<2> = KW$DICT AND FILE = ''
DKEY = WANT.DICT
* See if PDICT is on command line
CASE VDESC<2> = KW$PDICT AND FILE = ''
DKEY = WANT.PDICT
* If DICT is used in USING clause
CASE VDESC<2> = KW$DICT AND USING.CLAUSE = TRUE
USING.DICT = WANT.DICT
* If PDICT is used in USING clause
CASE VDESC<2> = KW$PDICT AND USING.CLAUSE = TRUE
USING.DICT = WANT.PDICT
* See if ALL is on command line
CASE VDESC<2> = KW$ALL AND NAME = ''
ALL.INDICES = TRUE
* See if BRIEF is on command line
CASE VDESC<2> = KW$BRIEF
CHECK.DICT = FALSE
* See if USING is on command line
CASE VDESC<2> = KW$USING
USING.CLAUSE = TRUE
* Check for RETAIN
CASE VDESC<2> = KW$RETAIN
KEEP.DICTS = TRUE
* Check for DETAIL
CASE VDESC<2> = KW$DETAIL
SHOW.DETAIL = TRUE
* Check for DET.SUP - disables asterisk output
CASE VDESC<2> = KW$DET.SUP
DISPLAY.TICK = FALSE
* Encountered unknown
CASE 1
GOTO ADD.IDX:
END CASE
!
* Check for FILE
!
CASE upcase(VDESC[1,1])='F' OR upcase(VDESC[1,1])='Q'
* Exit if more than 1 file name on command line and no USING clause
IF FILE # '' AND USING.CLAUSE = TRUE AND USING.NAME # '' THEN
** "Unexpected file name "%s" in command line."
PRINT;CALL *UVPRINTMSG(85302,COMMAND(I))
process.status = -1
GOTO EXIT.OUT:
END ELSE
* Assign file
IF FILE = "" THEN
FILE = COMMAND(I)
END ELSE
IF USING.CLAUSE = TRUE THEN
USING.NAME = COMMAND(I)
USING.CLAUSE = VOC.ENTRY
END ELSE
GOTO ADD.IDX
END
END
END
!
* Check for PHANTOM
!
CASE VDESC[1,1] = 'V' AND VDESC<2> = "PHANTOM"
I += 1
Is.phantom = COMMAND(I)
* Check if next work is MASTER
IF Is.phantom = "MASTER" THEN
Is.phantom = 0
The.master = TRUE
END ELSE
ALL.INDICES = FALSE ;* A phantom will only process one index
The.master = FALSE
END
!
* Anything else, add to possible index list
!
CASE 1
IF USING.CLAUSE = TRUE AND USING.NAME = "" THEN
USING.NAME = COMMAND(I)
USING.CLAUSE = UNIX.PATH
END ELSE
ADD.IDX:
IF NAME = '' THEN
NAME = COMMAND(I)
END ELSE
NAME := @FM:COMMAND(I)
END
END
END CASE
!
* Process next TOKEN item
!
NEXT I
!
* If FILE not on command line, prompt for it
!
PROMPT ' '
IF FILE = '' THEN
** "File name:"
PRINT UVREADMSG(85304,""):' ':
INPUT FILE
END
!
* Check for DICT
!
IF INDEX(FILE," ",1) THEN
DKEY = 0
AWORD = FIELD(FILE," ",1)
READ VDESC FROM VOC.FILE,AWORD THEN
* Check that this is DICT/PDICT keyword
IF VDESC[1,1] = "K" THEN
IF VDESC<2> = KW$DICT THEN DKEY = WANT.DICT
IF VDESC<2> = KW$PDICT THEN DKEY = WANT.PDICT
END
END
IF DKEY = 0 THEN
** "Unrecognized keyword "%s" in command line"
PRINT;CALL *UVPRINTMSG(85300,AWORD)
process.status = -1
GOTO EXIT.OUT:
END
FILE=TRIMF(FILE[LEN(AWORD)+1,999])
END
!
* Verify file is legit
!
IF FILE = '' THEN
** "No file name specified."
PRINT;CALL *UVPRINTMSG(10138,"")
process.status = -1
GOTO EXIT.OUT:
END ELSE
READ VDESC FROM VOC.FILE, FILE ELSE
* Check for multi-level data files
IF INDEX(FILE,",",1) THEN
MAINFILE = FIELD(FILE,",",1)
READ VDESC FROM VOC.FILE, MAINFILE ELSE
** "%n" is not a file name.
PRINT;CALL *UVPRINTMSG(45006,FILE)
process.status = -1
GOTO EXIT.OUT:
END
END ELSE
** "%n" is not a file name.
PRINT;CALL *UVPRINTMSG(45006,FILE)
process.status = -1
GOTO EXIT.OUT:
END
END
* Check for USING clause for which DICT to open
IF USING.CLAUSE # UNIX.PATH THEN
IF USING.CLAUSE = FALSE THEN
DFILE = IF DKEY THEN "DICT.DICT" ELSE "DICT ":FILE
END ELSE
DFILE = USING.NAME
IF USING.DICT = WANT.DICT THEN DFILE = "DICT ":DFILE
IF USING.DICT = WANT.PDICT THEN DFILE = "PDICT ":DFILE
END
OPEN DFILE TO UDICT ELSE
** "Unable to open "%s"."
PRINT;CALL *UVPRINTMSG(85303,DFILE)
process.status = -1
GOTO EXIT.OUT:
END
END ELSE
OPENPATH USING.NAME TO UDICT ELSE
** "Unable to open "%s"."
PRINT;CALL *UVPRINTMSG(85303,USING.NAME)
process.status = -1
GOTO EXIT.OUT:
END
DFILE = USING.NAME
END
* Get file status info
STATUS index.dict FROM UDICT ELSE
* Unable to stat file %s
PRINT;CALL *UVPRINTMSG(32007, DFILE)
process.status = -1
GOTO EXIT.OUT:
END
END
!
* Open the file
!
IF DKEY = WANT.DICT THEN FILE = "DICT ":FILE
IF DKEY = WANT.PDICT THEN FILE = "PDICT ":FILE
OPEN FILE TO UDATA ELSE
** "Unable to open "%s"."
PRINT;CALL *UVPRINTMSG(85303,FILE)
process.status = -1
GOTO EXIT.OUT:
END
!
* Get a list of INDICES. A null list is returned if none
!
TEMP = INDICES(UDATA)
IF TEMP = '' THEN
** "File "%s" has no indices defined!"
PRINT;CALL *UVPRINTMSG(85305,FILE)
process.status = -1
GOTO EXIT.OUT:
END
IF ALL.INDICES = TRUE THEN NAME = TEMP
IF NAME = '' AND ALL.INDICES = FALSE THEN
** "Index name:"
PRINT UVREADMSG(85306,""):' ':
INPUT NAME
END
IF NAME = '' THEN
** "No Index name specified."
PRINT;CALL *UVPRINTMSG(85307,"")
process.status = -1
GOTO EXIT.OUT:
END
* Check if item is in DICT, or VOC
READ VDESC FROM UDICT,NAME ELSE
READ VDESC FROM VOC.FILE, NAME ELSE VDESC=""
END
* Was ALL entered
IF VDESC[1,1] = 'K' THEN
IF VDESC<2> = KW$ALL THEN
ALL.INDICES = TRUE
NAME = INDICES(UDATA)
END
END
!
* How many indices do we have
!
MAX.INDICES = 0
LOOP
REMOVE X FROM NAME SETTING DELIM
IR = INDICES(UDATA,X)
IF IR = '' THEN
** "%s is not a secondary index field."
PRINT;CALL *UVPRINTMSG(85308,X)
process.status = -1
GOTO EXIT.OUT:
END
MAX.INDICES += 1
UNTIL DELIM = 0 DO
REPEAT
!
* Get Status information
!
BYTE="";unixFILE="";INDEX.DIRPATH=""
STATUS index.item FROM UDATA ELSE index.item=""
STATUS index.dict FROM UDICT ELSE index.dict=""
HDRLAYOUT = FILEINFO(UDATA, FINFO$HDRLAYOUT)
AKPATHoffset = HDRLAYOUT<FH$INDEXPATH,1>
AKPATHlength = HDRLAYOUT<FH$INDEXPATH,2>
IDXOFFoffset = HDRLAYOUT<FH$INDEXFLAGS,1>
IDXOFFlength = HDRLAYOUT<FH$INDEXFLAGS,2>
SQLIDXoffset = HDRLAYOUT<FH$IDXCOLCNT,1>
SQLIDXlength = HDRLAYOUT<FH$IDXCOLCNT,2>
!
* GMH: Check file type
!
IF index.item<21> = 27 THEN
* This is a Distributed File, so there are NO indices on the file
* itself. We must spawn a BUILD.INDEX for each partfile, and do
* them sequentially. The PF vocnames will be in F26 of the result
* from the above STATUS statement.
*
* Get absolute path of DICT file
DICT.UNIX.PATH = index.dict<27>
*
* Get hostname
EXECUTE OS.EXEC:" '":HOSTNAME:"'" CAPTURING LocalHOSTNAME
LocalHOSTNAME = LocalHOSTNAME<1>
MAX.PFS = DCOUNT(index.item<26>,@vm)
FOR I = 1 TO MAX.PFS
* Set up spawn command
cmd = "BUILD.INDEX PHANTOM MASTER ":index.item<26,I>:" "
* Add names
cmd := CONVERT(@fm," ",NAME)
* Is this PF a remote?
* IF (index.item<25,I> MATCHES "1X0X'!/'0X") OR (index.item<25,I> MATCHES "1X0X'!\'0X") OR (index.item<25,I> MATCHES "1X0X'!'1A':'0X") THEN
* * Let PF's use DICT of DF
* cmd := " USING ":DICT.UNIX.PATH
* END ELSE
* * Let PF use DICT of DF prepended with LocalHOSTNAME
* cmd := " USING ":LocalHOSTNAME:"!":DICT.UNIX.PATH
* END
* Don't check dict of PF
cmd := " BRIEF"
* Building indice(s) for partfile '%s'
CALL *UVPRINTMSG(85351,index.item<26,I>)
* Go do command
EXECUTE cmd SETTING return.code
* Stop if error
IF return.code = -1 THEN
* ERROR
process.status = -1
EXIT
END
NEXT I
GOTO EXIT.OUT:
END
!
* Check if this is a remote file. If it is, then spawn off a process
!
$IFDEF UV.MSWIN
CONVERT '\' TO '/' IN index.item<20>
$ENDIF
IF INDEX(index.item<20>,"!/",1) THEN
* Set up for remote execute call
NODE = FIELD(index.item<20>,"!/",1)
TEMP = CHANGE(FIELD(index.item<20>,"!/",2,9999),"/DATA.30","",-1)
DIRECTORY = FIELD(TEMP, "/", 1, COUNT(TEMP,"/"))
* Clean up command - get rid of determining string
THING.TO.DO = CHANGE(@sentence,"PHANTOM MASTER","",-1)
RESULT=""
* Calling remote node '":NODE:"'. Please wait..."
CALL *UVPRINTMSG(85352,NODE)
* Go do remote command
CALL *REMOTE.B(NODE, THING.TO.DO, DIRECTORY, RESULT)
PRINT RESULT
TEMP=""
DIRECTORY=""
NODE=""
GOTO UNLOCK.AND.EXIT:
END
!
* Get Secondary Index Path From file header
!
unixFILE=index.item<20>
IF SYSTEM(100) THEN
* NLS is enabled
* First Save the original sequential file map
OLD.SEQ.MAP = SYSTEM(106)
* SET.SEQ.MAP to NONE to ensure binary access to index file
IGNORE = NLSsetseqmap("NONE")
END
OPENSEQ unixFILE TO SEQFILE ELSE
IF SYSTEM(100) THEN
* Restore the original sequential file map
IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
END
** "Unable to openseq "%s"."
PRINT;CALL *UVPRINTMSG(85309,unixFILE)
process.status = -1
GOTO EXIT.OUT:
END
IF SYSTEM(100) THEN
* Restore the original sequential file map
IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
END
SEEK SEQFILE,AKPATHoffset,0 ELSE
** "Unable to seq in "%s"."
PRINT;CALL *UVPRINTMSG(85310,unixFILE)
process.status = -1
GOTO EXIT.OUT:
END
* Read in maximum bytes
READBLK INDEX.DIRPATH FROM SEQFILE,AKPATHlength ELSE
** "Unable to read AKpath from file header!"
PRINT;CALL *UVPRINTMSG(85342,"")
process.status = -1
GOTO EXIT.OUT:
END
* Truncate after first char(0)
IF INDEX(INDEX.DIRPATH,char(0),1) THEN
INDEX.DIRPATH = INDEX.DIRPATH[1,INDEX(INDEX.DIRPATH,char(0),1)-1]
END
CLOSESEQ SEQFILE
* Open index directory
OPENPATH INDEX.DIRPATH TO Index.directory ELSE
** "Unable to open "%s"."
PRINT;CALL *UVPRINTMSG(85303,INDEX.DIRPATH)
process.status = -1
GOTO EXIT.OUT:
END
IF The.master THEN
* Reset counter
READU ISOLOCK FROM Index.directory,"Phan.cnt" ELSE null
WRITE 0 ON Index.directory,"Phan.cnt" ELSE null
* Set secondary wait lock
READU Idxlock FROM Index.directory,"Idxlock" ELSE Idxlock=''
END
!
* If more than one index, spawn phantoms
!
all.NAMES = NAME
spawned = 0
IF MAX.INDICES > 1 THEN
* Only the master can spawn
IF NOT(The.master) THEN
** "A PHANTOM cannot itself spawn PHANTOMS!"
PRINT;CALL *UVPRINTMSG(85311,"")
process.status = -1
GOTO EXIT.OUT:
END
* Set SELECT stop
READU Selcnt FROM Index.directory,"Idxsel" ELSE Selcnt=0
Selcnt = MAX.INDICES
WRITE Selcnt ON Index.directory,"Idxsel"
!
* Setup to capture pids
!
Phan.pids = ""
Phan.msg = UVREADMSG(1066,99999)
Phan.msg = convert(" ",@fm,Phan.msg)
findstr "99999" in Phan.msg setting pid.loc else
pid.loc = dcount(Phan.msg,@fm)
end
* Start phantoms
FOR ZX = 2 TO MAX.INDICES
** "Starting PHANTOM for index %s"
PRINT UVREADMSG(85312,NAME<ZX>)
cmd="PHANTOM "
IF COMMAND(1) = "BUILD.INDEX" THEN
cmd := "BUILD.INDEX PHANTOM ":ZX-1:" ":FILE:" ":NAME<ZX>
END ELSE
cmd := "UPDATE.INDEX PHANTOM ":ZX-1:" ":FILE:" ":NAME<ZX>
END
if SHOW.DETAIL then display cmd
EXECUTE cmd CAPTURING output
if SHOW.DETAIL then display convert(@FM,char(10):char(13),output)
!
* Get pid
!
findstr Phan.msg<1> in output setting zloc else zloc = 1
Phan.pids<-1> = oconv(field(output<zloc>," ",pid.loc),"MCN")
SLEEP 2
spawned += 1
NEXT ZX
* Delete all but first index
NAME = NAME<1>
!
* Set up for done message
!
Phan.run = UVREADMSG(1154,99999)
Phan.run = convert(" ",@fm,Phan.run)
findstr "99999" in Phan.run setting pid.loc else
pid.loc = dcount(Phan.run,@fm)
end
END
!
* Check to see that an index actually exists for each item specified
!
Index.info = INDICES(UDATA,NAME<1>)
IF Index.info = '' THEN
**"%s is not a secondary index field."
PRINT;CALL *UVPRINTMSG(85308,NAME<1>)
process.status = -1
GOTO EXIT.OUT:
END
READ FOO FROM UDICT,NAME<1> ELSE FOO = ''
Field6 = TRIM(FOO<6>)
!
* Is the DICT item a Multivalued OR Single (if PICK assume Multivalued)
* Create a temp itype that will be used by SELECT. If the NAME item
* in the dictionary is itself an itype, then just include Field2. This
* gets around compiler problems and also solve the problem of itypes
* with imbedded semi-colons.
!
IF CHECK.DICT = TRUE THEN
READ old.dict FROM UDICT,NAME THEN
* Check to see if dict has changed from what was initially created
parse:
IF INDEX.TYPE="D" or INDEX.TYPE="I" or INDEX.TYPE="SQL" THEN
IF INDEX.LOC # old.dict<2> THEN changed=1 ELSE changed=0
END ELSE
* for A, S or C
IF INDEX.LOC # old.dict<2> THEN changed=1 ELSE changed=0
IF INDEX.TYPE='C' AND INDEX.CORR # old.dict<8> THEN changed=1
END
IF changed > 0 THEN
* Item has changed since index was created!
PRINT;CALL *UVPRINTMSG(85333,NAME:@FM:DFILE)
END
END ELSE
READ old.dict FROM VOC.FILE,NAME THEN
GOTO parse:
END
* Item does not exist
PRINT;CALL *UVPRINTMSG(85332,NAME:@FM:DFILE)
END
END
* This section creates a new itype that gets used in the SAVING clause
* portion of the SELECT. It generates AKkey:@TM:DATAkey
new.itype="I":@FM
new.dict=""
IF Field6 = 'M' OR INDEX("ACS",INDEX.TYPE,1) THEN
MFLG = 'M'
IF INDEX("ADS",INDEX.TYPE,1) THEN
IF INDEX.LOC = 9999 THEN
new.itype:="LEN(@RECORD)"
END ELSE
IF INDEX.LOC = 9998 THEN
new.itype:="@NI"
END ELSE
new.itype:=KEYWORD.INDEX:Is.phantom
END
END
new.dict = "D":@FM:INDEX.LOC:@FM:@FM:@FM:"10":INDEX.JUST:@FM:MFLG
new.itype:=";splice(@1,@TM,reuse(":DATAKEY.NAME:"))"
END ELSE
IF INDEX.TYPE = "C" THEN
IF INDEX.LOC = 9999 THEN
new.itype:="LEN(@RECORD)"
END ELSE
IF INDEX.LOC = 9998 THEN
new.itype:="@NI"
END ELSE
new.itype:=KEYWORD.INDEX:Is.phantom
END
END
new.dict = "D":@FM:INDEX.LOC:@FM:@FM:@FM:"10":INDEX.JUST:@FM:MFLG
* changed to use oconv rather than oconvs when location field is 0,
* since field 0 is always single valued and oconvs expects
* multivalued data
IF INDEX.LOC # 0 THEN
new.itype:=";splice(oconvs(@1,\":INDEX.CORR:"\),@TM,reuse(":DATAKEY.NAME:"))"
END ELSE
new.itype:=";splice(oconv(@1,\":INDEX.CORR:"\),@TM,reuse(":DATAKEY.NAME:"))"
END
END ELSE
f2=TRIM(INDEX.LOC)
semis=count(f2,';')
IF semis THEN GOSUB VERIFY.SEMIS:
new.itype:=f2:";splice(@":semis+1:",@TM,reuse(":DATAKEY.NAME:"))"
new.dict = "I":@FM:INDEX.LOC:@FM:@FM:@FM:"10":INDEX.JUST:@FM:MFLG
END
END
END ELSE
MFLG = 'S'
IF INDEX.TYPE # "I" AND INDEX.TYPE # "SQL" THEN
new.itype:=KEYWORD.INDEX:Is.phantom
IF INDEX.NO.NULLS = TRUE THEN
new.itype:=';if @1 NE "" THEN @1:@TM:':DATAKEY.NAME:' ELSE ""'
END ELSE
new.itype:=";@1:@TM:":DATAKEY.NAME
END
new.dict = "D":@FM:INDEX.LOC:@FM:@FM:@FM:"10":INDEX.JUST:@FM:MFLG
END ELSE
f2=TRIM(INDEX.LOC)
semis=count(f2,';')
IF semis THEN GOSUB VERIFY.SEMIS:
IF INDEX.NO.NULLS = TRUE THEN
new.itype:=f2:';if @':semis+1:' NE "" THEN @':semis+1:':@TM:':DATAKEY.NAME:' ELSE ""'
END ELSE
new.itype:=f2:";@":semis+1:":@TM:":DATAKEY.NAME
END
new.dict = "I":@FM:INDEX.LOC:@FM:@FM:@FM:"10":INDEX.JUST:@FM:MFLG
END
END
* Write out new itype.
new.itype:=@FM:@FM:@FM:"10":INDEX.JUST:@FM:MFLG
new.itype.name=SPECIAL.INDEX:NAME
* If this is an SQL index and the name has a quote, replace it in the
* temporary itype so that it will pass through the Retrieve parser.
IF INDEX.TYPE = "SQL"
THEN
IF INDEX(new.itype.name, "'", 1)
THEN CONVERT "'" TO "q" IN new.itype.name
ELSE IF INDEX(new.itype.name, '"', 1)
THEN CONVERT '"' TO "q" IN new.itype.name
END
READU ISOLOCK FROM UDICT,new.itype.name ELSE null
* Fudge in conversion?
if INDEX.JUST="R" then
* Jam in conversion to remove leading zeros
new.itype<3> = "MRZ"
end
WRITE new.itype ON UDICT,new.itype.name ELSE
** "Unable to create item '%s' in %s!"
** "Check possible permission restriction!"
PRINT;CALL *UVPRINTMSG(85315,new.itype.name:@FM:DFILE)
process.status = -1
GOTO CLEAN.DICT:
END
* Create copy of dict for use by new itype
READU ISOLOCK FROM UDICT,KEYWORD.INDEX:Is.phantom ELSE null
WRITE new.dict ON UDICT,KEYWORD.INDEX:Is.phantom ELSE
** "Unable to create item '%s' in %s!"
** "Check possible permission restriction!"
PRINT;CALL *UVPRINTMSG(85315,KEYWORD.INDEX:Is.phantom:@FM:DFILE)
process.status = -1
GOTO CLEAN.DICT:
END
!
* Only lock file if all.NAMES or this is the master
!
IF The.master THEN
* Create a new @id record that is always left justified
new.dict="D":@FM:0:@FM:@FM:@FM:"10L":@FM:"S"
READU ISOLOCK FROM UDICT,DATAKEY.NAME ELSE null
WRITE new.dict ON UDICT,DATAKEY.NAME ELSE
** "Unable to create item '%s' in %s!"
** "Check possible permission restriction!"
PRINT;CALL *UVPRINTMSG(85315,DATAKEY.NAME:@FM:DFILE)
process.status = -1
GOTO CLEAN.DICT:
END
*
* compare the value in Phan.cnt to the number of phantoms
* that were spawned. If they match, then we know the each
* phantom is now waiting for the lock to be released on
* the record Idxlock and that they have all opened FILE and
* one index file.
*
retries = 0
LOOP
READ Phan.cnt FROM Index.directory,"Phan.cnt" THEN
readvalue = Phan.cnt<1>
END ELSE
readvalue = 0
END
UNTIL readvalue >= spawned DO
retries += 1
IF retries > 100 THEN
**"Problem with PHANTOMS! Retried 100 times without success!"
PRINT;CALL *UVPRINTMSG(85316,"")
process.status = -1
GOTO CLEAN.DICT:
END
SLEEP 2
REPEAT
*
* Lock DATA file, now that everyone has it opened
*
PRINT
** "Locking '%s' file for exclusive use."
CALL *UVPRINTMSG(85317,FILE)
FILELOCK UDATA LOCKED
** "File '%s' is locked by another process. Try again later!"
PRINT;CALL *UVPRINTMSG(85340,FILE)
process.status = -1
*
* For GTAR 15563, since phantoms are spinning on Idxlock,
* write STOPPED to the entry, at which point the phantoms
* can read it then exit.
*
WRITE "STOPPED" TO Index.directory,"Idxlock"
GOTO CLEANUP:
END
*
* release holding locks
*
RELEASE Index.directory,"Idxlock"
END ELSE
!
* Add one to Phan.cnt
!
READU Phan.cnt FROM Index.directory,"Phan.cnt" ELSE Phan.cnt = 0
Phan.cnt = Phan.cnt<1> + 1
WRITE Phan.cnt ON Index.directory,"Phan.cnt" ELSE null
!
* Hang until unlocked by master
!
LOOP
READU Idxlock FROM Index.directory,"Idxlock" LOCKED
* Someone else has it. Sleep then try again
sleep 1
continue
END ELSE Idxlock=''
* Release so someone else can read it
RELEASE Index.directory,"Idxlock"
* Got the file - check for STOPPED
if Idxlock<1> = "STOPPED" then goto CLEANUP:
* Continue on
exit
REPEAT
END
!
* Now open the INDEX file and lock it for exclusive use
!
$IFDEF UV.MSWIN
CONVERT '\' TO '/' IN INDEX.PATH
$ENDIF
IBG=FIELD(INDEX.PATH,"/",(DCOUNT(INDEX.PATH,"/")),1)
OPENPATH INDEX.PATH TO Index.file ELSE
**"Unable TO open index file '%s'.
PRINT;CALL *UVPRINTMSG(85313,INDEX.PATH)
process.status = -1
GOTO CLEANUP:
END
INDEX.OPENED += 1
* Open the index file sequential for potential raw updates
IF SYSTEM(100) THEN
* NLS is enabled
* First Save the original sequential file map
OLD.SEQ.MAP = SYSTEM(106)
* SET.SEQ.MAP to NONE to ensure binary access to index file
IGNORE = NLSsetseqmap("NONE")
END
OPENSEQ INDEX.PATH TO BTREE.FILE ELSE
IF SYSTEM(100) THEN
* Restore the original sequential file map
IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
END
**"Unable to open index file '%s'.
PRINT;CALL *UVPRINTMSG(85313,INDEX.PATH)
process.status = -1
GOTO CLEANUP:
END
IF SYSTEM(100) THEN
* Restore the original sequential file map
IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
END
INDEX.OPENED += 1
FILELOCK Index.file LOCKED
**"Index file '%s' for key '%s' is locked. Aborting."
PRINT;CALL *UVPRINTMSG(85314,IBG:@FM:NAME)
process.status = -1
GOTO CLEANUP:
END
INDEX.LOCKED = TRUE
READBLK NODE FROM BTREE.FILE, 4 ELSE
* Unable to read block at 0 in index file
PRINT; CALL *UVPRINTMSG(85341, '0':@fm:INDEX.PATH)
process.status = -1
RETURN TO UNLOCK.AND.EXIT:
END
byte = 1
stamp = getUNIXshort
* See if this is an SQL I-type index. If so process a bit differently.
* Seek to IDXOFF position
SEEK BTREE.FILE, IDXOFFoffset, 0 ELSE
* Unable to seq in %s
PRINT; CALL *UVPRINTMSG(85310, INDEX.PATH)
process.status = -1
GOTO EXIT.OUT:
END
* Read IDXOFF
USESQLCMP = 0
READBLK IDXOFF FROM BTREE.FILE, IDXOFFlength THEN
* 44271 is 0xacef
IF stamp = 44271 THEN
VAL = BYTEVAL(IDXOFF[4,1])
END
ELSE
VAL = BYTEVAL(IDXOFF[1,1])
END
* See if sqlcmp should be called since it is called in *
* DBfindt25.c if index is not numeric and is an SQL Itype *
* index. *
IF NOT(BITAND(VAL,32)) AND BITAND(VAL, 64) THEN USESQLCMP = 1
* See if this is a SQL I-type index.
IF BITAND(VAL, 64) THEN
* It is, find out how many columns are involved.
SEEK BTREE.FILE, SQLIDXoffset, 0 ELSE
* Unable to seq in %s
PRINT; CALL *UVPRINTMSG(85310, INDEX.PATH)
process.status = -1
GOTO EXIT.OUT:
END
READBLK SQLCOLS FROM BTREE.FILE, SQLIDXlength
THEN
IF stamp = 44271
THEN
SQLCOLS = BYTEVAL(SQLCOLS[4,1])
END
ELSE
SQLCOLS = BYTEVAL(SQLCOLS[1,1])
END
END
ELSE SQLCOLS = 0
END
ELSE SQLCOLS = 0
END
ELSE
* Unable to read block at IDXOFFoffset in index file
PRINT; CALL *UVPRINTMSG(85341, IDXOFFoffset:@fm:INDEX.PATH)
process.status = -1
RETURN TO UNLOCK.AND.EXIT:
END
!
* Set the INDEX.MAP entry to build.required
!
VALUE = "N"
GOSUB UPDATE.INDEX.MAP:
!
* Sort Select the file. This allows new items to be correctly
* inserted into the tables.
!
* NOTE: The SELECT done below returns a select list which contains both
* the alternate index value and the record id, both of which are
* separated by a text mark (char(251)).
!
SKIPPED.RECORDS=0 ; SKIPPED.KEYS="";validation = 0
** "Starting SSELECT for file '%s index %s'."
CALL *UVPRINTMSG(85319,FILE:@FM:NAME)
!
* If we have a USING clause, then create a temp VOC record
!
!
* If we are NLS and NLSlocale enabled, we need to check the type of locale
* the file should be build with, and temp. change to that...
!
IF SYSTEM( 100 ) AND SYSTEM( 101 )
THEN
nlssavstatus = GETLOCALE( UVLC$COLLATE )
IF ( nlssavstatus # INDEX.NLSLOCALE )
THEN
status = SETLOCALE( UVLC$COLLATE, INDEX.NLSLOCALE )
END
END
IF USING.CLAUSE # FALSE THEN
* Create temp VOC item. Make certain to remove DATA.30, for dyn DICTs
TEMPvoc = "F":@FM:index.item<27>:@FM:CHANGE(index.dict<27>,"/DATA.30","",-1)
READU ISOLOCK FROM VOC.FILE,"TMPfile":@USERNO ELSE null
WRITE TEMPvoc on VOC.FILE,"TMPfile":@USERNO
CMD="SSELECT TMPfile":@USERNO
END ELSE
CMD="SSELECT ":FILE
END
IF MFLG = 'S' THEN
* should we NOT select NULLs
IF INDEX.NO.NULLS = TRUE THEN
IF INDEX.TYPE = "C" THEN
CMD := " WITH ":NAME:' # ""'
END ELSE
CMD := " WITH ":KEYWORD.INDEX:Is.phantom:' # ""'
END
END
CMD :=" BY "
END ELSE
* should we NOT select NULLs
IF INDEX.NO.NULLS = TRUE THEN
IF INDEX.TYPE = "C" THEN
CMD := " WITH ":NAME:' # ""'
END ELSE
CMD := " WHEN ":KEYWORD.INDEX:Is.phantom:' # ""'
END
END
CMD :=" BY.EXP "
END
IF INDEX.TYPE = "C" THEN
CMD := NAME
END ELSE
CMD := KEYWORD.INDEX:Is.phantom
END
CMD := " BY ":DATAKEY.NAME
* Changed SAVE TO 1 to SAVE because the TO keyword prevented the
* use of 'TO' for a field name. Also changed READNEXT FROM 1.
CMD := " SAVING ":new.itype.name:" NO.INDEX"
* Go do SELECT
if SHOW.DETAIL then display CMD
EXECUTE CMD SETTING validation
!
* Decrement Select counter
!
IF NOT(The.master) OR MAX.INDICES > 1
THEN
READU Selcnt FROM Index.directory,"Idxsel" ELSE validation = -1
Selcnt -= 1
IF Selcnt > 0 THEN
WRITE Selcnt ON Index.directory,"Idxsel"
END ELSE
DELETE Index.directory,"Idxsel"
RELEASE Index.directory,"Idxsel"
END
END
!
* Remove temp pointer
!
READU ISOLOCK FROM VOC.FILE,"TMPfile":@USERNO ELSE null
DELETE VOC.FILE,"TMPfile":@USERNO
!
* Did select blow up or not
!
IF validation = -1 THEN
PRINT
** "SELECT did not complete as expected. Please verify!"
PRINT;CALL *UVPRINTMSG(85320,"")
process.status = -1
GOTO CLEANUP:
END
DISABLE.AUTO.PAGING=@(0,0)
!
* Wait around for ALL selects to finish
!
LOOP
READ Selcnt FROM Index.directory,"Idxsel" ELSE Selcnt=0
UNTIL Selcnt = 0 DO
SLEEP 5
REPEAT
!
* Clear the INDEX file
!
PRINT
** "Clearing Index File %s"
CALL *UVPRINTMSG(85318,IBG)
CLEARFILE Index.file
IF SYSTEM(100) THEN
OLDMAP = FILEINFO(Index.file,FINFO$NLSMAP)
IF FIELD(OLDMAP,"(",1) <> "NONE" THEN
* Change the Index.file map to NONE, Re-open and Re-lock
STATUS = NLSfilemap(FILEINFO(Index.file,FINFO$PATHNAME),"DEFAULT")
STATUS = NLSfilemap(FILEINFO(Index.file,FINFO$PATHNAME),"NONE")
CLOSE Index.file
OPENPATH INDEX.PATH TO Index.file ELSE
**"Unable TO open index file '%s'.
PRINT;CALL *UVPRINTMSG(85313,INDEX.PATH)
process.status = -1
GOTO CLEANUP:
END
FILELOCK Index.file LOCKED
**"Index file '%s' for key '%s' is locked. Aborting."
PRINT;CALL *UVPRINTMSG(85314,IBG:@FM:NAME)
process.status = -1
GOTO CLEANUP:
END
END
END
!
* Begin building indices
!
PRINT
** "Starting DATA processing for index '%s'!"
CALL *UVPRINTMSG(85321,NAME)
Item.count = 0 ; EOL=0 ; LAST.IVAL = "xxxSPECIALxxx"
record.id = ""; t25.record = ""; itype.val = ""; bytes.out=0
unique = INDEX.UNIQUE
LOOP
READNEXT item.to.parse ELSE EOL = 1
UNTIL EOL DO
!
* peel off record id
!
REPARSE:
* SQL I-type indices may have additional @TMs in the alternate key,
* so position to the proper @TM to find AK.
IF (SQLCOLS > 0) THEN
tm.loc=index(item.to.parse,@TM, SQLCOLS)
END ELSE
tm.loc=index(item.to.parse,@TM,1)
END
itype.val = item.to.parse[1,tm.loc-1]
!
* Do we write out
!
IF itype.val = "" AND INDEX.NO.NULLS THEN CONTINUE
* if (itype.val) # (LAST.IVAL) then
IF USESQLCMP THEN COMPARE.RES = SQLCMP(itype.val,LAST.IVAL,Index.file)
ELSE COMPARE.RES = COMPARE(itype.val,LAST.IVAL,INDEX.JUST)
IF COMPARE.RES # 0 THEN
IF cur.elements THEN
MATBUILD t25.record FROM elements,1,cur.elements
* do not use RECORD LOCKS since have FX lock
READ xx FROM Index.file,LAST.IVAL THEN
t25.record = xx:@fm:t25.record
END
xx=''
WRITE t25.record ON Index.file,LAST.IVAL
END
cur.elements=0
t25.record = ""
bytes.out = 0
LAST.IVAL=itype.val
END ELSE
IF unique = 'U' THEN
PRINT
** "Duplicates found, can't build unique index on %s."
PRINT;CALL *UVPRINTMSG(85331, NAME)
process.status = -1
GOTO CLEANUP:
END
END
!
* Add to record
!
IF cur.elements >= max.elements OR (bytes.out >= RAW.TRIP.VALUE) THEN
IF cur.elements >= ABSOLUTE.MAX OR (bytes.out >= RAW.TRIP.VALUE) THEN
* Append new data to existing data
MATBUILD t25.record FROM elements,1,cur.elements
* do not use RECORD LOCKS since have FX lock
READ xx FROM Index.file,LAST.IVAL THEN
t25.record = xx:@fm:t25.record
END
bytes.out = len(t25.record)
xx=''
WRITE t25.record ON Index.file,LAST.IVAL
t25.record=""
* Have we exceeded so that we must now raw update
IF bytes.out >= RAW.TRIP.VALUE THEN
EOL = BuildIndexRaw(Index.file,LAST.IVAL,item.to.parse,Item.count, DISPLAY.TICK)
if EOL < 0 then
process.status = -1
GOTO UNLOCK.AND.EXIT:
end
cur.elements = 0
bytes.out = 0
* If list is exhausted, exit loop
IF EOL THEN exit
* Go do next item
GOTO REPARSE:
END
* Set to start
cur.elements = 0
END ELSE
max.elements += INCREMENT
DIM elements(max.elements)
END
END
cur.elements +=1
elements(cur.elements) = item.to.parse[tm.loc+1,99999]
bytes.out += len(elements(cur.elements))
!
* Display some type of movement
!
Item.count += 1
IF DISPLAY.TICK AND NOT(MOD(Item.count,25)) AND NOT(Is.phantom) THEN
PRINT '*':
IF NOT(MOD(Item.count,1000)) THEN
** " processed."
PRINT FMT(Item.count,"R#15"):PROCESSED
END
END
REPEAT ; * End of main loop
!
* Write out last record if not complete
!
IF cur.elements THEN
MATBUILD t25.record FROM elements,1,cur.elements
* do not use RECORD LOCKS since have FX lock
READ xx FROM Index.file,LAST.IVAL THEN
t25.record = xx:@fm:t25.record
END
xx=''
WRITE t25.record ON Index.file,LAST.IVAL ELSE null
t25.record = ""
END
!
* Have completed build. Do clean up
!
PRINT
** " total processed."
PRINT FMT(Item.count,"R#15"):UVREADMSG(85323,"")
PRINT
!
* Reset FLAGS in INDEX.MAP record
!
** "Updating INDEX.MAP flags..."
CALL *UVPRINTMSG(85324,"")
PRINT
VALUE = "Y"
GOSUB UPDATE.INDEX.MAP:
!
* All done. quit.
!
IF ALL.INDICES = TRUE AND The.master THEN
* Changes the "Indices require updating" message to "No updates pending"
execute "SET.INDEX ":FILE:" CLEAR"
END
PRINT
** "Index build of %s complete."
CALL *UVPRINTMSG(85325,NAME)
!
* Only unlock if all indexes are done.
!
CLEANUP:
IF SYSTEM( 100 ) AND SYSTEM( 101 )
THEN
IF ( nlssavstatus # INDEX.NLSLOCALE )
THEN
status = SETLOCALE( UVLC$COLLATE, nlssavstatus )
END
END
IF The.master THEN
IF spawned THEN
PRINT
** "Waiting for PHANTOMS."
PRINT UVREADMSG(85326,""):
RETRY=0
!
* Check for phantom completion
!
pid.cnt = dcount(Phan.pids,@fm)
LOOP
execute "JOBS" capturing output
* get all numbers
output = fields(output," ",pid.loc)
* get rid of non-numerics
output = oconv(output,"MCN")
for i = 1 to pid.cnt
findstr Phan.pids<i> in output setting loc else
del Phan.pids<i>
pid.cnt -= 1
i -= 1
end
next i
UNTIL Phan.pids = "" DO
RETRY += 1
sleep 5
REPEAT
PRINT
PRINT
IF RETRY < 120 THEN
** "All PHANTOMS completed."
CALL *UVPRINTMSG(85327,"")
END ELSE
** "Timed out waiting for PHANTOMS. Please verify completion of"
** "PHANTOM builds using LIST.INDEX command!"
CALL *UVPRINTMSG(85330,"")
END
END
* Cleanup hold record
READU ISOLOCK FROM Index.directory,"Phan.cnt" ELSE null
DELETE Index.directory,"Phan.cnt"
* Cleanup hold record
READU ISOLOCK FROM Index.directory,"Idxlock" ELSE null
DELETE Index.directory,"Idxlock"
* Cleanup hold record
READU ISOLOCK FROM Index.directory,"Idxsel" ELSE null
DELETE Index.directory,"Idxsel"
FILEUNLOCK UDATA
PRINT
** "File '%s' Unlocked."
CALL *UVPRINTMSG(85328,FILE)
PRINT
END ELSE
!
* Update Phan.cnt count, but don't create it if not there
!
READU Phan.cnt FROM Index.directory,"Phan.cnt" THEN
Phan.cnt = Phan.cnt<1> - 1
WRITE Phan.cnt ON Index.directory,"Phan.cnt" ELSE null
END
RELEASE Index.directory,"Phan.cnt"
END
!
* Delete temp DICT entry
!
CLEAN.DICT:
IF not(KEEP.DICTS) then
READU ISOLOCK FROM UDICT,new.itype.name ELSE null
DELETE UDICT,new.itype.name
READU ISOLOCK FROM UDICT,KEYWORD.INDEX:Is.phantom ELSE null
DELETE UDICT,KEYWORD.INDEX:Is.phantom
IF The.master THEN
READU ISOLOCK FROM UDICT,DATAKEY.NAME ELSE null
DELETE UDICT,DATAKEY.NAME
END
END
!
* Close files
!
UNLOCK.AND.EXIT:
IF INDEX.LOCKED = TRUE THEN
FILEUNLOCK Index.file ;* unlock index file
END
CLOSE Index.directory ;* close index directory
IF INDEX.OPENED = 1 THEN
CLOSE Index.file ;* close index file
END
IF INDEX.OPENED = 2 THEN
CLOSESEQ BTREE.FILE ;* close index sequential file
END
CLOSE VOC.FILE ;* close VOC
CLOSE UDICT ;* close DICT file
CLOSE UDATA ;* close file
!
* Finish up
!
EXIT.OUT:
PRINT
* Set @system.return.code
@SYSTEM.RETURN.CODE = process.status
STOP
!
* START OF SUBROUTINE DEFINITIONS
!
!
* Subroutine to update INDEX.MAP file
!
UPDATE.INDEX.MAP:
TPATH = INDEX.PATH
TPATH = TPATH[1,LEN(TPATH)-3]:"MAP"
remap:
IF SYSTEM(100) THEN
* NLS is enabled
* First Save the original sequential file map
OLD.SEQ.MAP = SYSTEM(106)
* SET.SEQ.MAP to NONE to ensure binary access to index file
IGNORE = NLSsetseqmap("NONE")
END
OPENSEQ TPATH TO MAP LOCKED
IF SYSTEM(100) THEN
* Restore the original sequential file map
IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
END
SLEEP 10
GOTO remap:
END ELSE
IF SYSTEM(100) THEN
* Restore the original sequential file map
IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
END
** "Unable TO open INDEX.MAP at '%s'."
PRINT;CALL *UVPRINTMSG(85329,TPATH)
process.status = -1
RETURN TO EXIT.OUT:
END
IF SYSTEM(100) THEN
* Restore the original sequential file map
IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
END
LOOP
* read filename
READBLK INAME FROM MAP,10 ELSE EXIT
* read keylen
READBLK IKL FROM MAP,1 ELSE NULL
* read keyname
READBLK IKEYN FROM MAP,BYTEVAL(IKL) ELSE NULL
IKEYN = IKEYN[1,LEN(IKEYN)-1]
* read type & multi
READBLK IKL FROM MAP,2 ELSE NULL
* is this the index we need. if so write value
* otherwise read in built value
LOCATE(IKEYN,NAME;FOO) THEN
WRITEBLK VALUE TO MAP ELSE NULL
END ELSE
READBLK IKL FROM MAP,1 ELSE NULL
END
* read in nulls & enabled
READBLK IKL FROM MAP,2 ELSE NULL
* read in data length
READBLK IKL FROM MAP,2 ELSE NULL
IKL = BYTEVAL(IKL,1) + 256 * byteval(IKL,2)
* read in data
READBLK IKL FROM MAP,IKL ELSE NULL
REPEAT
CLOSESEQ MAP ;* close INDEX.MAP file
RETURN
!
* Subroutine to verify the numbers of semi-colons found in an i-type
!
VERIFY.SEMIS:
p=LEN(f2)
c=0
achar=""
aquotes=0
bquotes=0
LOOP
c+=1
UNTIL c > p DO
achar=f2[c,1]
* Check for single quotes
IF achar = "'" THEN
IF NOT(aquotes) THEN
aquotes += 1
END ELSE
aquotes -= 1
END
END
* Check for double quotes
IF achar = '"' THEN
IF not(bquotes) THEN
bquotes += 1
END ELSE
bquotes -= 1
END
END
* If we are inside any active quotes, then ignore the
* the semi-colon we just found
IF (aquotes OR bquotes) AND achar = ';' THEN
semis -= 1
END
REPEAT
RETURN
Reference in New Issue Copy Permalink