*******************************************************************************
*
*	 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