*******************************************************************************
*
*	 Display secondary key file information
*
*	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.........................................
*	10/13/98 23801 RGA Change copyright info.
*	05/27/97 20380 DTM Corrected display for NLS info on partfiles
*	05/21/97 20380 DTM Moved location of NLS info to past current stuff
*	05/20/97 20380 DTM Added recognition of NLS Locale/Collation sequences
*	03/07/96 17832 HSB Recognize new SQL type indices.	
*	10/28/93 12435 GMH Correct parsing
*	08/10/93 11980 GMH Correct parsing
*	07/30/93 11918 GMH Rewrite to support Distributed Files
*	02/04/93 11020 PVW Display field numbers for C types.
*	02/01/93 10390 PVW Support multilevel files.
*	10/23/92 8864  GMH Support C type
*	10/06/92 10102 JKW Display uniqueness
*	08/10/92 9563  PVW Corrected spelling of Stat(a)istics
*	04/11/92 9406  GMH Added $OPTIONS line
*	03/03/92 8865  GMH Added justification field
*	04/25/91 8238  JWT allow Q pointers on command line
*	04/10/91 8142  JWT correct reporting of key count and average for STATS
*	12/14/90 7822  JWT better message when no indices present
*	10/18/89 6392  JWT fix to compensate for corrected INDICES return
*	09/23/89 6303,6304
*  		       JWT fix prompting mode errors
*	09/17/89 6284,6286,6285
*		       JWT Fix LPTR and ALL keywords
*	08/02/89 6191  JWT LIST.INDEX enhancements
*	07/27/89 6175  JWT display proper ENABLE state
*	07/26/89 5126  JWT fix file open when DICT used
*	12/21/88 5478  JWT Fix min when file is empty
*	07/25/88   -    -  Maintenence log purged at 5.2.1, see release 5.1.10.
*
*******************************************************************************

      ID = "%W%"

$OPTIONS DEFAULT
!
* Define variables
!
   DKEY = 0  ;* DICT keyword
   AKEY = 0  ;* ALL keyword
   NKEY = 0  ;* DETAIL keyword
   SKEY = 0  ;* STATISTICS keyword
   PKEY = 0  ;* NO.PAGE keyword
   LKEY = 0  ;* LPTR keyword
   FILE = '' ;* name of file
   IDXNAME = '' ;* index name(s)
   BADIDX  = '' ;* list of bad indices 
   IDXGOOD = '' ;* names
   MSG  = ''    ;* used for UVREADMSG
   NLSMSG = ''  ;* used for UVREADMSG
!
* Define keywords
!
   EQU DICT$KW       TO 20
   EQU NOPAGE$KW     TO 30
   EQU LPTR$KW       TO 33
   EQU ALL$KW        TO 37
   EQU STATS$KW      TO 230
   EQU DETAIL$KW     TO 231
!
* Define equates for INDICES function
!
   EQU IdxType         TO 1
   EQU NeedsRebuild    TO 2
   EQU EmptyValues     TO 3
   EQU AutoUpdate      TO 4
   EQU IdxPath         TO 5
   EQU FileMods        TO 6
   EQU Justification   TO 7
   EQU Unique          TO 8
   EQU PartNums        TO 9
   EQU PartBuild       TO 10
   EQU PartEmpty       TO 11
   EQU PartUpdates     TO 12
   EQU PartPaths       TO 13
   EQU PartPending     TO 14
   EQU PartJustif      TO 15
   EQU PartUnique      TO 16
   EQU NLSPath		   TO 17

!
* Define equates for STATUS statement
!
   EQU DBtype        TO 21
   EQU PFnumbers     TO 24
   EQU PFidxpaths    TO 25
!
* Define arrays
!
   DIM SID(512)
   DIM ISTATS(512)
   DIM SN(512)
!
* Define functions
!
   DEFFUN UVREADMSG(num, args)  CALLING '*UVREADMSG'
!
* Open files
!
   OPEN 'VOC' TO VOC ELSE
      *PRINT 'Sorry, unable to access VOC.'
      PRINT UVREADMSG(32000,"")
      STOP
   END
!
* Get command line
!
   PARAMS = CONVERT(" ",@FM,TRIM(@SENTENCE))
   DEL PARAMS<1>
