program IDXSTS,1.0(100)  ! scan wildcard list of IDX's, report status info
!----------------------------------------------------------------------------
!Scan a wildcard list of ISAM 1.x files, creating report of IDX statistics
!Usage:
!   .RUN IDXSTS wildspec {/switches}
!Switches:
!   /F{IX} - convert any invalid IDX fields to the default for ISAM 1.0
!   /L{ST} - output to IDXSTS.LST instead of screen
!Examples:
!   .RUN IDXSTS DSK1:[]*.IDX
!   .RUN IDXSTS ALL:[]
!----------------------------------------------------------------------------
!{Edit History}
! 2008-09-21 --- 100 --- Jack McGregor
! Created
!----------------------------------------------------------------------------

++pragma ERROR_IF_NOT_MAPPED "TRUE"
!++pragma FORCE_EXT "LIT"

++include ashinc:ashell.def
++include ashinc:ismdef.bsi

map1 MISC
    map2 PRGVER$,S,14
    map2 DIRFILE$,S,16,"IDXSTS.DIR"
    map2 LSTFILE$,S,16,"IDXSTS.LST"
    map2 IDXSPEC$,S,64
    map2 IDASPEC$,S,64
    map2 CHIN,B,1,1
    map2 CHOUT,B,1,0
    map2 CHIDX,B,1,3
    map2 STATUS,F
    map2 SWFIX,B,1
    map2 SWLST,B,1
    map2 X,F
    map2 RN,F
    map2 F$,S,1
    map2 HEADER$,S,80,"File                           Type  IDXBLK LVL    RecsUsed RecFree Status"
                     ! 1234567890123456789012345678901234567890123456789012345678901234567

    on error goto TRAP
    filebase 0

    xcall GETVER,PRGVER$
    ? "IDXSTS Version ";PRGVER$

    if CMDLIN$ = ""  goto HELPOUT

    ! detect switches
    if instr(1,CMDLIN$,"/?") > 0 goto HELPOUT
    if instr(1,CMDLIN$,"/F") > 0 then SWFIX = 1
    if instr(1,CMDLIN$,"/L") > 0 then
        SWLST = 1
        CHOUT = 2
    endif
    if SWFIX # 0 and SWLST # 0 then
        ? "%Incompatible switches - /FIX and /LST"
        end
    endif

    ? "Building matching file list for ";CMDLIN$
    xcall AMOS,"DIR "+DIRFILE$+"="+CMDLIN$+"/D/K",XAMOS_QUIET,XAMOS_NORUNSBR
    if lookup(DIRFILE$) = 0 then
        ? "%Error: directory file (";DIRFILE$;") not created"
        end
    endif

    open #CHIN, DIRFILE$, input

    if SWLST then
        ? "Outputting report to ";LSTFILE$;"..."
        open #CHOUT, LSTFILE$, output
        ? #CHOUT,"Status of ISAM 1.x IDX files (with matching IDA): ";CMDLIN$
        ? #CHOUT
    endif
    ? #CHOUT,HEADER$

    do while eof(CHIN) # 1
        input line #CHIN, IDXSPEC$
        X = instr(1,IDXSPEC$,".IDX")
        if X > 0 then
CHKFILE:
            STATUS = 0
            ? #CHOUT,IDXSPEC$;tab(-1,254);
            IDASPEC$ = IDXSPEC$[1,X] + "IDA" + IDXSPEC$[X+4,-1]
            if lookup(IDASPEC$) = 0 then
                STATUS = -1      ! no matching IDA
            else

                open #CHIDX, IDXSPEC$, random'forced, 512, RN
                RN = 0 : FIDX = CHIDX           ! needed for READ'ISAM'HEADER
                call READ'ISAM'HEADER           ! in ISMDEF.BSI

                ? #CHOUT,tab(31);INDEX'TYPE; &
                    tab(38);DIR'BLOCK'SIZE;tab(45);IDX'DIR'LEVELS; &
                    tab(50);RECORDS'USED using "########"; &
                    tab(59);IDA'FREECOUNT using "########";

                ! note: older ISAM files may have DIR'BLOCK'SIZE = 0; we treat this
                ! as valid (same as 512); but if you want to fix, remove the # 0 test
                if DIR'BLOCK'SIZE # 0 and DIR'BLOCK'SIZE # 512 and DIR'BLOCK'SIZE # 1024 &
                and DIR'BLOCK'SIZE # 2048 and DIR'BLOCK'SIZE # 4096 and DIR'BLOCK'SIZE # 8192 &
                and DIR'BLOCK'SIZE # 16384 then
                    STATUS = 1          ! invalid block size
                endif

                ! note: most ISAM 1.0 files may have levels = 0; we treat this
                ! as valid (same as 3); but if you want to fix, modify the
                ! test here...
                if IDX'DIR'LEVELS > 9 then
                    STATUS = 2          ! invalid levels
                endif
                close #CHIDX
            endif

            ? #CHOUT;tab(70);
            switch STATUS
                case -1
                    ? #CHOUT;"!NO IDA!"
                    exit
                case 0
                    ? #CHOUT;"OK"
                    exit
                case 1
                    ? #CHOUT;"!Blk Size!"
                    exit
                case 2
                    ? #CHOUT;"!Levels!"
                    exit
                default
                    ? #CHOUT;tab(70);"?????"
                    exit
            endswitch

            if SWFIX # 0 and STATUS > 0 then
                F$ = "X"
                do while ucs(F$) # "Y" and ucs(F$) # "Y"
                    input "Fix? [y/N] ",F$
                loop
                if ucs(F$)="Y" then
                    open #CHIDX, IDXSPEC$, random, 512, RN
                    RN = 0 : FIDX = CHIDX           ! needed for READ'ISAM'HEADER
                    call READ'ISAM'HEADER           ! in ISMDEF.BSI
                    DIR'BLOCK'SIZE = 512
                    IDX'DIR'LEVELS = 3
                    call WRITE'ISAM'HEADER
                    close #CHIDX
                    ? #CHOUT,"   IDX fields reset to default 3 levels, 512 byte IDX block; re-checking..."
                    goto CHKFILE
                else
                    ? #CHOUT, "   File not updated"
                endif
            endif
        endif
NXTFILE:
    loop

    close #CHIN
    close #CHOUT
    end

HELPOUT:
    ? "IDXSTS scans disk for ISAM 1.x files with invalid header fields"
    ? "Syntax: "
    ? "    .RUN IDXSTS {/switches}"
    ? "Switches:"
    ? "    /L - output report to IDXSTS.LST, else to screen"
    ? "    /F - fix invalid header fields (reset to 3 levels, 512 byte blocks)"
    end



TRAP:
    if err(0)=37 and err(2)=CHIDX then      ! file in use
        ? #CHOUT,tab(32);"<file in use - skipping>"
        resume NXTFILE
    endif
    ? #CHOUT
    ? #CHOUT,"Basic error #";ERR(0);" last file: ";ERR(2)
    if err(0)=16 then
        ? #CHOUT,"IDXSPEC$ = ";IDXSPEC$
        ? #CHOUT,"IDASPEC$ = ";IDASPEC$
    endif
    if SWLST close #CHOUT
    end