****************************************************************************** * * 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 AKPATHlength = HDRLAYOUT IDXOFFoffset = HDRLAYOUT IDXOFFlength = HDRLAYOUT SQLIDXoffset = HDRLAYOUT SQLIDXlength = HDRLAYOUT ! * 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) cmd="PHANTOM " IF COMMAND(1) = "BUILD.INDEX" THEN cmd := "BUILD.INDEX PHANTOM ":ZX-1:" ":FILE:" ":NAME END ELSE cmd := "UPDATE.INDEX PHANTOM ":ZX-1:" ":FILE:" ":NAME 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," ",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 in output setting loc else del Phan.pids 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