!
* Parse command line, looking for files or keywords
!
CHECK:
   REMOVE WORD FROM PARAMS SETTING Delim
   LOOP
   UNTIL WORD = "" DO
      * Read from VOC
      READ VDESC FROM VOC,FIELD(WORD,",",1) ELSE
         * Save as possible index key
			VDESC = "A"
      END
      * If we got something, let's check its type
      F1 = UPCASE(VDESC<1>[1,1])
      BEGIN CASE
         * Keyword
         CASE F1 = 'K'
            F2 = VDESC<2>
            BEGIN CASE
               * Check for DICT
               CASE F2 = DICT$KW AND FILE = ''
                  DKEY = 1
               * Check for ALL
               CASE F2 = ALL$KW
                  AKEY = 1
               * CHeck for NO.PAGE
               CASE F2 = NOPAGE$KW
                  PKEY = 1
               * Check for LPTR
               CASE F2 = LPTR$KW
                  * If next token is numeric, set channel
                  REMOVE WORD FROM PARAMS SETTING Delim
                  IF NUM(WORD) AND WORD > 0 THEN
                     LKEY = WORD
                  END ELSE
                     * Since not a number, let's go check
                     LKEY = -1
                     CONTINUE
                  END
               * Check for STATISTICS
               CASE F2 = STATS$KW
                  SKEY = 1
               * Check for DETAIL
               CASE F2 = DETAIL$KW
                  NKEY = 1
               * Unknown: try as an index
               CASE 1
                   IDXNAME<-1> = WORD
            END CASE
         * File
         CASE ( F1 = 'F' OR F1 = 'Q' ) AND FILE = ""
            FILE = WORD
         * Add as possible index key
         CASE 1
            IDXNAME<-1> = WORD
      END CASE
   UNTIL Delim = 0 DO
      REMOVE WORD FROM PARAMS SETTING Delim
   REPEAT
!
* Check if FILE was on command line
!
   PROMPT ' '
   IF FILE = '' THEN
      *PRINT 'File name:  ':
      PRINT UVREADMSG(32003,""):
      INPUT FILE
      IF FILE[1,5] = "DICT " THEN
         DKEY=1
         FILE=FILE[6,999]
      END
      IF FILE = '' THEN
         *PRINT 'NO FILE NAME SPECIFIED.'
         PRINT UVREADMSG(32004,"")
         STOP
      END
      * Read (w/multi-data check)
      READ VDESC FROM VOC,FIELD(FILE,",",1) ELSE
         *PRINT DQUOTE(FILE):' is not a file name.'
         PRINT UVREADMSG(32005,FILE)
         STOP
      END
   END
   * Open DICT of file
   DFILE = IF DKEY THEN "DICT.DICT" ELSE "DICT ":FILE
   OPEN DFILE TO UDICT ELSE
      *PRINT 'Unable to open ':DQUOTE(DFILE):'.'
      PRINT UVREADMSG(32006,DFILE)
      STOP
   END
!
* Open file
!
   IF DKEY THEN FILE = "DICT ":FILE
   OPEN FILE TO UDATA ELSE
      *PRINT 'Unable to open ':DQUOTE(FILE):'.'
      PRINT UVREADMSG(32006,FILE)
      STOP
   END
   STATUS fileinfo FROM UDATA ELSE
      *PRINT "Unable to stat file ":DQUOTE(FILE):"."
      PRINT UVREADMSG(32007,FILE)
      STOP
   END
!
* Check indices
!
   ILIST = INDICES(UDATA)
   IF ILIST = '' THEN
      *PRINT 'File "':FILE:'" has no indices.'
      PRINT UVREADMSG(32008,FILE)
      STOP
   END
   * No indices and ALL keyword not seen?
   IF IDXNAME = '' AND AKEY = 0 THEN
      *PRINT 'Index name(s): ':
      MSG = UVREADMSG(32009,"")
      PRINT MSG:
      INPUT TEMP
      IF TEMP = '' THEN
         *PRINT 'NO INDEX NAME SPECIFIED.'
         PRINT UVREADMSG(32010,"")
         STOP
      END ELSE
         * See if can be read from VOC
         READ VDESC FROM VOC,TEMP THEN
            * Is this the ALL keyword?
            IF UPCASE(VDESC<1>[1,1]) = 'K' AND VDESC<2> = ALL$KW THEN
               AKEY = 1
            END ELSE
               IDXNAME = TEMP
            END
         END ELSE
            * Add as possible index key and convert space or comma to FM
            * in case we got a string of index names
            *IDXNAME = CONVERT(\ ,\,@FM:@FM,TRIM(TEMP))
            PARAMS = CONVERT(\ ,\,@FM:@FM,TRIM(TEMP))
            GOTO CHECK:
         END
      END
   END
   * If ALL keyword was seen, assign
   IF AKEY = 1 THEN IDXNAME = ILIST
   * If DETAIL, then enable STATISTICS
   IF NKEY THEN SKEY = 1
