tldm-universe/Ardent/UV/BP/DELETE.INDEX
2024-09-09 17:51:08 -04:00

589 lines
16 KiB
Plaintext
Executable File

******************************************************************************
*
* Description: Remove one or more indices from a 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.........................................
* 04/23/99 24742 GMH Add support for new headers
* 10/14/98 23801 SAP Change copyrights.
* 09/26/97 14997 KAM Remove garbage char after error 87903 is printed
* 06/20/97 19819 KAM Add support for UNIX filenames with special chars
* 01/27/97 19949 PEJ Fix binary value conversion when NLS is on
* 06/05/96 18438 JC Port to NT
* 04/03/96 18235 WSM Redo fix to keep rm errors out of COMO files
* 02/22/96 17804 GMM Replace 'SH -c' with OS.EXEC and handle remote paths
* 01/16/96 17903 HSB When last index on a file is deleted, close INDEX.MAP
* 11/08/95 16356 WSM Keep rm errors out of COMO files
* 06/06/95 16638 EAP Change to use BYTE,BYTEVAL,BYTELEN for NLSsupport
* 05/05/95 15741 EAP Remove .uvnlsmap from empty index directory
* 08/01/94 14545 EAP Don't allow DELETE.INDEX on files which are being logged
* 12/14/93 12726 GMH Correct remote parsing
* 10/28/93 12435 GMH Correct parsing
* 09/22/93 12324 JWT Fix incorrect write of datalen
* 09/08/93 12209 GMH Use correct counter
* 09/07/93 12209 GMH Cleanup delete
* 08/25/93 12137 GMH Implement external in BASIC
*
*******************************************************************************
$OPTIONS DEFAULT
$INCLUDE UNIVERSE.INCLUDE MACHINE.NAME
$INCLUDE UNIVERSE.INCLUDE FILENAMES.H
$INCLUDE UNIVERSE.INCLUDE OSDEF.H
ID = "%W%"
!
* Define variables
!
DKEY = 0 ;* DICT keyword
AKEY = 0 ;* ALL keyword
VKEY = 0 ;* BRIEF keyword
FILE = '' ;* name of file
IDXNAME = '' ;* index name(s)
BADIDX = '' ;* list of bad indices
IDXGOOD = '' ;* names
MSG = '' ;* used for UVREADMSG
!
* Define keywords
!
INCLUDE UNIVERSE.INCLUDE KEYWORD.H
INCLUDE UNIVERSE.INCLUDE FILEINFO.H
INCLUDE UNIVERSE.INCLUDE TLOG.H
!
* Define equates for STATUS statement
!
EQU DBpath TO 20
EQU DBtype TO 21
EQU PFnumbers TO 24
EQU PFidxpaths TO 25
EQU PFvocnames TO 26
!
* Defined equates for INDICES function
!
EQU INDEXpath TO 5
!
* Define arrays
!
DIM SID(512)
DIM SN(512)
DIM INDEX.MAP(125)
MAT INDEX.MAP = ""
DIM DATA.MAP(125)
MAT DATA.MAP = ""
!
* Define equates for INDEX.MAP array
!
EQU IDXname LIT 'INDEX.MAP(1)'
EQU IDXkeylen LIT 'INDEX.MAP(2)'
EQU IDXkeytext LIT 'INDEX.MAP(3)'
EQU IDXtype LIT 'INDEX.MAP(4)'
EQU IDXmulti LIT 'INDEX.MAP(5)'
EQU IDXbuilt LIT 'INDEX.MAP(6)'
EQU IDXnulls LIT 'INDEX.MAP(7)'
EQU IDXenabled LIT 'INDEX.MAP(8)'
EQU IDXdatalen LIT 'INDEX.MAP(9)'
EQU IDXdatatext LIT 'INDEX.MAP(10)'
!
* Define functions
!
DECLARE GCI NLSsetseqmap
DEFFUN UVREADMSG(num, args) CALLING '*UVREADMSG'
!
* Open files
!
OPEN 'VOC' TO VOC ELSE
*PRINT 'Sorry, unable to access VOC.'
PRINT UVREADMSG(32000,"")
STOP
END
!
* Get command line
!
PARAMS = CONVERT(" ",@FM,TRIM(@SENTENCE))
DEL PARAMS<1>
!
* Parse command line, looking for files or keywords
!
CHECK:
REMOVE WORD FROM PARAMS SETTING Delim
LOOP
UNTIL WORD = "" DO
* File path?
IF FILE = "" AND (WORD[1,1] = "/" OR WORD[1,1] = "\") THEN
FILE = WORD
END ELSE
* Read from VOC
READ VDESC FROM VOC,FIELD(WORD,",",1) ELSE
* Save as possible index key
VDESC = "A"
END
* If we got something, let's check its type
F1 = UPCASE(VDESC<1>[1,1])
BEGIN CASE
* Keyword
CASE F1 = 'K'
F2 = VDESC<2>
BEGIN CASE
* Check for DICT
CASE F2 = KW$DICT AND FILE = ''
DKEY = 1
* Check for ALL
CASE F2 = KW$ALL
AKEY = 1
* Check for BRIEF
CASE F2 = KW$BRIEF
VKEY = 1
* Unknown: try as an index
CASE 1
IDXNAME<-1> = WORD
END CASE
* File
CASE ( F1 = 'F' OR F1 = 'Q' ) AND FILE = ""
FILE = WORD
* Add as possible index key
CASE 1
IDXNAME<-1> = WORD
END CASE
END
UNTIL Delim = 0 DO
REMOVE WORD FROM PARAMS SETTING Delim
REPEAT
!
* Check if FILE was on command line
!
PROMPT ' '
IF FILE = '' THEN
*PRINT 'File name: ':
PRINT UVREADMSG(32003,""):
INPUT FILE
IF FILE[1,5] = "DICT " THEN
DKEY=1
FILE=FILE[6,999]
END
IF FILE = '' THEN
*PRINT 'NO FILE NAME SPECIFIED.'
PRINT UVREADMSG(32004,"")
STOP
END
* Read (w/multi-data check)
READ VDESC FROM VOC,FIELD(FILE,",",1) ELSE
*PRINT DQUOTE(FILE):' is not a file name.'
PRINT UVREADMSG(32005,FILE)
STOP
END
END
!
* Open file
!
IF DKEY THEN FILE = "DICT ":FILE
IF FILE[1,1] # "/" AND FILE[1,1] # "\" THEN
OPEN FILE TO UDATA ELSE
*PRINT 'Unable to open ':DQUOTE(FILE):'.'
PRINT UVREADMSG(32006,FILE)
STOP
END
END ELSE
OPENPATH FILE TO UDATA ELSE
*PRINT 'Unable to open ':DQUOTE(FILE):'.'
PRINT UVREADMSG(32006,FILE)
STOP
END
END
STATUS fileinfo FROM UDATA ELSE
*PRINT "Unable to stat file ":DQUOTE(FILE):"."
PRINT UVREADMSG(32007,FILE)
STOP
END
* Set up file offsets
HDRLAYOUT = FILEINFO(UDATA, FINFO$HDRLAYOUT)
AKPATHoffset = HDRLAYOUT<FH$INDEXPATH,1>
AKPATHlength = HDRLAYOUT<FH$INDEXPATH,2>
STATE = 0
RECIO(STATE,FINFO$AI.STATE,RECIO$FINFO)
IF FILEINFO(UDATA,FINFO$RECOVERYTYPE) # 0 AND STATE = AI$LOGGING THEN
CALL *UVPRINTMSG(87903,"")
STOP
END
!
* Check indices
!
ILIST = INDICES(UDATA)
IF ILIST = '' THEN
*PRINT 'File "':FILE:'" has no indices.'
PRINT UVREADMSG(32008,FILE)
STOP
END
* No indices and ALL keyword not seen?
IF IDXNAME = '' AND AKEY = 0 THEN
*PRINT 'Index name(s): ':
MSG = UVREADMSG(32009,"")
PRINT MSG:
INPUT TEMP
IF TEMP = '' THEN
*PRINT 'NO INDEX NAME SPECIFIED.'
PRINT UVREADMSG(32010,"")
STOP
END ELSE
* See if can be read from VOC
READ VDESC FROM VOC,TEMP THEN
* Is this the ALL keyword?
IF UPCASE(VDESC<1>[1,1]) = 'K' AND VDESC<2> = KW$ALL THEN
AKEY = 1
END ELSE
IDXNAME = TEMP
END
END ELSE
* Add as possible index key and convert space or comma to FM
* in case we got a string of index names
PARAMS = CONVERT(\ ,\,@FM:@FM,TRIM(TEMP))
GOTO CHECK:
END
END
END
* If ALL keyword was seen, assign
IF AKEY = 1 THEN IDXNAME = ILIST
!
* Set up for checking index
!
C = 0
Delim = 0
!
* Check each index
!
LOOP
REMOVE ONE FROM IDXNAME SETTING Delim
IR = INDICES(UDATA,ONE)
IF IR = '' THEN
BADIDX<-1> = ONE
END ELSE
* Make certain we haven't seen this one yet
LOCATE ONE IN IDXGOOD<1> SETTING FOO ELSE
C += 1
SID(C) = IR
SN(C) = ONE
INS ONE BEFORE IDXGOOD<FOO>
END
END
UNTIL Delim = 0 DO
REPEAT
!
* Close file
!
CLOSE UDATA
!
* Anything to output?
!
IF C = 0 THEN
GOTO EXIT.OUT:
END
!
* Was BRIEF keyword seen?
!
IF VKEY THEN
HUSH ON
END
!
* Is this a Distributed File? If so, then dispatch a call for each existing
* partfile.
!
IF fileinfo<DBtype> = 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.
MAX.PFS = DCOUNT(fileinfo<PFvocnames>,@vm)
FOR I = 1 TO MAX.PFS
* Set up spawn command
cmd = "DELETE.INDEX ":fileinfo<PFvocnames,I>:" "
cmd := CONVERT(@fm," ",IDXNAME)
cmd := " BRIEF"
* Go do command
PRINT " Removing ":CONVERT(@fm," ",IDXNAME):" from index of partfile '":fileinfo<PFvocnames,I>:"'!"
EXECUTE cmd
NEXT I
GOTO EXIT.OUT:
END
!
* Is this a remote file? If so, then go do work on that remote system
!
$IFDEF UV.MSWIN
CONVERT '\' TO '/' IN fileinfo<DBpath>
$ENDIF
IF (fileinfo<DBpath> MATCHES "1X0X'!/'0X") THEN
IS.REMOTE = 1
NODE = FIELD(fileinfo<DBpath>,"!/",1)
DIRECTORY = FIELD(fileinfo<DBpath>,"!/",2,9999)
END ELSE IF (fileinfo<DBpath> MATCHES "1X0X'!'1A':'0X") THEN
IS.REMOTE = 1
NODE = FIELD(fileinfo<DBpath>,"!",1)
DIRECTORY = FIELD(fileinfo<DBpath>,"!",2,9999)
END ELSE
IS.REMOTE = 0
END
IF IS.REMOTE THEN
* Set up for remote execute call
IF INDEX(DIRECTORY,"/DATA.30",1) THEN
DIRECTORY = FIELD(DIRECTORY, "/", 1, COUNT(DIRECTORY,"/"))
END
DIRECTORY = FIELD(DIRECTORY, "/", 1, COUNT(DIRECTORY,"/"))
* Replace FILE name with unix path
THING.TO.DO = CHANGE(@sentence,FILE,TEMP,1)
* Go do remote command
RESULT=""
PRINT " Calling remote node '":NODE:"' to execute requested command! Please wait..."
CALL *REMOTE.B(NODE, THING.TO.DO, DIRECTORY, RESULT)
PRINT RESULT
TEMP=""
DIRECTORY=""
NODE=""
GOTO EXIT.OUT:
END
!
* Disable break key
!
BREAK OFF
!
* Open header of file
!
ABSPATH = fileinfo<27>
IF fileinfo<21> = 30 THEN ABSPATH := "/DATA.30"
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 ABSPATH TO UDATA ELSE
IF SYSTEM(100) THEN
* Restore the original sequential file map
IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
END
*PRINT 'Unable to openseq %s'
PRINT UVREADMSG(85309,ABSPATH)
GOTO EXIT.OUT:
END
IF SYSTEM(100) THEN
* Restore the original sequential file map
IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
END
!
* Was ALL keyword specified? If so, then remove them all
!
$IFDEF UV.MSWIN
CONVERT '\' TO '/' IN IR<1,INDEXpath>
$ENDIF
IF AKEY THEN
REMOVE.ALL:
* Get pathname of directory to remove
INDEX.PATH = FIELD(IR<1,INDEXpath>,"/",1,COUNT(IR<1,INDEXpath>,"/"))
* Seek to correct location
SEEK UDATA, AKPATHoffset, 0 ELSE
* "Unable to seq in "%s"."
PRINT;CALL *UVPRINTMSG(85310,unixFILE)
GOTO EXIT.OUT:
END
* Zero out
WRITEBLK STR(BYTE(0),AKPATHlength) ON UDATA ELSE NULL
* CLose file
CLOSESEQ UDATA
* Now remove everything pertaining to indices within INDEX.PATH directory
* Leave anything else that isn't ours
HUSH ON SETTING HUSH.STATE
$IFDEF UV.UNIX
cmd = RM.CMD:" ":"'":INDEX.PATH:"'":"/.uvnlsmap ":"'":INDEX.PATH:"'":"/INDEX.* ":"'":INDEX.PATH:"'":"/Phan*"
EXECUTE OS.EXEC:'"':cmd:'"' CAPTURING screen
$ELSE
EXECUTE OS.EXEC:"'":RM.CMD:" ":INDEX.PATH:"/.uvnlsmap ":INDEX.PATH:"/INDEX.* ":INDEX.PATH:"/Phan*'" CAPTURING SCREEN
$ENDIF
HUSH HUSH.STATE
* Now attempt to remove the directory
* since we are using the OS rmdir, make sure the slashes are correct
$IFDEF UV.UNIX
cmd = "rmdir ":"'":INDEX.PATH:"'"
EXECUTE OS.EXEC:' "':cmd:'"' CAPTURING screen
$ELSE
CONVERT '/' TO '\' IN INDEX.PATH
EXECUTE OS.EXEC:" 'rmdir ":INDEX.PATH:"'"
$ENDIF
GOTO EXIT.OUT:
END
!
* Open the INDEX.MAP file
!
INDEX.MAP.PATH = IR<1,INDEXpath>[1,LEN(IR<1,INDEXpath>)-3]:"MAP"
Islocked = 0
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
LOOP
OPENSEQ INDEX.MAP.PATH TO MAP.FILE LOCKED
Islocked = 1
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,INDEX.MAP.PATH)
GOTO EXIT.OUT:
END
WHILE Islocked DO
SLEEP 10
REPEAT
IF SYSTEM(100) THEN
* Restore the original sequential file map
IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
END
!
* Load in contents of INDEX.MAP file
!
IDXcnt = 0
LOOP
* Get file name
READBLK TEMP FROM MAP.FILE,10 ELSE EXIT
IDXcnt += 1
IDXname<IDXcnt> = TEMP
* Get keylen
READBLK IKL FROM MAP.FILE,1 ELSE IKL = 0
IDXkeylen<IDXcnt> = IKL
* Get keytext
READBLK TEMP FROM MAP.FILE, BYTEVAL(IKL) ELSE TEMP=""
* Remove BYTE(0) from end
IDXkeytext<IDXcnt> = TEMP[1,LEN(TEMP)-1]
* Get next 5 chars
READBLK TEMP FROM MAP.FILE, 5 ELSE TEMP=""
IDXtype<IDXcnt> = TEMP[1,1]
IDXmulti<IDXcnt> = TEMP[2,1]
IDXbuilt<IDXcnt> = TEMP[3,1]
IDXnulls<IDXcnt> = TEMP[4,1]
IDXenabled<IDXcnt> = TEMP[5,1]
* Read in datalen
READBLK IKL FROM MAP.FILE, 2 ELSE IKL = 0
* GTAR 19949
* Character substrings are not the same as byte substrings when NLS on
* IKL = BYTEVAL(IKL[1,1]) + 256 * BYTEVAL(IKL[2,1])
HEXIKL = OCONV( IKL, "MX0C" )
IKL = ICONV( HEXIKL[1,2], "MCD" ) + 256 * ICONV( HEXIKL[3,2], "MCD" )
IDXdatalen<IDXcnt> = IKL
* Read in datatext
READBLK TEMP FROM MAP.FILE, IKL ELSE TEMP=""
IDXdatatext<IDXcnt> = IDXcnt
DATA.MAP(IDXcnt) = TEMP
REPEAT
!
* Now remove the given indices
!
B = 0
D = 0
LOOP
B += 1
UNTIL B > C DO
* Get name
LOCATE SN(B) IN IDXkeytext,1 SETTING POS THEN
* Removing index file %s
CALL *UVPRINTMSG(35036, SN(B))
* Found at field POS, so remove all references
FOR I = 1 TO 10
DEL INDEX.MAP(I)<POS>
NEXT I
* Remove file from index directory
$IFDEF UV.UNIX
cmd = RM.CMD:" ":"'":SID(B)<1,5>:"'"
EXECUTE OS.EXEC:' "':cmd:'"' CAPTURING screen
$ELSE
EXECUTE OS.EXEC:" '":RM.CMD:" ":SID(B)<1,5>:"'"
$ENDIF
D += 1
END
REPEAT
!
* Is there anything left to rewrite?
!
IF IDXcnt = D THEN
* Go up and remove everything
CLOSESEQ MAP.FILE
GOTO REMOVE.ALL:
END
!
* Rewrite INDEX.MAP file
!
SEEK MAP.FILE, 0, 0 ELSE
* Unable to seq in %s.
PRINT;CALL *UVPRINTMSG(85310,INDEX.MAP.PATH)
GOTO EXIT.OUT:
END
!
* Truncate file
!
WEOFSEQ MAP.FILE
!
* Lay down remaining values
!
C = DCOUNT(IDXname,@fm)
B = 0
D = 0
F = 0
LOOP
B += 1
UNTIL B > C DO
TEMP = IDXname<B>
TEMP := IDXkeylen<B>:IDXkeytext<B>:BYTE(0)
TEMP := IDXtype<B>:IDXmulti<B>:IDXbuilt<B>
TEMP := IDXnulls<B>:IDXenabled<B>
F = INT(IDXdatalen<B> / 256)
IF F > 0 THEN
D = BYTE((IDXdatalen<B>-(F*256))):BYTE(F)
END ELSE
D = BYTE(IDXdatalen<B>):BYTE(0)
END
TEMP := D
* TEMP := IDXdatalen<B>
TEMP := DATA.MAP(IDXdatatext<B>)
WRITEBLK TEMP ON MAP.FILE ELSE
PRINT "Error updating INDEX.MAP file!"
EXIT
END
REPEAT
!
* Close
!
CLOSESEQ MAP.FILE
!
* Any bad indices
!
EXIT.OUT:
IF BADIDX # "" THEN
MSG = UVREADMSG(32022,"")
C = DCOUNT(BADIDX, @FM)
FOR I = 1 TO C
PRINT BADIDX<I>:" ":MSG<1>
NEXT I
END
HUSH OFF
BREAK ON
!
* End of code
!
END