859 lines
26 KiB
Plaintext
Executable File
859 lines
26 KiB
Plaintext
Executable File
******************************************************************************
|
|
*
|
|
* Description: SET.INDEX to ENABLE, DISABLE, CLEAR and MOVE
|
|
*
|
|
* 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.
|
|
* 05/28/97 18104 KAM Allow root access despite file permissions
|
|
* 05/28/97 19314 KAM Honor secondary group permissions
|
|
* 09/06/96 19192 ALC Corrected the test for OS.TYPE
|
|
* 04/22/96 18329 JJV Port to NT.
|
|
* 06/08/95 16638 EAP Fixed CONVERT.number.TO.ASCII for NLS
|
|
* 06/06/95 16638 EAP Change to use BYTE,BYTEVAL,BYTELEN for NLSsupport
|
|
* 01/28/94 12922 GMH Fix path for local type 30 files
|
|
* 12/16/93 12745 GMH Correct pathname for OPENPATH
|
|
* 11/03/93 12492 GMH Check for Type 1 and 19 files
|
|
* 10/28/93 12384 GMH Accept NULL keyword with TO option
|
|
* 09/08/93 12183 GMH Fix FILE prompting
|
|
* 09/07/93 12183 GMH Fix openseq for type30 files
|
|
* 09/03/93 12183 GMH Implement in BASIC
|
|
*
|
|
*******************************************************************************
|
|
$OPTIONS DEFAULT
|
|
ID = "%W%"
|
|
!
|
|
* Declare functions
|
|
!
|
|
DECLARE GCI NLSsetseqmap
|
|
DECLARE GCI BYTEreplace
|
|
DEFFUN UVREADMSG(num,args) CALLING '*UVREADMSG'
|
|
!
|
|
* Declare keyword values
|
|
!
|
|
INCLUDE UNIVERSE.INCLUDE KEYWORD.H
|
|
INCLUDE UNIVERSE.INCLUDE FILENAMES.H
|
|
INCLUDE UNIVERSE.INCLUDE FILEINFO.H
|
|
INCLUDE UNIVERSE.INCLUDE MACHINE.NAME
|
|
!
|
|
* Declare general equates
|
|
!
|
|
EQU UNIXmachine TO 44271 ;* UNIX byte ordering (acef)
|
|
EQU END.OF.STRING TO 0 ;* For REMOVE
|
|
EQU FALSE TO 0 ;* no
|
|
EQU TRUE TO 1 ;* yes
|
|
EQU DEFAULT TO -1 ;* No mode set
|
|
EQU ENABLED TO 1 ;* ENABLE indices
|
|
EQU DISABLED TO 2 ;* DISABLE indices
|
|
EQU CLEAR.TAG TO 3 ;* CLEAR 2 bit of IDXOFF value
|
|
EQU MOVE.INDEX TO 4 ;* MOVE indice path in file header
|
|
EQU INFORM TO 5 ;* Display current AK location
|
|
EQU CLEAR.INDEX TO 6 ;* CLEAR indice path in file header
|
|
EQU WANT.DICT TO 100 ;* The DICT keyword was seen
|
|
EQU WANT.PDICT TO 200 ;* The PDICT keyword was seen
|
|
!
|
|
* Define variables used
|
|
!
|
|
FIL.TO.CHANGE = '' ;* Dynarray of file names
|
|
INDEX.MODE = DEFAULT;* Default to no mode specified
|
|
VDESC = '' ;* Item read from VOC file
|
|
PROMPTING = TRUE ;* Default to verify
|
|
USE.DICT = 0 ;* Default to DATA portion of file
|
|
MOVE.PATH = '' ;* Where indices are to be relocated
|
|
MACHINE.TYPE = UNIXmachine ;* Default to UNIX byte ordering
|
|
process.status = FALSE ;* Value to set @system.return.code
|
|
INDENT = '' ;* To offset partfiles
|
|
PARTFILE = 0 ;* Current partfile
|
|
!
|
|
* Define multipliers
|
|
!
|
|
dim POWER(5)
|
|
POWER(1) = 1
|
|
POWER(2) = 256
|
|
POWER(3) = 65536
|
|
POWER(4) = 16777216
|
|
!
|
|
* Define MACROS
|
|
!
|
|
EQU getUNIXlong LIT "byteval(IDXOFFvalue,1)*POWER(4) + byteval(IDXOFFvalue,2)*POWER(3) + byteval(IDXOFFvalue,3)*POWER(2) + byteval(IDXOFFvalue,4)"
|
|
EQU getXINUlong LIT "byteval(IDXOFFvalue,4)*POWER(4) + byteval(IDXOFFvalue,3)*POWER(3) + byteval(IDXOFFvalue,2)*POWER(2) + byteval(IDXOFFvalue,1)"
|
|
!
|
|
* Set up command and data matrix
|
|
!
|
|
DIM COMMAND(125) ;* Command line arguments
|
|
!
|
|
* Disable auto pagination
|
|
!
|
|
ASSIGN 0 TO SYSTEM(1005)
|
|
PROMPT ' '
|
|
!
|
|
* 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
|
|
!
|
|
* Is LONGNAMES active
|
|
!
|
|
READV LONGNAMES FROM VOC.FILE,"CREATE.FILE",5 ELSE LONGNAMES=""
|
|
IF LONGNAMES = "" THEN
|
|
LONGNAMES = 12
|
|
END ELSE
|
|
LONGNAMES = 999
|
|
END
|
|
!
|
|
* Open UV.ACCOUNT file
|
|
!
|
|
OPENPATH UV.ROOT:'/UV.ACCOUNT' TO UVACCT.FILE ELSE
|
|
** "Unable to open UVACCT file."
|
|
PRINT;CALL *UVPRINTMSG(85303,"UV.ACCOUNT")
|
|
process.status = -1
|
|
GOTO EXIT.OUT:
|
|
END
|
|
!
|
|
* Parse out COMMAND line
|
|
!
|
|
MATPARSE COMMAND FROM TRIM(@SENTENCE) , ' '
|
|
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 VDESC = ""
|
|
* Check if path is given
|
|
IF INDEX.MODE = MOVE.INDEX AND MOVE.PATH = "" THEN
|
|
* Check for NULL keyword
|
|
IF VDESC<2> = KW$NULL OR COMMAND(I) = '""' OR COMMAND(I) = "''" THEN
|
|
MOVE.PATH = ""
|
|
INDEX.MODE = CLEAR.INDEX
|
|
CONTINUE
|
|
END
|
|
* If any other VOC entry, then leave
|
|
IF VDESC # "" THEN GOTO REMAIN
|
|
IF COMMAND(I)[1,1] = "/" OR (OS.TYPE = "MSWIN" AND ((COMMAND(I) MATCH "1A':\'0X") OR (COMMAND(I) MATCH "1A':/'0X") OR (COMMAND(I)[1,1] = "\"))) THEN
|
|
MOVE.PATH = COMMAND(I)
|
|
* Verify that path exists
|
|
CHECK.PATH:
|
|
IF OS.TYPE = "MSWIN" THEN
|
|
MOVE.PATH = CONVERT( "\", "/", MOVE.PATH )
|
|
END
|
|
|
|
OPENPATH MOVE.PATH TO TMPfile ELSE
|
|
* Path %n cannot be opened for reading. Verify exists
|
|
PRINT;CALL *UVPRINTMSG(32100, MOVE.PATH)
|
|
process.status = -1
|
|
GOTO EXIT.OUT:
|
|
END
|
|
* Must be Type1 or Type19
|
|
STATUS FILstatus FROM TMPfile else FILstatus = ""
|
|
IF FILstatus<21> # 1 AND FILstatus<21> # 19 THEN
|
|
* Location where indices are to reside not a UNIX directory!
|
|
PRINT;CALL *UVPRINTMSG(32101,"")
|
|
process.status = -1
|
|
GOTO EXIT.OUT:
|
|
END
|
|
CLOSE TMPfile
|
|
END ELSE
|
|
* Read from UV.ACCOUNT file
|
|
READV MOVE.PATH FROM UVACCT.FILE, COMMAND(I), 11 ELSE
|
|
* Unable to read item "%s".
|
|
PRINT;CALL *UVPRINTMSG(1205,COMMAND(I))
|
|
process.status = -1
|
|
GOTO EXIT.OUT:
|
|
END
|
|
GOTO CHECK.PATH:
|
|
END
|
|
CONTINUE
|
|
END
|
|
REMAIN:
|
|
* If entry is not in VOC file
|
|
IF VDESC = "" THEN
|
|
* 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
|
|
PRINT;CALL *UVPRINTMSG(85300,COMMAND(I))
|
|
process.status = -1
|
|
GOTO EXIT.OUT:
|
|
END
|
|
END
|
|
!
|
|
* Examine for Keywords
|
|
!
|
|
BEGIN CASE
|
|
CASE VDESC[1,1] = 'K'
|
|
BEGIN CASE
|
|
* Check for DICT keyword
|
|
CASE VDESC<2> = KW$DICT
|
|
USE.DICT = WANT.DICT
|
|
* Check for PDICT keyword
|
|
CASE VDESC<2> = KW$PDICT
|
|
USE.DICT = WANT.PDICT
|
|
* Check if FORCE keyword
|
|
CASE VDESC<2> = KW$FORCE
|
|
PROMPTING = FALSE
|
|
* Check if CLEAR keyword
|
|
CASE VDESC<2> = KW$CLEAR
|
|
IF INDEX.MODE = DEFAULT THEN
|
|
INDEX.MODE = CLEAR.TAG
|
|
END ELSE
|
|
GOTO BAD.OPTION:
|
|
END
|
|
* Check if ON keyword
|
|
CASE VDESC<2> = KW$ON
|
|
IF INDEX.MODE = DEFAULT THEN
|
|
INDEX.MODE = ENABLED
|
|
END ELSE
|
|
GOTO BAD.OPTION:
|
|
END
|
|
* Check if INFORM keyword
|
|
CASE VDESC<2> = KW$INFORM
|
|
IF INDEX.MODE = DEFAULT THEN
|
|
INDEX.MODE = INFORM
|
|
END ELSE
|
|
GOTO BAD.OPTION:
|
|
END
|
|
* Check if OFF keyword
|
|
CASE VDESC<2> = KW$OFF
|
|
IF INDEX.MODE = DEFAULT THEN
|
|
INDEX.MODE = DISABLED
|
|
END ELSE
|
|
GOTO BAD.OPTION:
|
|
END
|
|
* Check if TO keyword
|
|
CASE VDESC<2> = KW$TO
|
|
IF INDEX.MODE = DEFAULT THEN
|
|
INDEX.MODE = MOVE.INDEX
|
|
END ELSE
|
|
BAD.OPTION:
|
|
* "Only one mode can be specified!"
|
|
PRINT;CALL *UVPRINTMSG(32200,"")
|
|
process.status = -1
|
|
GOTO EXIT.OUT:
|
|
END
|
|
* Default
|
|
CASE 1
|
|
PRINT;CALL *UVPRINTMSG(85300,COMMAND(I))
|
|
process.status = -1
|
|
GOTO EXIT.OUT:
|
|
END CASE
|
|
!
|
|
* Check for FILE
|
|
!
|
|
CASE upcase(VDESC[1,1])='F' OR upcase(VDESC[1,1])='Q'
|
|
* Add file to file list
|
|
FIL.TO.CHANGE<-1> = COMMAND(I)
|
|
!
|
|
* Stack as possible entry
|
|
!
|
|
CASE 1
|
|
* Unrecognised word "%s" in command line.
|
|
PRINT;CALL *UVPRINTMSG(85300,COMMAND(I))
|
|
process.status = -1
|
|
GOTO EXIT.OUT:
|
|
END CASE
|
|
!
|
|
* Process next TOKEN item
|
|
!
|
|
NEXT I
|
|
!
|
|
* Was any mode set?
|
|
!
|
|
IF INDEX.MODE = DEFAULT THEN
|
|
process.status = -1
|
|
GOTO EXIT.OUT:
|
|
END
|
|
!
|
|
* If TO keyword is seen and MOVE.PATH is NULL, set to CLEAR
|
|
!
|
|
IF INDEX.MODE = MOVE.INDEX AND MOVE.PATH = "" THEN
|
|
INDEX.MODE = CLEAR.INDEX
|
|
END
|
|
!
|
|
* Check if there is an active SELECT list. Add to FIL.TO.CHANGE
|
|
!
|
|
IF SYSTEM(11) = TRUE THEN
|
|
* Change SELECT list into dynarray
|
|
READLIST TMParray THEN
|
|
* Append to file list
|
|
FIL.TO.CHANGE<-1> = TMParray
|
|
END
|
|
TMParray = ""
|
|
END
|
|
!
|
|
* Any files?
|
|
!
|
|
IF FIL.TO.CHANGE = "" THEN
|
|
* "File name:"
|
|
PRINT UVREADMSG(85304,""):' ':
|
|
INPUT FIL.TO.CHANGE
|
|
|
|
* Check for DICT
|
|
IF INDEX(FIL.TO.CHANGE," ",1) THEN
|
|
USE.DICT = 0
|
|
AWORD = FIELD(FIL.TO.CHANGE," ",1)
|
|
READ VDESC FROM VOC.FILE,AWORD THEN
|
|
* Check that this is DICT keyword
|
|
IF VDESC[1,1] = "K" THEN
|
|
IF VDESC<2> = KW$DICT THEN
|
|
USE.DICT = WANT.DICT
|
|
END ELSE
|
|
IF VDESC<2> = KW$PDICT THEN
|
|
USE.DICT = WANT.PDICT
|
|
END
|
|
END
|
|
END
|
|
END
|
|
IF USE.DICT = 0 THEN
|
|
* "Unrecognized keyword "%s" in command line"
|
|
PRINT;CALL *UVPRINTMSG(85300,AWORD)
|
|
process.status = -1
|
|
GOTO EXIT.OUT:
|
|
END
|
|
FIL.TO.CHANGE=TRIMF(FIL.TO.CHANGE[LEN(AWORD)+1,999])
|
|
END
|
|
END
|
|
!
|
|
* Process through each file and do requested work
|
|
!
|
|
CURRENT.FILE = ''
|
|
DELIM = 0
|
|
DICT = ''
|
|
HDRLAYOUT = ''
|
|
LOOP
|
|
pSTATUS = TRUE
|
|
REMOVE CURRENT.FILE FROM FIL.TO.CHANGE SETTING DELIM
|
|
* Is there any CURRENT.FILE
|
|
IF CURRENT.FILE = "" AND DELIM = END.OF.STRING THEN EXIT
|
|
* DICT keyword seen?
|
|
IF USE.DICT = WANT.DICT THEN DICT = 'DICT '
|
|
IF USE.DICT = WANT.PDICT THEN DICT = 'PDICT '
|
|
* Open this file
|
|
OPEN DICT:CURRENT.FILE TO FILE.VAR ELSE
|
|
* Unable to open %s
|
|
PRINT;CALL *UVPRINTMSG(32006, DICT:CURRENT.FILE)
|
|
* Get next
|
|
CONTINUE
|
|
END
|
|
* Does this file even have indices?
|
|
FILE.INDICES = INDICES(FILE.VAR)
|
|
IF FILE.INDICES = "" AND INDEX.MODE # MOVE.INDEX AND INDEX.MODE # CLEAR.INDEX THEN
|
|
* Print mode message
|
|
BEGIN CASE
|
|
CASE USE.DICT = 0
|
|
* File %s has no secondary indices.
|
|
PRINT;CALL *UVPRINTMSG(35059, DICT:CURRENT.FILE)
|
|
CASE USE.DICT = WANT.DICT
|
|
* File DICT %s has no secondary indices.
|
|
PRINT;CALL *UVPRINTMSG(35057, DICT:CURRENT.FILE)
|
|
CASE USE.DICT = WANT.PDICT
|
|
* File PDICT %s has no secondary indices.
|
|
PRINT;CALL *UVPRINTMSG(35058, DICT:CURRENT.FILE)
|
|
END CASE
|
|
* Get next
|
|
CONTINUE
|
|
END
|
|
* Get info
|
|
STATUS FILstatus FROM FILE.VAR ELSE
|
|
* Unable to stat file %s
|
|
PRINT;CALL *UVPRINTMSG(32007, DICT:CURRENT.FILE)
|
|
* Get next
|
|
CONTINUE
|
|
END
|
|
* Do we have UNIX/SQL write permissions to file
|
|
GOSUB CHECK.PERMISSIONS:
|
|
* Check ATPERMS
|
|
IF ATPERMS = 0 THEN
|
|
* Insufficient privileges on file %s to perform operation.
|
|
PRINT;CALL *UVPRINTMSG(32201,DICT:CURRENT.FILE)
|
|
* Get next
|
|
CONTINUE
|
|
END
|
|
* Set up file offsets
|
|
HDRLAYOUT = FILEINFO(FILE.VAR, FINFO$HDRLAYOUT)
|
|
AKPATHoffset = HDRLAYOUT<FH$INDEXPATH,1>
|
|
AKPATHlength = HDRLAYOUT<FH$INDEXPATH,2>
|
|
IDXOFFoffset = HDRLAYOUT<FH$INDEXFLAGS,1>
|
|
IDXOFFlength = HDRLAYOUT<FH$INDEXFLAGS,2>
|
|
|
|
* Special handling for DISTRIBUTED files
|
|
IF FILstatus<21> = 27 THEN
|
|
GOSUB DO.PARTFILES:
|
|
END ELSE
|
|
* Check if file is type 1 or 19
|
|
IF FILstatus<21> = 1 OR FILstatus<21> = 19 THEN
|
|
* Secondary index facility is not supported for type 1 or 19 files.
|
|
PRINT;CALL *UVPRINTMSG(35038,"")
|
|
pSTATUS = FALSE
|
|
END ELSE
|
|
GOSUB DISPATCH:
|
|
END
|
|
END
|
|
* Close main file
|
|
CLOSE FILE.VAR
|
|
* add so that @system.return.code will return number of files processed
|
|
IF pSTATUS = TRUE THEN
|
|
process.status += 1
|
|
END
|
|
* Check for any more files
|
|
UNTIL DELIM = END.OF.STRING DO
|
|
REPEAT
|
|
!
|
|
* Exit
|
|
!
|
|
EXIT.OUT:
|
|
* Should return number of files processed, or -1 if error
|
|
@SYSTEM.RETURN.CODE = process.status
|
|
STOP
|
|
!
|
|
* All those nasty subroutines
|
|
!
|
|
DISPATCH:
|
|
* Go do action
|
|
ON INDEX.MODE GOSUB CHANGE.INDEX,
|
|
CHANGE.INDEX,
|
|
CHANGE.INDEX,
|
|
MOVE.INDEX.PATH,
|
|
SHOW.INDEX.PATH,
|
|
CLEAR.INDEX.PATH
|
|
RETURN
|
|
!
|
|
* Check UNIX/SQL permissions
|
|
!
|
|
CHECK.PERMISSIONS:
|
|
MYuid = SYSTEM(28) ;* effective uid
|
|
MYgid = SYSTEM(30) ;* effective gid
|
|
MYgid<-1> = SYSTEM(1017) ;*supplementary groups
|
|
ATPERMS = 0 ;* No permissions
|
|
|
|
IF MYuid = FILstatus<8> THEN ;* Am I file owner?
|
|
ATPERMS = BITAND(FILstatus<5>, 128);* 128(dec) = 200(oct)
|
|
END ELSE ;* Am I in same group?
|
|
LOCATE FILstatus<9> IN MYgid SETTING POS THEN
|
|
ATPERMS = BITAND(FILstatus<5>, 16);* 16(dec) = 20(oct)
|
|
END ELSE ;* I must be other
|
|
ATPERMS = BITAND(FILstatus<5>, 2);* 2(dec) = 2(oct)
|
|
END
|
|
END
|
|
* If this is an SQL type file, do we have write permissions
|
|
IF FILstatus<28> # "" THEN
|
|
* This is an SQL type file - check bit 1 for write permissions
|
|
ATPERMS = BITAND(FILstatus<28>, 1)
|
|
END
|
|
IF MYuid = 0 THEN
|
|
ATPERMS = 1
|
|
END
|
|
RETURN
|
|
!
|
|
* Special handling for distributed files
|
|
!
|
|
DO.PARTFILES:
|
|
PARTFILES = FILstatus<26>
|
|
newDELIM = 0
|
|
* Go do each partfile
|
|
LOOP
|
|
REMOVE CURRENT.FILE FROM PARTFILES SETTING newDELIM
|
|
* Open this file
|
|
OPEN CURRENT.FILE TO PART.VAR ELSE
|
|
* Unable to open %s
|
|
PRINT;CALL *UVPRINTMSG(32006, CURRENT.FILE)
|
|
* Get next
|
|
CONTINUE
|
|
END
|
|
* Get info
|
|
STATUS FILstatus FROM PART.VAR ELSE
|
|
* Unable to stat file %s
|
|
PRINT;CALL *UVPRINTMSG(32007, CURRENT.FILE)
|
|
* Get next
|
|
CONTINUE
|
|
END
|
|
INDENT=SPACE(5)
|
|
PARTFILE=FILstatus<24>
|
|
GOSUB DISPATCH:
|
|
CLOSE PART.VAR
|
|
UNTIL newDELIM = END.OF.STRING DO
|
|
REPEAT
|
|
RETURN
|
|
!
|
|
* Change list of indices
|
|
!
|
|
CHANGE.INDEX:
|
|
FILEopen = FALSE
|
|
* Update file header IDXOFF value
|
|
GOSUB OPEN.FILE:
|
|
IF pSTATUS = FALSE THEN GOTO SPIT.OUT.MESSAGE:
|
|
FILEopen = TRUE
|
|
* Get system type
|
|
GOSUB SYSTEM.TYPE:
|
|
* Go to location
|
|
SEEK SEQFILE,IDXOFFoffset,0 THEN
|
|
* read long
|
|
READBLK IDXOFFvalue FROM SEQFILE, IDXOFFlength ELSE
|
|
pSTATUS = FALSE
|
|
GOTO SPIT.OUT.MESSAGE:
|
|
END
|
|
END ELSE
|
|
pSTATUS = FALSE
|
|
GOTO SPIT.OUT.MESSAGE:
|
|
END
|
|
* Convert value based on machine type
|
|
IF MACHINE.TYPE = UNIXmachine THEN
|
|
IDXOFFvalue = getUNIXlong
|
|
END ELSE
|
|
IDXOFFvalue = getXINUlong
|
|
END
|
|
* Change value based on mode
|
|
BEGIN CASE
|
|
CASE INDEX.MODE = ENABLED
|
|
* Unset bit 0
|
|
IDXOFFvalue = BITRESET(IDXOFFvalue, 0)
|
|
CASE INDEX.MODE = DISABLED
|
|
* Set bit 0
|
|
IDXOFFvalue = BITSET(IDXOFFvalue, 0)
|
|
CASE INDEX.MODE = CLEAR.TAG
|
|
* Unset bit 1
|
|
IDXOFFvalue = BITRESET(IDXOFFvalue, 1)
|
|
END CASE
|
|
* Convert this number back to ascii
|
|
number = IDXOFFvalue
|
|
GOSUB CONVERT.number.TO.ASCII:
|
|
* Go to location
|
|
SEEK SEQFILE,IDXOFFoffset,0 THEN
|
|
* Write out
|
|
WRITEBLK ASCII.NUMBER ON SEQFILE ELSE
|
|
pSTATUS = FALSE
|
|
END
|
|
END ELSE
|
|
pSTATUS = FALSE
|
|
END
|
|
SPIT.OUT.MESSAGE:
|
|
* Close
|
|
IF FILEopen = TRUE THEN
|
|
CLOSESEQ SEQFILE
|
|
END
|
|
* Print message
|
|
BEGIN CASE
|
|
CASE INDEX.MODE = ENABLED
|
|
BEGIN CASE
|
|
CASE USE.DICT = 0
|
|
IF pSTATUS = TRUE THEN
|
|
MESSAGE = UVREADMSG(35047,DICT:CURRENT.FILE)
|
|
END ELSE
|
|
MESSAGE = UVREADMSG(35050,DICT:CURRENT.FILE)
|
|
END
|
|
CASE USE.DICT = WANT.DICT
|
|
IF pSTATUS = TRUE THEN
|
|
MESSAGE = UVREADMSG(35045,DICT:CURRENT.FILE)
|
|
END ELSE
|
|
MESSAGE = UVREADMSG(35048,DICT:CURRENT.FILE)
|
|
END
|
|
CASE USE.DICT = WANT.PDICT
|
|
IF pSTATUS = TRUE THEN
|
|
MESSAGE = UVREADMSG(35046,DICT:CURRENT.FILE)
|
|
END ELSE
|
|
MESSAGE = UVREADMSG(35049,DICT:CURRENT.FILE)
|
|
END
|
|
END CASE
|
|
CASE INDEX.MODE = DISABLED
|
|
BEGIN CASE
|
|
CASE USE.DICT = 0
|
|
IF pSTATUS = TRUE THEN
|
|
MESSAGE = UVREADMSG(35053,DICT:CURRENT.FILE)
|
|
END ELSE
|
|
MESSAGE = UVREADMSG(35056,DICT:CURRENT.FILE)
|
|
END
|
|
CASE USE.DICT = WANT.DICT
|
|
IF pSTATUS = TRUE THEN
|
|
MESSAGE = UVREADMSG(35051,DICT:CURRENT.FILE)
|
|
END ELSE
|
|
MESSAGE = UVREADMSG(35054,DICT:CURRENT.FILE)
|
|
END
|
|
CASE USE.DICT = WANT.PDICT
|
|
IF pSTATUS = TRUE THEN
|
|
MESSAGE = UVREADMSG(35052,DICT:CURRENT.FILE)
|
|
END ELSE
|
|
MESSAGE = UVREADMSG(35055,DICT:CURRENT.FILE)
|
|
END
|
|
END CASE
|
|
CASE 1
|
|
MESSAGE = ""
|
|
END CASE
|
|
IF MESSAGE # "" THEN PRINT MESSAGE<1>
|
|
RETURN
|
|
!
|
|
* Change AKdirPATH in file header
|
|
!
|
|
MOVE.INDEX.PATH:
|
|
UPDATEpath = TRUE
|
|
* Get path
|
|
GOSUB GET.INDEX.PATH:
|
|
* Split into PARENT and CHILD
|
|
|
|
IF OS.TYPE = "MSWIN" THEN
|
|
INDEX.DIRPATH = CONVERT( "\", "/", INDEX.DIRPATH )
|
|
END
|
|
|
|
PARENT = FIELD(INDEX.DIRPATH,"/",1,COUNT(INDEX.DIRPATH,"/"))
|
|
CHILD = "/":FIELD(INDEX.DIRPATH,"/",DCOUNT(INDEX.DIRPATH,"/"),1)
|
|
IF CHILD = '/' THEN
|
|
CHILD = "/I_":DICT:CURRENT.FILE[1,LONGNAMES]
|
|
INDEX.DIRPATH = "No indices path currently defined."
|
|
END
|
|
IF INDEX(MOVE.PATH,"I_",1) THEN
|
|
CHILD = ""
|
|
END
|
|
* Display?
|
|
IF PROMPTING = TRUE THEN
|
|
* The current indices for this file are at unix path:
|
|
PRINT
|
|
CALL *UVPRINTMSG(32202, DICT:CURRENT.FILE:@fm:INDEX.DIRPATH:@fm:MOVE.PATH:CHILD)
|
|
INPUT ANX
|
|
ANX = UPCASE(ANX)
|
|
* If not a Y, then no update
|
|
IF ANX[1,1] # "Y" THEN UPDATEpath = FALSE
|
|
* Does path exist?
|
|
IF UPDATEpath = TRUE THEN
|
|
OPENPATH MOVE.PATH:CHILD TO TMPfile THEN
|
|
STATUS TMPstatus FROM TMPfile ELSE TMPstatus=""
|
|
* Check that is type1 or type19
|
|
IF TMPstatus<21> # 1 AND TMPstatus<21> # 19 THEN
|
|
* "Unix path is not a directory. Continue (Y/N)?"
|
|
PRINT;CALL *UVPRINTMSG(32203,"")
|
|
INPUT ANX
|
|
ANX = UPCASE(ANX)
|
|
* If not a Y, then no update
|
|
IF ANX[1,1] # "Y" THEN UPDATEpath = FALSE
|
|
END
|
|
CLOSE TMPfile
|
|
END ELSE
|
|
* "Unix path does not exist. Continue (Y/N)?"
|
|
PRINT;CALL *UVPRINTMSG(32204,"")
|
|
INPUT ANX
|
|
ANX = UPCASE(ANX)
|
|
* If not a Y, then no update
|
|
IF ANX[1,1] # "Y" THEN UPDATEpath = FALSE
|
|
END
|
|
END
|
|
END
|
|
* Make new path
|
|
INDEX.DIRPATH = MOVE.PATH:CHILD
|
|
* Make certain does not exceed the max chars in length
|
|
IF BYTELEN(INDEX.DIRPATH) > AKPATHlength THEN
|
|
* Index directory path name "%n" exceeds %i character limit.
|
|
PRINT;CALL *UVPRINTMSG(35026,INDEX.DIRPATH:@fm:AKPATHlength)
|
|
UPDATEpath = FALSE
|
|
END
|
|
* Change
|
|
IF UPDATEpath = TRUE THEN
|
|
* Write change
|
|
GOSUB WRITE.INDEX.PATH:
|
|
* "File header block updated."
|
|
CALL *UVPRINTMSG(32205,"")
|
|
END
|
|
* Close
|
|
CLOSESEQ SEQFILE
|
|
RETURN
|
|
!
|
|
* Clear AKdirPATH in file header
|
|
!
|
|
CLEAR.INDEX.PATH:
|
|
UPDATEpath = TRUE
|
|
* Get path
|
|
GOSUB GET.INDEX.PATH:
|
|
* Display?
|
|
IF PROMPTING = TRUE THEN
|
|
* The current indices for this file are at unix path:
|
|
PRINT
|
|
PRINT "The current indices for file '":DICT:CURRENT.FILE:"' are at unix path:"
|
|
PRINT
|
|
PRINT " ":INDEX.DIRPATH
|
|
PRINT
|
|
PRINT "Do you wish to remove this path (Y/N)? ":
|
|
INPUT ANX
|
|
ANX = UPCASE(ANX)
|
|
* If not a Y, then no update
|
|
IF ANX[1,1] # "Y" THEN UPDATEpath = FALSE
|
|
END
|
|
* Make new path
|
|
INDEX.DIRPATH = str(BYTE(0),AKPATHlength)
|
|
* Make certain does not exceed the max chars in length
|
|
IF BYTELEN(INDEX.DIRPATH) > AKPATHlength THEN
|
|
* Index directory path name "%n" exceeds %i character limit.
|
|
PRINT;CALL *UVPRINTMSG(35026,INDEX.DIRPATH:@fm:AKPATHlength)
|
|
UPDATEpath = FALSE
|
|
END
|
|
* Change
|
|
IF UPDATEpath = TRUE THEN
|
|
* Write change
|
|
GOSUB WRITE.INDEX.PATH:
|
|
* "File header block updated."
|
|
CALL *UVPRINTMSG(32205,"")
|
|
END
|
|
* Close
|
|
CLOSESEQ SEQFILE
|
|
RETURN
|
|
!
|
|
* Display AKdirPATH in file header
|
|
!
|
|
SHOW.INDEX.PATH:
|
|
* Get path
|
|
GOSUB GET.INDEX.PATH:
|
|
IF pSTATUS = FALSE THEN RETURN
|
|
* Partfile prefix
|
|
IF PARTFILE > 0 THEN
|
|
PRINT "Part File ":PARTFILE:":"
|
|
PRINT INDENT:
|
|
END
|
|
* "Indices for file '":DICT:CURRENT.FILE:"' reside in '":INDEX.DIRPATH:"'."
|
|
CALL *UVPRINTMSG(32206,DICT:CURRENT.FILE:@fm:INDEX.DIRPATH)
|
|
* Close
|
|
CLOSESEQ SEQFILE
|
|
RETURN
|
|
!
|
|
* Get the AKpath from the file header
|
|
!
|
|
GET.INDEX.PATH:
|
|
* Open file
|
|
GOSUB OPEN.FILE:
|
|
IF pSTATUS = FALSE THEN
|
|
* Unable to read index directory name in file header block.
|
|
PRINT;CALL *UVPRINTMSG(35030,"")
|
|
RETURN
|
|
END
|
|
* Go to location
|
|
SEEK SEQFILE,AKPATHoffset,0 ELSE
|
|
* Unable to read index directory name in file header block.
|
|
PRINT;CALL *UVPRINTMSG(35030,"")
|
|
pSTATUS = FALSE
|
|
RETURN
|
|
END
|
|
* Read in maximum bytes
|
|
READBLK INDEX.DIRPATH FROM SEQFILE,AKPATHlength ELSE
|
|
* Unable to read index directory name in file header block.
|
|
PRINT;CALL *UVPRINTMSG(35030,"")
|
|
pSTATUS = FALSE
|
|
RETURN
|
|
END
|
|
* Truncate after first char(0)
|
|
IF INDEX(INDEX.DIRPATH,BYTE(0),1) THEN
|
|
INDEX.DIRPATH = INDEX.DIRPATH[1,INDEX(INDEX.DIRPATH,BYTE(0),1)-1]
|
|
END
|
|
RETURN
|
|
!
|
|
* Write the AKpath to the file header
|
|
!
|
|
WRITE.INDEX.PATH:
|
|
* Open file
|
|
GOSUB OPEN.FILE:
|
|
IF pSTATUS = FALSE THEN
|
|
* Unable to write index directory name in file header block.
|
|
PRINT;CALL *UVPRINTMSG(35029,"")
|
|
RETURN
|
|
END
|
|
* Go to location
|
|
SEEK SEQFILE,AKPATHoffset,0 ELSE
|
|
* Unable to write index directory name in file header block.
|
|
PRINT;CALL *UVPRINTMSG(35029,"")
|
|
pSTATUS = FALSE
|
|
RETURN
|
|
END
|
|
* Pad to AKPATHlength
|
|
INDEX.DIRPATH = (INDEX.DIRPATH:STR(BYTE(0),AKPATHlength))("L#":AKPATHlength)
|
|
* Write in maximum bytes
|
|
WRITEBLK INDEX.DIRPATH ON SEQFILE ELSE
|
|
* Unable to write index directory name in file header block.
|
|
PRINT;CALL *UVPRINTMSG(35029,"")
|
|
pSTATUS = FALSE
|
|
RETURN
|
|
END
|
|
RETURN
|
|
!
|
|
* Open file sequentially
|
|
!
|
|
OPEN.FILE:
|
|
ABSOLUTE.FILE = FILstatus<27>
|
|
* If a DYNAMIC, make certain full path has DATA.30. A remote file
|
|
* should already have it, while a local file won't
|
|
IF FILstatus<21> = 30 AND FILstatus<27>[8] # "/DATA.30" THEN
|
|
ABSOLUTE.FILE := "/DATA.30"
|
|
END
|
|
* Open file
|
|
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 ABSOLUTE.FILE TO SEQFILE ELSE
|
|
pSTATUS = FALSE
|
|
END
|
|
IF SYSTEM(100) THEN
|
|
* Restore the original sequential file map
|
|
IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
|
|
END
|
|
RETURN
|
|
!
|
|
* Determine UNIX or XINU system
|
|
!
|
|
SYSTEM.TYPE:
|
|
* Seek to beginning of file
|
|
SEEK SEQFILE, 0, 0 ELSE
|
|
* "Unable to seq in "%s"."
|
|
PRINT;CALL *UVPRINTMSG(85310,ABSOLUTE.FILE)
|
|
pSTATUS = FALSE
|
|
RETURN
|
|
END
|
|
* Read first two characters
|
|
READBLK MACHINE.TYPE FROM SEQFILE, 2 ELSE
|
|
* Cannot read %s from %s file
|
|
PRINT;CALL *UVPRINTMSG(85310,"File Id":@fm:ABSOLUTE.FILE)
|
|
pSTATUS = FALSE
|
|
RETURN
|
|
END
|
|
* Convert - a UNIX system will have 'ACEF(base16)' or '44271(base10)'
|
|
MACHINE.TYPE = byteval(MACHINE.TYPE,1) * 256 + byteval(MACHINE.TYPE,2)
|
|
RETURN
|
|
!
|
|
* Convert a number to a LONG
|
|
!
|
|
CONVERT.number.TO.ASCII:
|
|
ASCII.NUMBER = STR(BYTE(0),4)
|
|
spot = 1
|
|
FOR p = 4 TO 1 STEP -1
|
|
temp = INT(number/POWER(p))
|
|
IF MACHINE.TYPE = UNIXmachine THEN
|
|
ASCII.NUMBER = BYTEreplace(ASCII.NUMBER,spot,1,BYTE(temp))
|
|
spot += 1
|
|
END ELSE
|
|
ASCII.NUMBER = BYTEreplace(ASCII.NUMBER,spot+(p-1),1,BYTE(temp))
|
|
END
|
|
* Decrement value
|
|
number -= (temp*POWER(p))
|
|
NEXT p
|
|
RETURN
|
|
!
|
|
* End of code
|
|
!
|
|
END
|