!
* Set up for checking index
!
   C      = 0
   ITYP   = 0
   DTYP   = 0
   ATYP   = 0
   CTYP   = 0
   STYP   = 0
   SQTYP  = 0
   TOTTYP = 0
   Delim  = 0
   NLS.LOCALE = 0
   NLS.ENABLED = SYSTEM( 100 )
!
* Check each index
!
   LOOP
      REMOVE ONE FROM IDXNAME SETTING Delim
      IR = INDICES(UDATA,ONE)
      IF IR = '' THEN
         BADIDX<-1> = ONE
      END ELSE
         * Check type
         BBIT=upcase(IR<1,1>)
         begin case
            case BBIT = "A"
               ATYP += 1
            case BBIT = "C"
               CTYP += 1
            case BBIT = "D"
               DTYP += 1
            case BBIT = "I"
               ITYP += 1
            case BBIT = "S"
               STYP += 1
            case BBIT = "SQL"
               SQTYP += 1
         end case
         * Increment total
         TOTTYP += 1
         * Make certain we haven't seen this one yet
         LOCATE ONE IN IDXGOOD<1> SETTING FOO ELSE
            C += 1
            SID(C) = IR
            SN(C) = ONE
            INS ONE BEFORE IDXGOOD<FOO>
         END
      END
   UNTIL Delim = 0 DO
   REPEAT
!
* Used LPTR keyword
!
   IF LKEY # 0 THEN
     IF LKEY < 0 THEN LKEY = 0
     PRINTER ON
   END
!
* Anything to output?
!
   IF C = 0 THEN
      GOTO EXIT.OUT:
   END
!
* Used NO.PAGE keyword
!
   IF PKEY THEN
      * Disable pagination
      ASSIGN 0 TO SYSTEM(1005)
   END
!
* Start displaying
!
	W = UVREADMSG(32011,"")
   W = IF NKEY THEN W<1> ELSE IF SKEY THEN W<2> ELSE W<3>

   *PRINT ON LKEY "Alternate Key Index ":
   *PRINT ON LKEY W:
   *PRINT ON LKEY " for file ":FILE
   *PRINT ON LKEY "File........... ":FILE
   *PRINT ON LKEY "Indices........ ":TOTTYP:' (':ATYP:' A-type, ':CTYP:' C-type, ':DTYP:' D-type, ':ITYP:' I-type, ':STYP:' S-type)'
   *PRINT ON LKEY "Index Updates.. ":
   W<2> = FILE
   W<3> = FILE
   W<4> = TOTTYP
   W<5> = ATYP
   W<6> = CTYP
   W<7> = DTYP
   W<8> = ITYP
   W<9> = SQTYP
   W<10> = STYP
   MSG = change(UVREADMSG(32012,W),@fm,char(10):char(13))
   PRINT ON LKEY MSG:
!
* Is this NOT a Distributed File?
!      
  IF fileinfo<DBtype> # "27" THEN 
     * Is this a Part file?
     IF fileinfo<PFnumbers> > 0 THEN
        *PRINT ON LKEY "Part":fileinfo<PFnumbers,1>:": ":
        MSG = UVREADMSG(32013,"")
        PRINT ON LKEY MSG:fileinfo<PFnumbers,1>:": ":
     END
     * Is active?   
     MSG = UVREADMSG(32014,"")
     IF SID(1)<1,AutoUpdate> = '1' THEN
        *PRINT ON LKEY "Enabled, ":
        PRINT ON LKEY MSG<1>:
     END ELSE
        *PRINT ON LKEY "Disabled, ":
        PRINT ON LKEY MSG<2>:
     END
     MSG = UVREADMSG(32015,"")
     IF SID(1)<1,FileMods> = '1' THEN
        *PRINT ON LKEY "Indices require updating"
        PRINT ON LKEY MSG<1>
     END ELSE
        *PRINT ON LKEY "No updates pending"
        PRINT ON LKEY MSG<2>
     END
  END ELSE
     * Count the number of sub-values (partfiles in distributed file)
     LVAL = DCOUNT(SID(1)<1,PartNums>,@SM)
     FOR I = 1 TO LVAL
        * If multiple lines, space properly
        IF I > 1 THEN PRINT ON LKEY SPACE(16):
        * Display partfile number
        *PRINT ON LKEY "Part":SID(1)<1,PartNums,I>:": ":
        MSG = UVREADMSG(32013,"")
        PRINT ON LKEY MSG:SID(1)<1,PartNums,I>:": ":
        * Is active?   
        MSG = UVREADMSG(32014,"")
        IF SID(1)<1,PartUpdates,I> = '1' THEN
           *PRINT ON LKEY "Enabled, ":
           PRINT ON LKEY MSG<1>:
        END ELSE
           *PRINT ON LKEY "Disabled, ":
           PRINT ON LKEY MSG<2>:
        END
        MSG = UVREADMSG(32015,"")
        IF SID(1)<1,PartPending,I> = '1' THEN
           *PRINT ON LKEY "Indices require updating"
           PRINT ON LKEY MSG<1>
        END ELSE
           *PRINT ON LKEY "No updates pending"
           PRINT ON LKEY MSG<2>
        END
     NEXT I
  END
