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

1400 lines
42 KiB
Plaintext
Raw Permalink Normal View History

first push of universe files
2024-09-09 21:51:08 +00:00
*******************************************************************************
*
* Create or modify a Distributed 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.........................................
* 05/04/99 24297 LPC Set DFswitch before opening DF for admin
* 04/28/99 21797 OGO Replication support for distributed files.
* 10/14/98 23801 SAP Change copyrights.
* 03/13/96 17797 AGM Replace 'SH -c' with OS.EXEC
* 10/06/95 16685 SHJ Remove &PARTFILES& entry when deleting dist file
* 01/13/95 14670 FTW Make sure Distfile exists when the REMOVING
* keyword is supplied.
* 11/21/94 15189 GMH Add READU before &PARTFILE& write
* 10/24/94 15139 LPC Add READU before writing part alg to dictionary
* 10/21/94 15139 LPC Change READs to READUs before updates
* 07/08/94 14168 ALC Removed spurious debug statement
* 06/07/94 14168 ALC Fixed MULTIVOLUME to give error on non PI/open
* flavor accounts.
* 05/23/94 14165 ALC Implement the EXTERNAL partitioning algorithm.
* Added new algorithm MULTIVOLUME.
* 05/11/94 12647 FTW Change static PRINT msgs to *UVPRINTMSG calls.
* 09/13/93 11197 LPC Fix code for changing a files partitioning information
* 09/07/93 12012 LPC Add code for REBUILD.DF, LIST.DF, VERIFY.DF
* 08/23/93 12013 LPC Add CANCEL option to remove Partblock from Partfiles
* 08/20/93 11167 LPC Fix pathnames supplied to DF.MODIFY
* 08/10/93 11988 LPC Delete Distributed File with no Partfiles
* 08/05/93 11969 LPC Use CREATE.FILE to create Distributed Files
* 03/12/93 11178 LPC Keep part block if partfile is part of another DF
* 03/05/93 11168 LPC Fix arguments to DFmodify when REMOVING
* 02/18/93 10960 LPC Fix creation of DF dictionary in PICK accounts
* 02/18/93 11030 LPC Add error message for unsupported CANCEL option
* 02/18/93 11089 LPC Add space after RETAIN option
* 01/25/93 10940 LPC Fix RETAIN option
* 01/21/93 10929 LPC Don't allow VOC or non-hashed files
* 10/10/92 10316 LPC Fix misleading error message
* 09/28/92 10259 LPC Fixed handling of algorithm when not specified
* 09/28/92 10256 LPC Fix routine to change partitioning algorithm
* 09/28/82 10215 LPC Fix write to &PARTFILES&
* 09/27/92 10254 LPC Disallow adding or removing a Distributed File
* 09/27/92 10255 LPC Use EXECUTE RETURNING to check return codes
* 08/20/92 10082 LPC Add the ability to change a part number
* 08/12/92 9686 LPC Added to sccs.
*
*******************************************************************************
$OPTIONS INFO.LOCATE
$INCLUDE UNIVERSE.INCLUDE MACHINE.NAME
$INCLUDE UNIVERSE.INCLUDE FILENAMES.H
* Flags
ADDING.FLAG = 0
REMOVING.FLAG = 0
CANCEL.FLAG = 0
FORCE.FLAG = 0
RETAIN.FLAG = 0
DATA.FLAG = 0
CREATE.FLAG = 0
CHANGE.PART.FLAG = 0
CHANGE.DIST.FLAG = 0
HUSH.COMPILE.FLAG = 0
CHECKED.ALGORITHM = 0
COMPILED.ALGORITHM = 0
CREATED.DISTFILE = 0
DEBUG.MODE = 0
pos = 1
NumPartfiles = -1
* Keywords
K.DATA = 63
K.FORCE = 65
K.RETAIN = 277
K.CANCEL = 285
K.ADDING = 312
K.REMOVING = 313
K.SYSTEM = 314
K.INTERNAL = 315
K.EXTERNAL = 316
K.MULTIVOLUME = 605
Keywords = "DATA": @FM: "FORCE": @FM: "RETAIN": @FM
Keywords := "CANCEL": @FM: "ADDING": @FM: "REMOVING": @FM
Keywords := "SYSTEM": @FM: "INTERNAL": @FM: "EXTERNAL":@FM:"MULTIVOLUME"
* Modes
MODE = 0
M.NULL = 0
M.ADDING = 1
M.REMOVING = 2
M.CANCEL = 3
CURRENT.MODE = 0
DistFile = ""
DistPath = ""
PartFile = ""
PartPath = ""
OpArray = ""
PartNumber = ""
OldPartNumber = ""
PartAlgorithm = ""
SaveAlgorithm = ""
OldAlgorithm = ""
SYSTEM.SEPARATOR = ""
DEFAULT.SEPARATOR = "-"
INTERNAL.ITYPE = ""
EXT.ITYPE.P1 = 'SUBR("-EXTERNALG","'
EXT.ITYPE.P2 = '",@ID,LEN(@ID),0)'
MULTIVOL.ITYPE.P1 = 'SUBR("-EXTERNALG","",@ID,LEN(@ID),'
MULTIVOL.ITYPE.P2 = ')'
AT.PART.ALGORITHM = "@PART.ALGORITHM"
AT.PART.COMPILE = "@PART.COMPILE"
COPY.PHRASE = " @PART.COMPILE, @PART.ALGORITHM OVERWRITING DELETING"
DEFAULT.ALGORITHM = "IF INDEX( @ID, '-', 1 ) THEN "
DEFAULT.ALGORITHM := "FIELD( @ID, '-', 1 ) ELSE 'ERROR'"
*
* Housekeeping
*
OPEN "&PARTFILES&" to part.fv ELSE
CALL *UVPRINTMSG(010572,"&PARTFILES&")
STOP
END
OPEN "VOC" to voc.fv ELSE
CALL *UVPRINTMSG(001720,'')
CLOSE part.fv
STOP
END
execute OS.EXEC:" '":PWD.CMD:"'" capturing CWD
CWD = CWD<1>
AccountName = @WHO
AccountPath = CWD
*
* Create command line tokens
*
sentence = TRIM( @SENTENCE )
Verb = field( sentence, " ", 1 )
DIM Tokens( DCOUNT( sentence, " " ) )
MATPARSE Tokens FROM sentence, " "
NumTokens = INMAT()
IF NumTokens < 2 THEN
CALL *UVPRINTMSG(010591,'')
GOSUB abort.define
STOP
END
IF Tokens(2) = "DATA" THEN
DATA.FLAG = 1
CurPos = 3
END
ELSE
CurPos = 2
END
IF DATA.FLAG AND NumTokens < 3 THEN
CALL *UVPRINTMSG(010585,"DATA")
GOSUB abort.define
STOP
END
*
* Get the Distributed (or Part) filename
*
Filename = Tokens(CurPos) ; CurPos += 1
FOR i = 1 to DCOUNT( Keywords, @FM )
IF Filename = Keywords<i> THEN
CALL *UVPRINTMSG(010604,Keywords<i>)
GOSUB abort.define
END
NEXT i
READ VocRec FROM voc.fv, Filename THEN
VocType = UPCASE( VocRec[1,1] )
IF VocType # "F" AND VocType # "Q" THEN
CALL *UVPRINTMSG(010565,Filename:@FM:VocType)
GOSUB abort.define
END
ASSIGN 1 to SYSTEM(223)
ASSIGN 1 to SYSTEM(224)
OPEN Filename to fv ELSE
CALL *UVPRINTMSG(010572,Filename)
GOSUB abort.define
END
STATUS StatusArray FROM fv ELSE
CALL *UVPRINTMSG(010571,Filename)
CLOSE fv
GOSUB abort.define
END
CLOSE fv
IF StatusArray<21> = 27 THEN
DistFile = Filename
DistPath = StatusArray<27>
END
ELSE
PartFile = Filename
PartPath = StatusArray<27>
END
END
ELSE
CREATE.FLAG = 1
DistFile = Filename
END
*
* No options specified
*
IF Verb EQ "DEFINE.DF" THEN
IF CurPos > NumTokens AND (DistFile EQ "" OR CREATE.FLAG = 0) THEN
CALL *UVPRINTMSG(010592,'')
GOSUB abort.define
END
IF CurPos > NumTokens AND CREATE.FLAG = 1 THEN
PartRec = ""
SYSTEM.SEPARATOR = "-"
GOSUB create.dist.file
lpos = 0
READU DistRec FROM part.fv,DistPath ELSE NULL
DistRec = ""
LOCATE DistPath IN PartRec <6,1> SETTING lpos ELSE NULL
DistRec<1,lpos>= DistFile
DistRec<2> = AccountName
DistRec<3> = "Distributed"
DistRec<4> = SaveAlgorithm
DistRec<5> = AccountPath
WRITE DistRec ON part.fv, DistPath
RELEASE fv.part
CLOSE fv.voc
CLOSE fv.part
STOP
END
END
ELSE
* LIST.DF, REBUILD.DF or VERIFY.DF specified
IF CurPos > NumTokens THEN GOSUB df.maint
END
*
* Parse command line arguments
*
LOOP
CurToken = Tokens(CurPos)
READ VocRec FROM voc.fv, CurToken THEN VocEntry = 1 ELSE VocEntry = 0
VocType = UPCASE( VocRec[1,1] )
BEGIN CASE
CASE VocType = "F" OR VocType = "Q"
IF Verb NE "DEFINE.DF" THEN
CALL *UVPRINTMSG(010582,Verb)
GOSUB abort.define
END
OPEN CurToken TO temp.fv ELSE
CALL *UVPRINTMSG(010572,CurToken)
GOSUB abort.define
END
STATUS StatusArray FROM temp.fv ELSE
CALL *UVPRINTMSG(010571,CurToken)
GOSUB abort.define
END
CLOSE temp.fv
IF StatusArray<21> = 27 THEN
CALL *UVPRINTMSG(010563,CurToken)
GOSUB abort.define
END
IF StatusArray<21> = 1 OR StatusArray<21> = 19 THEN
CALL *UVPRINTMSG(010581,CurToken)
GOSUB abort.define
END
OpArray<pos,1> = MODE
OpArray<pos,2> = CurToken
OpArray<pos,4> = StatusArray<24>
IF CurPos < NumTokens THEN
IF NUM( Tokens( CurPos+1 ) ) THEN
CurPos += 1
OpArray<pos,3> = Tokens( CurPos )
END
END
pos += 1
CASE VocType = "K"
KeyNum = VocRec<2>
IF KeyNum = K.DATA THEN
IF CurPos = 2 THEN DATA.FLAG = 1
END
IF KeyNum = K.ADDING THEN
IF Verb NE "DEFINE.DF" THEN
CALL *UVPRINTMSG(010603,"ADDING":@FM:Verb)
GOSUB abort.define
END
MODE = M.ADDING
IF ADDING.FLAG THEN
CALL *UVPRINTMSG(010587,"ADDING")
GOSUB abort.define
END
ADDING.FLAG = 1
END
IF KeyNum = K.REMOVING THEN
IF Verb NE "DEFINE.DF" THEN
CALL *UVPRINTMSG(010603,"REMOVING":@FM:Verb)
GOSUB abort.define
END
IF CREATE.FLAG THEN
CALL *UVPRINTMSG(010580,"REMOVING")
GOSUB abort.define
END
MODE = M.REMOVING
IF REMOVING.FLAG THEN
CALL *UVPRINTMSG(010587,"REMOVING")
GOSUB abort.define
END
REMOVING.FLAG = 1
END
IF KeyNum = K.CANCEL THEN
IF Verb NE "DEFINE.DF" THEN
CALL *UVPRINTMSG(010603,"CANCEL":@FM:Verb)
GOSUB abort.define
END
MODE = M.CANCEL
IF CANCEL.FLAG THEN
CALL *UVPRINTMSG(010587,"CANCEL")
GOSUB abort.define
END
IF ADDING.FLAG THEN
CALL *UVPRINTMSG(010564,"ADDING":@FM:"CANCEL")
GOSUB abort.define
END
IF REMOVING.FLAG THEN
CALL *UVPRINTMSG(010564,"REMOVING":@FM:"CANCEL")
GOSUB abort.define
END
IF CREATE.FLAG THEN
CALL *UVPRINTMSG(010606,DistFile)
GOSUB abort.define
END
IF DistFile THEN
CALL *UVPRINTMSG(010566,"CANCEL")
GOSUB abort.define
END
IF NOT( PartFile ) THEN
CALL *UVPRINTMSG(010585,"CANCEL")
GOSUB abort.define
END
IF NumTokens > CurPos THEN
CALL *UVPRINTMSG(010583,"CANCEL")
GOSUB abort.define
END
CANCEL.FLAG = 1
GOSUB cancel.partblock
END
IF KeyNum = K.FORCE THEN
IF Verb NE "DEFINE.DF" THEN
CALL *UVPRINTMSG(010603,"FORCE":@FM:Verb)
GOSUB abort.define
END
FORCE.FLAG = 1
END
IF KeyNum = K.RETAIN THEN
IF Verb NE "DEFINE.DF" THEN
CALL *UVPRINTMSG(010603,"RETAIN":@FM:Verb)
GOSUB abort.define
END
RETAIN.FLAG = 1
END
IF KeyNum = K.SYSTEM THEN
GOSUB get.system.algorithm
IF Verb NE "DEFINE.DF" THEN GOSUB df.maint
END
IF KeyNum = K.INTERNAL THEN
GOSUB get.internal.algorithm
IF Verb NE "DEFINE.DF" THEN GOSUB df.maint
END
IF KeyNum = K.EXTERNAL THEN
GOSUB get.external.algorithm
IF Verb NE "DEFINE.DF" THEN GOSUB df.maint
END
IF KeyNum = K.MULTIVOLUME THEN
IF system(1001) = 64 THEN
GOSUB get.multivol.algorithm
IF Verb NE "DEFINE.DF" THEN GOSUB df.maint
END
ELSE
CALL *UVPRINTMSG(001608,CurToken)
GOSUB abort.define
END
END
CASE 1
CALL *UVPRINTMSG(001608,CurToken)
GOSUB abort.define
END CASE
CurPos += 1
UNTIL CurPos > NumTokens REPEAT
*
* Main Loop
*
IF DEBUG.MODE THEN GOSUB print.debug
DistRec = ""
IF DistFile THEN
READU DistRec FROM part.fv, DistPath THEN NULL ELSE NULL
END
FOR op = 1 to DCOUNT( OpArray, @FM )
CURRENT.MODE = 0
BEGIN CASE
CASE Verb = "LIST.DF" OR Verb = "REBUILD.DF" OR Verb = "VERIFY.DF"
GOSUB df.maint
CASE op = 1 AND OpArray<op,1> = M.NULL AND CREATE.FLAG = 0
OPEN DistFile to dist.fv ELSE
CALL *UVPRINTMSG(010572,DistFile)
GOSUB abort.define
END
STATUS StatusArray FROM dist.fv ELSE
CALL *UVPRINTMSG(010571,DistFile)
GOSUb abort.define
END
Partfiles = RAISE(StatusArray<26>)
* Check if file supplied exists
pos = 0
LOCATE OpArray<op,2> IN Partfiles <1> SETTING pos ELSE
CALL *UVPRINTMSG(010601,"ADDING")
CURRENT.MODE = -1
GOSUB abort.define
END
IF OpArray<op,3> OR PartAlgorithm THEN
GOSUB change.part.file
END
ELSE
CALL *UVPRINTMSG(010590,DistFile)
GOSUB abort.define
END
CASE OpArray<op,1> = M.NULL
PartFile = OpArray<op,2>
PartNumber = OpArray<op,3>
CURRENT.MODE = M.ADDING
GOSUB add.part.file
CASE OpArray<op,1> = M.ADDING
PartFile = OpArray<op,2>
PartNumber = OpArray<op,3>
CURRENT.MODE = M.ADDING
GOSUB add.part.file
CASE OpArray<op,1> = M.REMOVING
PartFile = OpArray<op,2>
PartNumber = OpArray<op,3>
CURRENT.MODE = M.REMOVING
GOSUB remove.part.file
CASE 1
CALL *UVPRINTMSG(010584,OpArray<op,1>)
CURRENT.MODE = -1
GOSUB abort.define
END CASE
NEXT op
*
* Check for request to change Distributed File algorithm
*
IF OpArray EQ "" AND DistFile THEN
GOSUB change.dist.file
END
*
* Remove Distributed File if all partfiles have been removed
*
IF NumPartfiles = 0 THEN
execute "DELETE.FILE ": DistFile capturing output
IF output<1>[1,6] = "DELETE" THEN
print
print "Removing Distributed File ": quote( DistFile )
FOR i = 2 to DCOUNT( output, @FM )
print output<i>
NEXT i
END
ELSE
print output
END
* Remove the &PARTFILES& entry too
DELETE part.fv, DistPath
END
RELEASE part.fv
CLOSE voc.fv
CLOSE part.fv
STOP
*
* Subroutine to close files and exit in case we need to abort
*
abort.define:
RELEASE part.fv
CLOSE voc.fv
CLOSE part.fv
STOP
RETURN
*
* Subroutine to ADD a Part file
*
add.part.file:
IF PartFile = "VOC" THEN
CALL *UVPRINTMSG(010608,"VOC")
GOSUB abort.define
END
OPEN PartFile TO fv ELSE
CALL *UVPRINTMSG(010605,DistFile)
CALL *UVPRINTMSG(010572,PartFile)
GOSUB abort.define
END
STATUS StatusArray FROM fv ELSE
CALL *UVPRINTMSG(010605,DistFile)
CALL *UVPRINTMSG(010571,PartFile)
GOSUB abort.define
END
CLOSE fv
PartPath = StatusArray<27>
OldPartNumber = StatusArray<24>
PartRec = ""
READU PartRec FROM part.fv, PartPath THEN NULL ELSE NULL
GOSUB check.part.number
GOSUB check.part.algorithm
IF CREATE.FLAG = 1 THEN GOSUB create.dist.file
GOSUB compile.dict
command = "DF.MODIFY -d ": DistFile: " "
command := "-o ADDING -p ": PartFile: " -n ": PartNumber
ReturnCode = 0
execute command returning ReturnCode
IF ReturnCode LT 0 THEN GOSUB abort.define
NumPartfiles = ReturnCode
lpos = 0
LOCATE DistPath IN PartRec <6,1> SETTING lpos ELSE NULL
PartRec<1,lpos> = DistFile
PartRec<2> = AccountName
PartRec<3> = PartNumber
PartRec<4> = SaveAlgorithm
PartRec<5> = AccountPath
PartRec<6,lpos> = DistPath
WRITE PartRec ON part.fv, PartPath
DistRec<1> = DistFile
DistRec<2> = AccountName
DistRec<3> = "Distributed"
DistRec<4> = SaveAlgorithm
DistRec<5> = AccountPath
WRITE DistRec ON part.fv, DistPath
RETURN
*
* Subroutine to REMOVE a Part file
*
remove.part.file:
OPEN PartFile TO fv ELSE
CALL *UVPRINTMSG(010605,DistFile)
CALL *UVPRINTMSG(010572,PartFile)
GOSUB abort.define
END
STATUS StatusArray FROM fv ELSE
CALL *UVPRINTMSG(010605,DistFile)
CALL *UVPRINTMSG(010571,PartFile)
CLOSE fv
GOSUB abort.define
END
PartPath = StatusArray<27>
PartRec = ""
READU PartRec FROM part.fv, PartPath THEN NULL ELSE NULL
* check if part file marked for replication, if so, cancel operation
IF PartRec<7> = "R" Then
CALL *UVPRINTMSG(010614,PartFile)
GOSUB abort.define
End
* Check if this part file belongs to more than one Distributed File
IF DCOUNT( PartRec<1>, @VM ) > 1 THEN
multiple.files = 1
END
ELSE
multiple.files = 0
END
command = "DF.MODIFY -d ": DistFile: " "
IF RETAIN.FLAG OR multiple.files THEN command := " -r "
command := "-o REMOVING -p ": PartFile
IF PartNumber THEN command := " -n ": PartNumber
ReturnCode = 0
execute command returning ReturnCode
IF ReturnCode LT 0 THEN GOSUB abort.define
NumPartfiles = ReturnCode
IF multiple.files THEN
LOCATE DistPath IN PartRec <6,1> SETTING lpos ELSE NULL
DEL PartRec <1,lpos>
DEL PartRec <6,lpos>
WRITE PartRec ON part.fv, PartPath
END
ELSE
DELETE part.fv, PartPath
END
RETURN
*
* Remove partitioning algorithm and part number from a Partfile
*
cancel.partblock:
CALL *UVPRINTMSG(010600,PartFile)
command = "DF.MODIFY -p ": PartFile: " -x "
ReturnCode = 0
execute command returning ReturnCode
IF ReturnCode LT 0 THEN GOSUB abort.define
CALL *UVPRINTMSG(010599,'')
OPEN PartFile TO fv ELSE
CALL *UVPRINTMSG(010572,PartFile)
GOSUB abort.define
END
STATUS StatusArray FROM fv ELSE
CALL *UVPRINTMSG(010571,PartFile)
CLOSE fv
GOSUB abort.define
END
CLOSE fv
PartPath = StatusArray<27>
PartRec = ""
READU PartRec FROM part.fv, PartPath THEN
DELETE part.fv, PartPath
END
RETURN
*
* Subroutine to change the partitioning algorithm in a Distributed file
*
change.dist.file:
CHANGE.DIST.FLAG = 1
PartRec = ""
GOSUB check.part.algorithm
OldAlgorithm = DistRec<4>
IF OldAlgorithm = SaveAlgorithm THEN
CALL *UVPRINTMSG(010588,DistFile)
GOSUB abort.define
END
GOSUB compile.dict
command = "DF.MODIFY -d ": DistFile: " "
command := "-o CHANGING"
ReturnCode = 0
execute command returning ReturnCode
IF ReturnCode LT 0 THEN GOSUB abort.define
* Update &PARTFILES&
CALL *UVPRINTMSG(010602,'')
OPEN DistFile TO dist.fv ELSE
CALL *UVPRINTMSG(010574,DistFile)
GOSUB abort.define
END
STATUS DistStatusArray FROM dist.fv ELSE
CALL *UVPRINTMSG(010571,DistFile)
CLOSE dist.fv
GOSUB abort.define
END
CLOSE dist.fv
FOR i = 1 TO DCOUNT( DistStatusArray<26>, @VM )
PartFile = DistStatusArray<26,i>
OPEN PartFile TO fv ELSE
CALL *UVPRINTMSG(010575,PartFile)
GOSUB abort.define
END
STATUS PartStatusArray FROM fv ELSE
CALL *UVPRINTMSG(010571,PartFile)
CLOSE fv
GOSUB abort.define
END
PartPath = PartStatusArray<27>
PartRec = ""
READU PartRec FROM part.fv, PartPath ELSE
CALL *UVPRINTMSG(010577,'')
CLOSE fv
GOSUB abort.define
END
CLOSE fv
PartRec<4> = SaveAlgorithm
WRITE PartRec ON part.fv, PartPath
NEXT i
DistRec<4> = SaveAlgorithm
WRITE DistRec ON part.fv, DistPath
RETURN
GOSUB check.part.algorithm
OPEN "DICT", DistFile to dict.fv else
CALL *UVPRINTMSG(010573,DistFile)
GOSUB abort.define
END
READU DictRec FROM dict.fv, AT.PART.ALGORITHM ELSE
CALL *UVPRINTMSG(010576,DistFile)
GOSUB abort.define
END
OldAlgorithm = DictRec<2>
CLOSE dict.fv
IF OldAlgorithm = PartAlgorithm THEN
CALL *UVPRINTMSG(010593,'')
GOSUB abort.define
END
CALL *UVPRINTMSG(010569,OldAlgorithm:@FM:PartAlgorithm)
GOSUB compile.dict
DistRec<1> = DistFile
DistRec<2> = AccountName
DistRec<3> = "Distributed"
DistRec<4> = SaveAlgorithm
DistRec<5> = AccountPath
WRITE DistRec ON part.fv, DistPath
RETURN
*
* Subroutine to change the partitioning information in a Part file
*
change.part.file:
CHANGE.PART.FLAG = 1
PartFile = OpArray<op,2>
OPEN PartFile to fv ELSE
CALL *UVPRINTMSG(010572,PartFile)
GOSUB abort.define
END
STATUS StatusArray FROM fv ELSE
CALL *UVPRINTMSG(010571,PartFile)
CLOSE fv
GOSUB abort.define
END
CLOSE fv
PartPath = StatusArray<27>
PartRec = ''
READU PartRec from part.fv, PartPath ELSE
CALL *UVPRINTMSG(010577,'')
GOSUB abort.define
END
* check if part file marked for replication, if so, cancel operation
IF PartRec<7> = "R" Then
CALL *UVPRINTMSG(010614,PartFile)
GOSUB abort.define
End
BEGIN CASE
CASE PartAlgorithm AND OpArray<op,3>
* Changing partitioning algorithm and part number
IF OpArray<op,4> EQ OpArray<op,3> THEN
CALL *UVPRINTMSG(010589,PartFile)
GOSUB abort.define
END
CALL *UVPRINTMSG(010562,OpArray<op,3>:@FM:PartFile)
GOSUB check.part.algorithm
OldAlgorithm = PartRec<4>
IF OldAlgorithm = SaveAlgorithm THEN
CALL *UVPRINTMSG(010588,PartFile)
GOSUB abort.define
END
GOSUB compile.dict
PartNumber = OpArray<op,3>
command = "DF.MODIFY -d ": DistFile: " "
command := "-o CHANGING -p ": PartFile: " -n ": PartNumber
ReturnCode = 0
execute command returning ReturnCode
IF ReturnCode LT 0 THEN GOSUB abort.define
PartRec<3> = PartNumber
PartRec<4> = SaveAlgorithm
CASE OpArray<op,3>
* Changing part number only
IF OpArray<op,4> EQ OpArray<op,3> THEN
CALL *UVPRINTMSG(010589,PartFile)
GOSUB abort.define
END
PartNumber = OpArray<op,3>
PartAlgorithm = PartRec<4>
HUSH.COMPILE.FLAG = 1
CALL *UVPRINTMSG(010578,'')
GOSUB check.part.algorithm
GOSUB compile.dict
command = "DF.MODIFY -d ": DistFile: " "
command := "-o CHANGING -p ": PartFile: " -n ": PartNumber
ReturnCode = 0
execute command returning ReturnCode
IF ReturnCode LT 0 THEN GOSUB abort.define
PartRec<3> = PartNumber
CASE PartAlgorithm
* Changing partitioning algorithm only
GOSUB check.part.algorithm
OldAlgorithm = PartRec<4>
IF OldAlgorithm = SaveAlgorithm THEN
CALL *UVPRINTMSG(010588,PartFile)
GOSUB abort.define
END
GOSUB compile.dict
PartNumber = OpArray<op,3>
command = "DF.MODIFY -d ": DistFile: " "
command := "-o CHANGING -p ": PartFile
ReturnCode = 0
execute command returning ReturnCode
IF ReturnCode LT 0 THEN GOSUB abort.define
PartRec<4> = SaveAlgorithm
END CASE
WRITE PartRec ON part.fv, PartPath
RETURN
*
* Subroutine to verify the partitioning algorithm
*
check.part.algorithm:
IF CHECKED.ALGORITHM THEN RETURN ELSE CHECKED.ALGORITHM = 1
* If no partioning algorithm has been supplied, use
* the algorithm contained for this Part file in
* &PARTFILES&
IF NOT( PartAlgorithm ) THEN PartAlgorithm = PartRec<4>
* If there is no Part file entry in &PARTFILES&, use
* the Distributed File entry in &PARTFILES&
IF NOT( PartAlgorithm ) THEN PartAlgorithm = DistRec<4>
* If there still isn't a partitioning algorithm, abort!
IF NOT( PartAlgorithm ) THEN
CALL *UVPRINTMSG(010598,'')
GOSUB abort.define
END
* Check for SYSTEM algorithm
PartAlgorithm = TRIM( PartAlgorithm )
SaveAlgorithm = PartAlgorithm
IF FIELD( PartAlgorithm, " ", 1 ) = "SYSTEM" THEN
sep = FIELD( PartAlgorithm, " ", 2 )
PartAlgorithm = "IF INDEX( @ID, ": SQUOTE( sep ): ", 1 ) THEN "
PartAlgorithm := "FIELD( @ID, ": SQUOTE( sep ): ", 1 ) "
PartAlgorithm := "ELSE 'ERROR'"
END
* Make sure partitioning algorithms are consistent in Part file
IF PartRec<4> AND NOT(CHANGE.PART.FLAG) THEN
IF PartRec<4> NE SaveAlgorithm AND PartRec<4> NE PartAlgorithm THEN
IF DistFile THEN DISPFN=DistFile ELSE DISPFN=PartFile
CALL *UVPRINTMSG(010559,DISPFN)
IF NOT( FORCE.FLAG ) AND OpArray NE "" THEN
IF CHANGE.PART.FLAG THEN
CALL *UVPRINTMSG(010595,PartFile)
END
ELSE IF CHANGE.DIST.FLAG THEN
CALL *UVPRINTMSG(010579,DistFile)
END
ELSE
CALL *UVPRINTMSG(010594,PartFile)
END
GOSUB abort.define
END
IF NOT( FORCE.FLAG ) AND OpArray EQ "" THEN
CALL *UVPRINTMSG(010597,'')
GOSUB abort.define
END
RETURN
END
END
* Make sure partitioning algorithms are consistent in Distributed file
IF DistRec<4> AND NOT(CHANGE.DIST.FLAG) THEN
IF DistRec<4> NE SaveAlgorithm AND DistRec<4> NE PartAlgorithm THEN
IF DistFile THEN DISPFN=DistFile ELSE DISPFN=PartFile
CALL *UVPRINTMSG(010560,DISPFN)
IF NOT( FORCE.FLAG ) AND OpArray NE "" THEN
IF CHANGE.PART.FLAG THEN
CALL *UVPRINTMSG(010595,PartFile)
END
ELSE IF CHANGE.DIST.FLAG THEN
CALL *UVPRINTMSG(010579,DistFile)
END
ELSE
CALL *UVPRINTMSG(010594,PartFile)
END
GOSUB abort.define
END
IF NOT( FORCE.FLAG ) AND OpArray EQ "" THEN
CALL *UVPRINTMSG(010597,'')
GOSUB abort.define
END
END
END
RETURN
*
*
*
check.system.algorithm:
* Check for SYSTEM algorithm
PartAlgorithm = TRIM( PartAlgorithm )
SaveAlgorithm = PartAlgorithm
IF FIELD( PartAlgorithm, " ", 1 ) = "SYSTEM" THEN
sep = FIELD( PartAlgorithm, " ", 2 )
PartAlgorithm = "IF INDEX( @ID, ": SQUOTE( sep ): ", 1 ) THEN "
PartAlgorithm := "FIELD( @ID, ": SQUOTE( sep ): ", 1 ) "
PartAlgorithm := "ELSE 'ERROR'"
END
RETURN
*
* Subroutine to check part number
*
check.part.number:
* if no part number has been supplied and the file
* doesn't already have a part number, then abort.
*
IF NOT( PartNumber ) AND NOT( OldPartNumber ) THEN
CALL *UVPRINTMSG(010605,DistFile)
CALL *UVPRINTMSG(010596,PartFile)
GOSUB abort.define
END
* if the file doesn't already have a part number, return
*
IF NOT( OldPartNumber ) THEN RETURN
* if no Part number supplied, use the old Part number
*
IF NOT( PartNumber ) THEN
PartNumber = OldPartNumber
RETURN
END
* check if the part number supplied matches the part number
* found in the file's internal Partblock
*
IF PartNumber NE OldPartNumber THEN
CALL *UVPRINTMSG(010558,PartFile:@FM:OldPartNumber:char(7))
IF NOT( FORCE.FLAG ) THEN
IF CURRENT.MODE = M.ADDING THEN CALL *UVPRINTMSG(010609,PartFile)
GOSUB abort.define
END
END
RETURN
*
*
*
compile.dict:
* If the partitioning algorithm has already been compiled then
* return
IF COMPILED.ALGORITHM THEN RETURN
OPEN "DICT", DistFile TO dict.fv ELSE
CALL *UVPRINTMSG(010573,DistFile)
GOSUB abort.define
STOP
END
IF CREATE.FLAG = 1 AND SYSTEM.SEPARATOR = "-" THEN
CALL *UVPRINTMSG(010586,DistFile)
PartAlgorithm = DEFAULT.ALGORITHM
END
* Write Itype to dictionary
READU WriteRec FROM dict.fv, AT.PART.ALGORITHM ELSE NULL
WriteRec = "I": @FM: PartAlgorithm
WRITE WriteRec TO dict.fv, AT.PART.ALGORITHM
CLOSE dict.fv
execute "CD ": DistFile: " ": AT.PART.ALGORITHM capturing output
* Compile the Itype
execute "CD ": DistFile: " ": AT.PART.ALGORITHM capturing output
IF NOT(HUSH.COMPILE.FLAG) THEN
FOR i = 1 to COUNT( output, @FM )
print output<i>
NEXT i
END
* Check for failed compilation of Itype
output.lines = dcount( output, @FM )
IF output<2>[1,5] = "Word " OR output.lines > 3 THEN
CALL *UVPRINTMSG(010594,PartFile)
GOSUB abort.define
END
COMPILED.ALGORITHM = 1
RETURN
*
* Subroutine to create the Distributed File
*
create.dist.file:
* If the Distributed File has been created then return
IF CREATED.DISTFILE THEN RETURN
IF DistFile = "VOC" THEN
CALL *UVPRINTMSG(010610,"VOC")
GOSUB abort.define
END
command = "CREATE.FILE DATA ": DistFile: " DISTRIBUTED"
execute command returning ReturnCode capturing output
IF ReturnCode = -1 THEN GOSUB abort.define
execute "CREATE.FILE DICT ": DistFile: " DYNAMIC" returning ReturnCode
IF ReturnCode = -1 THEN GOSUB abort.define
GOSUB compile.dict
ASSIGN 1 to SYSTEM(223)
OPEN DistFile TO fv ELSE
CALL *UVPRINTMSG(010572,DistFile)
GOSUB abort.define
END
STATUS StatusArray FROM fv ELSE
CALL *UVPRINTMSG(010605,DistFile)
CALL *UVPRINTMSG(010571,DistFile)
CLOSE fv
GOSUB abort.define
END
CLOSE fv
DistPath = StatusArray<27>
CREATED.DISTFILE = 1
RETURN
*
* Subroutine to retrieve the MULTIVOLUME partitioning algorithm
*
get.multivol.algorithm:
IF Verb NE "DEFINE.DF" AND Verb NE "REBUILD.DF" THEN
CALL *UVPRINTMSG(010603,"MULTIVOLUME":@FM:Verb)
GOSUB abort.define
END
CurPos += 1
IF CurPos > NumTokens THEN
CALL *UVPRINTMSG(010612,'')
GOSUB abort.define
END
NumVols = Tokens(CurPos)
IF NOT(NumVols MATCHES '1N0N') THEN
CALL *UVPRINTMSG(010612,'')
GOSUB abort.define
END
PartAlgorithm = MULTIVOL.ITYPE.P1:NumVols:MULTIVOL.ITYPE.P2
RETURN
*
* Subroutine to retrieve the EXTERNAL partitioning algorithm
*
get.external.algorithm:
IF Verb NE "DEFINE.DF" AND Verb NE "REBUILD.DF" THEN
CALL *UVPRINTMSG(010603,"EXTERNAL":@FM:Verb)
GOSUB abort.define
END
CurPos += 1
IF CurPos > NumTokens THEN
CALL *UVPRINTMSG(010613,'')
GOSUB abort.define
END
ExtAlg = Tokens(CurPos)
PartAlgorithm = EXT.ITYPE.P1:ExtAlg:EXT.ITYPE.P2
RETURN
*
* Subroutine to retrieve the INTERNAL partitioning algorithm
*
get.internal.algorithm:
IF Verb NE "DEFINE.DF" AND Verb NE "REBUILD.DF" THEN
CALL *UVPRINTMSG(010603,"INTERNAL":@FM:Verb)
GOSUB abort.define
END
CurPos += 1
IF CurPos > NumTokens THEN
CALL *UVPRINTMSG(010568,'')
GOSUB abort.define
END
DICT = "DICT"
IF UPCASE( Tokens(CurPos) ) = "DATA" THEN
DICT = "" ; CurPos += 1
IF CurPos > NumTokens THEN
CALL *UVPRINTMSG(010568,'')
GOSUB abort.define
END
END
VocRec = ""
READU VocRec FROM voc.fv, Tokens(CurPos) THEN NULL ELSE NULL
VocType = VocRec<1>[1,1]
Q = Tokens(CurPos)[1,1]
BEGIN CASE
CASE Q EQ "'" OR Q EQ '"'
* Algorithm specified on command line
GOSUB get.itype
CASE VocType = "F" OR VocType = "Q"
* Algorithm contained in File
Filename = Tokens(CurPos) ; CurPos += 1
IF CurPos > NumTokens THEN
CALL *UVPRINTMSG(010567,Filename)
GOSUB abort.define
END
OPEN DICT, Filename to fv ELSE
DFNAME=DICT:" ":Filename
CALL *UVPRINTMSG(010572,DFNAME)
GOSUB abort.define
END
id = Tokens(CurPos) ; CurPos += 1
READ TempRec FROM fv, id ELSE
DFNAME=DICT:" ":Filename
CALL *UVPRINTMSG(010561,id:@FM:DFNAME)
CLOSE fv
GOSUB abort.define
END
CLOSE fv
IF TempRec<1> # "I" THEN
CALL *UVPRINTMSG(040063,id)
GOSUB abort.define
END
INTERNAL.ITYPE = TempRec<2>
CASE VocType = "I"
* Algorithm contained in VOC
INTERNAL.ITYPE = VocRec<2>
CASE 1
* Algorithm specified on command line
GOSUB get.itype
END CASE
PartAlgorithm = INTERNAL.ITYPE
RETURN
*
* Subroutine to retrieve the SYSTEM partitioning algorithm
*
get.system.algorithm:
IF Verb NE "DEFINE.DF" AND Verb NE "REBUILD.DF" THEN
CALL *UVPRINTMSG(010603,"SYSTEM":@FM:Verb)
GOSUB abort.define
END
IF (CurPos+1) > NumTokens THEN
SYSTEM.SEPARATOR = DEFAULT.SEPARATOR
PartAlgorithm = "SYSTEM ": DEFAULT.SEPARATOR
RETURN
END
IF UPCASE( Tokens(CurPos+1) ) = "FORCE" THEN
SYSTEM.SEPARATOR = DEFAULT.SEPARATOR
PartAlgorithm = "SYSTEM ": DEFAULT.SEPARATOR
RETURN
END
IF UPCASE( Tokens(CurPos+1) ) = "RETAIN" THEN
SYSTEM.SEPARATOR = DEFAULT.SEPARATOR
PartAlgorithm = "SYSTEM ": DEFAULT.SEPARATOR
RETURN
END
CurPos += 1
SYSTEM.SEPARATOR = Tokens(CurPos)
IF LEN(SYSTEM.SEPARATOR) > 1 THEN
CALL *UVPRINTMSG(010570,SYSTEM.SEPARATOR)
GOSUB abort.define
END
PartAlgorithm = "SYSTEM ": SYSTEM.SEPARATOR
RETURN
*
* Subroutine to get I-descriptor off command line
*
get.itype:
* Q is set to the first character of the current token
* If the first character is not a quote then the Itype
* is assummed to contain no spaces (1 token).
IF Q NE "'" AND Q NE '"' THEN
INTERNAL.ITYPE = Tokens(CurPos)
RETURN
END
CheckToken = Tokens(CurPos) ; * Strip leading quote
CheckToken = CheckToken[2,len(CheckToken)-1]
end.quote = 0 ; last.token = 0
LOOP
IF CheckToken[len(CheckToken),1] = Q THEN
CheckToken = CheckToken[1,len(CheckToken)-1] ; * Strip trailing quote
end.quote = 1
END
INTERNAL.ITYPE := CheckToken: " "
IF CurPos = NumTokens THEN
last.token = 1
END
IF NOT( last.token ) AND NOT( end.quote ) THEN
CurPos += 1
CheckToken = Tokens(CurPos)
END
UNTIL end.quote OR last.token REPEAT
RETURN
*
* Subroutine to print OpArray table in DEBUG mode
*
print.debug:
FOR i = 1 TO DCOUNT( OpArray, @FM )
PRINT "Mode = ": OpArray<i,1>: ", File = ": OpArray<i,2>:
PRINT ", Number = ": OpArray<i,3>
NEXT i
PRINT "Algorithm = ": PartAlgorithm
PRINT "DATA = ": DATA.FLAG
PRINT "CREATE = ": CREATE.FLAG
PRINT "FORCE = ": FORCE.FLAG
PRINT "RETAIN = ": RETAIN.FLAG
RETURN
df.maint:
BEGIN CASE
CASE Verb = "LIST.DF"
IF PartFile THEN
CALL *UVPRINTMSG(010611,PartFile)
GOSUB abort.define
END
IF CREATE.FLAG = 1 THEN
CALL *UVPRINTMSG(010606,DistFile)
GOSUB abort.define
END
command = "DF.MODIFY -d ": DistFile: " -o LIST"
ReturnCode = 0
execute command returning ReturnCode
IF ReturnCode LT 0 THEN GOSUB abort.define
CASE Verb = "REBUILD.DF"
IF PartFile THEN
CALL *UVPRINTMSG(010611,PartFile)
GOSUB abort.define
END
IF CREATE.FLAG = 1 THEN
CALL *UVPRINTMSG(010606,DistFile)
GOSUB abort.define
END
* If there is no partitioning algorithm, abort!
IF NOT( PartAlgorithm ) THEN
CALL *UVPRINTMSG(010598,'')
GOSUB abort.define
END
GOSUB check.system.algorithm
GOSUB compile.dict
command = "DF.MODIFY -d ": DistFile: " -o REBUILD"
ReturnCode = 0
execute command returning ReturnCode
IF ReturnCode LT 0 THEN GOSUB abort.define
* Check all the Partfiles
CALL *UVPRINTMSG(010602,'')
OPEN DistFile TO dist.fv ELSE
CALL *UVPRINTMSG(010574,DistFile)
GOSUB abort.define
END
STATUS DistStatusArray FROM dist.fv ELSE
CALL *UVPRINTMSG(010571,DistFile)
CLOSE dist.fv
GOSUB abort.define
END
CLOSE dist.fv
FOR i = 1 TO DCOUNT( DistStatusArray<26>, @VM )
PartFile = DistStatusArray<26,i>
OPEN PartFile TO fv ELSE
CALL *UVPRINTMSG(010575,PartFile)
GOSUB abort.define
END
STATUS PartStatusArray FROM fv ELSE
CALL *UVPRINTMSG(010571,PartFile)
CLOSE fv
GOSUB abort.define
END
PartPath = PartStatusArray<27>
PartRec = ""
READU PartRec FROM part.fv, PartPath ELSE
CALL *UVPRINTMSG(010577,'')
CLOSE fv
GOSUB abort.define
END
CLOSE fv
PartRec<3> = PartStatusArray<24>
PartRec<4> = SaveAlgorithm
WRITE PartRec ON part.fv, PartPath
NEXT i
CASE Verb = "VERIFY.DF"
IF PartFile THEN
CALL *UVPRINTMSG(010611,PartFile)
GOSUB abort.define
END
IF CREATE.FLAG = 1 THEN
CALL *UVPRINTMSG(010606,DistFile)
GOSUB abort.define
END
command = "DF.MODIFY -d ": DistFile: " -o VERIFY"
ReturnCode = 0
execute command returning ReturnCode
IF ReturnCode LT 0 THEN GOSUB abort.define
END CASE
CLOSE part.fv
CLOSE voc.fv
STOP
RETURN
END
Reference in New Issue Copy Permalink