138 lines
4.7 KiB
Plaintext
138 lines
4.7 KiB
Plaintext
compile subroutine ded_indexer( Dum )
|
|
/*
|
|
DECLARE SUBROUTINE FORCE_INDEX_FLUSH, MSG, BORDER.UP, PRINT_CENTER, DELAY
|
|
declare subroutine fsmsg, Attach_Resolve_Volumes, statup
|
|
DECLARE FUNCTION VIDEO.RW
|
|
|
|
if IdxRTrace@ then
|
|
CALL ROUTINE_TRACE('INDEX_REP', 'START')
|
|
end
|
|
|
|
PERFORM_TITLE = 'Training':@FM:'Production'
|
|
PERFORM_TYPE = 'TRAIN':@FM:'PROD'
|
|
PERFORM_POS = 1
|
|
|
|
GOSUB SCRN_SETUP
|
|
CONTINUE = TRUE$
|
|
|
|
LOOP
|
|
WHILE (PERFORM_POS <= 2) AND CONTINUE
|
|
ThisAttachTitle = PERFORM_TITLE<PERFORM_POS>
|
|
ProcessOK = true$
|
|
if ThisAttachTitle = 'Training' then
|
|
STATUP(SINGLE$, STAT.MODAL$, 'Determining if users are in Training...')
|
|
|
|
ProcessOK = false$
|
|
* check to see if there is anyone in training...
|
|
open "VOC" to VocFile else
|
|
fsmsg()
|
|
stop
|
|
end
|
|
TrainingID = 1
|
|
loop
|
|
LockId = 'IN_TRAINING*':TrainingID
|
|
lock VocFile, LockID then
|
|
* no one using this training ID
|
|
unlock VocFile, LockID
|
|
TrainingID += 1
|
|
end else
|
|
* couldn't get the lock
|
|
ProcessOK = true$
|
|
end
|
|
until (ProcessOK) or (TrainingID > 100)
|
|
repeat
|
|
end
|
|
|
|
if ProcessOK then
|
|
STATUP(SINGLE$, STAT.MODAL$, 'Attaching files for ':PERFORM_TITLE<PERFORM_POS>:' Volume')
|
|
Attach_Resolve_Volumes('A', PERFORM_TYPE<PERFORM_POS>)
|
|
|
|
TEMP = @FILES
|
|
NUM_ITEMS = fieldcount(TEMP, @FM)
|
|
STATUP(SINGLE$, STAT.MODAL$, 'Updating Indexes for ':PERFORM_TITLE<PERFORM_POS>:' Files')
|
|
|
|
FOR J = 1 TO NUM_ITEMS WHILE CONTINUE
|
|
THIS_FILE = TEMP<J>
|
|
IF THIS_FILE[1,1] = '!' THEN
|
|
FILENAME = THIS_FILE[2,999]
|
|
*IDX_FIELDS = XLATE(THIS_FILE, '*INDEXES', '', 'X')
|
|
*NUM_FIELDS = fieldcount(IDX_FIELDS, @VM)
|
|
*FOR K = 1 TO NUM_FIELDS WHILE CONTINUE
|
|
GOSUB CHECK_KEY_HIT
|
|
* IF CONTINUE THEN
|
|
* TRANS_PRESENT = XLATE(THIS_FILE, '0', '', 'X')
|
|
* IF (LEN(TRANS_PRESENT)) AND ((LEN(TRANS_PRESENT) > 2) OR (TRANS_PRESENT<1> <> 0)) THEN
|
|
* STATUP(SINGLE$, STAT.MODAL$, 'Updating Indexes for ':PERFORM_TITLE<PERFORM_POS>:' Files File = ':FILENAME:'/Field = ':IDX_FIELDS<1,K>)
|
|
* FORCE_INDEX_FLUSH(FILENAME, IDX_FIELDS<1,K>)
|
|
STATUP(SINGLE$, STAT.MODAL$, 'Updating ':PERFORM_TITLE<PERFORM_POS>:' Indexes - File = ':FILENAME)
|
|
FORCE_INDEX_FLUSH(FILENAME, '')
|
|
* END
|
|
* END
|
|
*NEXT K
|
|
* need to check the presence of transactions again to verify
|
|
* that no fields are stranded due to index removal....
|
|
FLUSH
|
|
GARBAGECOLLECT
|
|
*TRANS_PRESENT = XLATE(THIS_FILE, '0', '', 'X')
|
|
*IF (LEN(TRANS_PRESENT)) AND ((LEN(TRANS_PRESENT) > 2) OR (TRANS_PRESENT<1> <> 0)) THEN
|
|
* STATUP(SINGLE$, STAT.MODAL$, 'Updating Indexes for ':PERFORM_TITLE<PERFORM_POS>:' Files File = ':FILENAME:'/All Fields Update')
|
|
* * do an all fields call - index may have been removed
|
|
* FORCE_INDEX_FLUSH(FILENAME, '')
|
|
*END
|
|
END
|
|
NEXT J
|
|
end else
|
|
* bypassing training...
|
|
STATUP(SINGLE$, STAT.MODAL$, 'Bypassing update for ':PERFORM_TITLE<PERFORM_POS>)
|
|
*msg('%B%bypass', 'T3', '','')
|
|
delay(1)
|
|
end
|
|
IF @DATA = '' THEN
|
|
PERFORM_POS += 1
|
|
END
|
|
REPEAT
|
|
|
|
IF PERFORM_POS = 1 THEN
|
|
STATUP(SINGLE$, STAT.MODAL$, 'Re-attaching files for ':PERFORM_TITLE<2>:' Volume before exiting')
|
|
Attach_Resolve_Volumes('A', PERFORM_TYPE<2>)
|
|
END
|
|
|
|
* restore the original image
|
|
gosub clear_box
|
|
|
|
if IdxRTrace@ then
|
|
CALL ROUTINE_TRACE('INDEX_REP', 'END')
|
|
end
|
|
RETURN
|
|
|
|
CLEAR_BOX:
|
|
CALL STATUP(POP$, '', statup_state)
|
|
msg('', 'DB', ScrImg, '')
|
|
RETURN
|
|
|
|
*============================================================================*
|
|
|
|
SCRN_SETUP:
|
|
msg('Index Processing Active...', 'UB', ScrImg, '')
|
|
CALL STATUP(PUSH$, '', statup_state)
|
|
RETURN
|
|
|
|
*============================================================================*
|
|
|
|
CHECK_KEY_HIT:
|
|
INPUT KEYSTROKE, -1
|
|
IF ((KEYSTROKE = '') AND MOUSE_ACTIVE@) THEN
|
|
KEYSTROKE = MOUSE_TEST
|
|
END
|
|
IF (KEYSTROKE <> '') THEN
|
|
CONTINUE = FALSE$
|
|
IF @CAPTURE THEN
|
|
@SCRIPT := KEYSTROKE
|
|
END
|
|
@DATA := KEYSTROKE
|
|
END ELSE
|
|
CONTINUE = TRUE$
|
|
END
|
|
RETURN
|
|
*/
|