!
* Now let's do the index specifics.
!
  PRINT ON LKEY
  *PRINT ON LKEY "Index name      Type  Build    Nulls  In DICT  S/M  Just Unique Field num/I-type"
  PRINT UVREADMSG(32016,"")
  NLSMSG = UVREADMSG( 32115, "" )
  FOR I = 1 TO C
     * Index name
     PRINT ON LKEY SN(I) '16L':
     * Index type
     PRINT ON LKEY " ":SID(I)<1,IdxType> '5L':
     * Build. This is different for DF's in that if any one Partfile index is
     * not built, then we must display required.
     MSG = UVREADMSG(32017,"")
     IF fileinfo<DBtype> # "27" THEN
        * A regular or Part file
        IF SID(I)<1,NeedsRebuild> = '1' THEN
           *PRINT ON LKEY  "Required  ":
           PRINT ON LKEY MSG<1>"L#10":
        END ELSE
           *PRINT ON LKEY "Not Reqd  ":
           PRINT ON LKEY MSG<2>"L#10":
        END
     END ELSE
        * A Distributed file. All Parts must have empty (0) value
        IF SUMMATION(SID(I)<1,PartBuild>) = 0 THEN
           *PRINT ON LKEY "Not Reqd  ":
           PRINT ON LKEY MSG<2>"L#10":
        END ELSE
           *PRINT ON LKEY  "Required  ":
           PRINT ON LKEY MSG<1>"L#10":
        END
     END
     * Nulls
     MSG = UVREADMSG(32018,"")
     IF SID(I)<1,EmptyValues> = '1' THEN
        *PRINT ON LKEY  "No     ":
        PRINT ON LKEY MSG<1>"L#7":
     END ELSE
        *PRINT ON LKEY "Yes    ":
        PRINT ON LKEY MSG<2>"L#7":
     END
     * In dict
     READ FOO FROM UDICT,SN(I) THEN
        *PRINT ON LKEY "Yes      ":
        PRINT ON LKEY MSG<2>"L#9":
     END ELSE
        FOO = ""
        *PRINT ON LKEY "No       ":
        PRINT ON LKEY MSG<1>"L#9":
     END
     * multi
     FOO = UPCASE(TRIM(FOO<6>))
     IF FOO = 'M' OR index("ACS",SID(I)<1,IdxType>,1) THEN
        PRINT ON LKEY "M    ":
     END ELSE
        PRINT ON LKEY "S    ":
     END
     * Justification
     IF SID(I)<1,Justification> # "" THEN
        PRINT ON LKEY SID(I)<1,Justification>"L#4":
     END ELSE
        PRINT ON LKEY "L""L#4":
     END
     * Unique
     PRINT ON LKEY "  ":SID(I)<1,Unique>:"    ":
     * Code
     spot = 2
     strlen = 16
     if SID(I)<1,IdxType> = 'C' then
        PRINT ON LKEY SID(I)<spot,1>:" ":
        strlen = strlen - (len(SID(I)<spot,1>)+1)
        if strlen <= 0 then
           print
           strlen = 16
        end
        spot = 8
     end
     PRINT ON LKEY SID(I)<spot,1>[1,strlen]
     * Don't wrap.  Chop up to make it look nice
     XNUM = INT(LEN(SID(I)<spot,1>)/16) 
     FOR L=1 TO XNUM
        PRINT ON LKEY SPACE(64):SID(I)<spot,1>[((16*L)+1),16]
     NEXT L
	 IF NLS.ENABLED THEN
  		NLS.LOCALE = SID(I)<1,NLSPath>
  		IF NLS.LOCALE # "" THEN
			PRINT SPACE( 17 ):NLSMSG:NLS.LOCALE<1,1,1>
		END
	END
  NEXT I
  PRINT ON LKEY
!
* STATISTICS keyword was seen
!
  IF SKEY THEN
     * Gather statistics for each index
     FOR I = 1 TO C
        * Initialize
        ISTATS(I) = ''
        ISTATS(I)<2> = 0
        ISTATS(I)<3> = 0
        ISTATS(I)<4> = "NIL"
        ISTATS(I)<5> = 0
        ISTATS(I)<6> = 0
        ISTATS(I)<7> = 0
        * Select index file
        SELECTINDEX SN(I) FROM UDATA
        * If DETAIL
        IF NKEY THEN
           *PRINT ON LKEY "Details of index ":SN(I):" in file ":FILE
           *PRINT ON LKEY
           *PRINT ON LKEY "                              # of Records    Bytes Used"
           *PRINT ON LKEY "Alternate Key Value           for Key         for Key"
           MSG = change(UVREADMSG(32019,SN(I):@am:FILE),@fm,char(10):char(13))
           PRINT ON LKEY MSG
        END
        * Tabulate from SELECT list
        EOS = 0
        LOOP
           READNEXT RID ELSE EOS = 1
        UNTIL EOS DO
           * Create a SELECT list of AK contents
           SELECTINDEX SN(I),RID FROM UDATA TO 5
           * Convert SELECT list to Dynamic Array
           READLIST FOO FROM 5 THEN
              DCNT = @SELECTED
              DLEN = LEN(FOO)+LEN(RID)+1
              * If DETAIL
              IF NKEY THEN
                 *IF RID = '' THEN RID = "*** Null Value ***"
                 IF RID = '' THEN RID = UVREADMSG(32020,"")
                 PRINT ON LKEY RID[1,29] '30L':
                 PRINT ON LKEY DCNT '16L':
                 PRINT ON LKEY DLEN '10L'
              END
              ISTATS(I)<2> = ISTATS(I)<2> + DCNT
              ISTATS(I)<3> = ISTATS(I)<3> + 1
              IF ISTATS(I)<4> = "NIL" OR ISTATS(I)<4> GT DCNT THEN
                 ISTATS(I)<4> = DCNT
              END
              IF ISTATS(I)<5> LT DCNT THEN ISTATS(I)<5> = DCNT
              ISTATS(I)<6> = ISTATS(I)<6> + DCNT*DCNT
              ISTATS(I)<7> = ISTATS(I)<7> + DLEN
           END
        REPEAT
        * Skip a line if DETAIL
        IF NKEY THEN PRINT ON LKEY
     NEXT I
!
* Display Statistics
!
     *PRINT ON LKEY "Statistics:"
     *PRINT ON LKEY "                    Number       Records per Alternate Key Index      Size"
     *PRINT ON LKEY "Index name          of Keys   Average   Minimum   Maximum   StdDev   (in Bytes)"
     MSG = change(UVREADMSG(32021,""),@fm,char(10):char(13))
     PRINT ON LKEY MSG
     FOR I = 1 TO C
        * Index name
        PRINT ON LKEY SN(I)[1,19] '20L':
        * Number of keys
        PRINT ON LKEY ISTATS(I)<3> '10L':
        * Average
        IF ISTATS(I)<3> = 0 THEN ISTATS(I)<3> = 1
        PRINT ON LKEY (ISTATS(I)<2>/ISTATS(I)<3>) '10L':
        * Minimum
        IF ISTATS(I)<4> = "NIL" THEN ISTATS(I)<4> = 0
        PRINT ON LKEY ISTATS(I)<4> '10L':
        * Maximum
        PRINT ON LKEY ISTATS(I)<5> '10L':
        * Std dev
        PRINT ON LKEY SQRT((ISTATS(I)<6>/ISTATS(I)<3>) - ((ISTATS(I)<2>/ISTATS(I)<3>)^2)) '10L':
        * Size
        PRINT ON LKEY ISTATS(I)<7> '8L'
     NEXT I
  END
!
* Any bad indices
!
EXIT.OUT:
  IF BADIDX # "" THEN
     MSG = UVREADMSG(32022,"")
     C = DCOUNT(BADIDX, @FM)
     FOR I = 1 TO C 
         PRINT BADIDX<I>:" ":MSG<1>
     NEXT I
  END
!
* End of code
!
END