SUBROUTINE CHKUIC ( luntrm, tstlun, dirmod, uic, iuic, + lenuic, setuic, defuic, lendir, + device, idev, ids ) C+ C SUBROUTINE CHKUIC C C Environment: System Utility DEF C Env. Vsn: 01.00 C C Subroutine/Function Description: C C CHKUIC checks the format of a UIC or directory, making sure the C correct number of characters exist, etc. Also, it uses the C DEFUIC to activate the and <,nnn> forms of DEF. C C Parameter List: C Name Type I/O Purpose C -------------------------- ------------- ------ ------------------------ C C luntrm Integer*2 I Terminal LUN C tstlun Integer*2 I LUN for testing C dirmod Logical I Directory mode flag C uic Character*80 I/O UIC to check C iuic Integer*2 I/O Length of SET /DEF cmd C lenuic Integer*2 I/O Length of UIC C setuic Character*80 O SET /DEF command C defuic Character*80 I Default UIC or dir C lendir Integer*2 I Length of default C ids Integer*2 I Error flag C C Data Structures: C COMMON Blocks: NONE C C C Side effects: NONE C C C------------------------------------------------------------------------- C Environmental Requirements C C Re-compile Procedure: See MOVEBLD.CMD C Compile Command: F4P CHKUIC=CHKUIC C Library: MOVE.OLB C Modules called: PARSE ( MOVE.OLB ) C INSZIP ( MOVE.OLB ) C C Test Procedures: C Test Data Files: NONE C Test Scripts: NONE C Documents: NONE C C Module Documentation: C Help File: NONE C Document File: C C Required Logicals: NONE C C Required Files: NONE C C C Written By: Robert Hays C KMS Fusion, Inc. C P.O. Box 1567 C Ann Arbor, Mich. 48106 C C Ident: RLH001 C Date: September 29, 1986 C C C Change Log: C Date Initials Ident Description C [dd-mmm-yy] [tbs] [tbs] [tbs......] C---------------------------------------------------------------------------- C- C IDENT /01.00/ C CHARACTER*80 uic ! Potential UIC or dir. CHARACTER*80 setuic ! Potential SET /DEF command. CHARACTER*80 defuic ! Current default UIC or dir. CHARACTER*80 cmp ! Temporary string. CHARACTER*80 device ! Device to check on. CHARACTER*3 chst, chen ! Substrings of DEFUIC. CHARACTER*1 space, ! Constants. + lftbrc, ! + rtbrc, ! + comma ! C LOGICAL dirmod ! .TRUE. if in directory mode. LOGICAL commod ! .TRUE. if in comma dir mode. LOGICAL grp, usr ! Group and user prompt mode ! flags. C INTEGER*2 idev ! Length of device string. INTEGER*2 luntrm, ! Terminal lun. + tstlun ! Lun for (later) file checking. INTEGER*2 iuic ! Length of SETUIC. INTEGER*2 ids ! Error code. INTEGER*2 locspc(6), ! Used by PARSE. + loclft(6), ! Ditto. + locrt(6), ! Ditto. + loccom(6) ! Ditto. INTEGER*2 lenuic ! Output length of UIC. INTEGER*2 loctmp ! INTEGER*2 lendir ! Length of DEFUIC. INTEGER*2 ichst, ichen ! Markers for DEFUIC substrs. INTEGER*2 i1 ! Constant 1. C DATA space/' '/, ! + lftbrc/'['/, ! + rtbrc/']'/, ! + comma/','/ ! DATA i1/1/ ! C C Executable begins here. C isploc = 1 ! CALL PARSE ( uic, i1, iuic, space, locspc, ids )! Find all spaces. IF ( uic(1:1) .EQ. space ) THEN ! Remove leading spaces. uic(1:iuic-locspc(isploc)+1) = ! Move string over. + uic(locspc(isploc):iuic) ! iuic = iuic - locspc(1) + 1 ! Get new length. isploc = isploc + 1 ! Advance to next space. END IF ! ioff1 = INDEX ( uic(1:iuic), '*' ) ! Is there an *? IF ( ioff1 .GT. 0 ) THEN ! Prompt for dir. then. grp = .FALSE. ! Default for all grps. usr = .FALSE. ! " " " usrs. IF ( .NOT. dirmod ) THEN ! UIC mode only. CALL ASTERX ( uic, i1, iuic, grp, usr, ! Parse input line. + cmp ) ! END IF ! CALL LSTDIR ( tstlun, luntrm, uic, iuic, ! Issue list and maybe + device, idev, ! get one back. + dirmod, grp, usr, cmp, ids ) ! IF ( ids .LT. 0 ) THEN ! Nope, didn't get one. GO TO 9000 ! Exit out. END IF ! END IF ! CALL PARSE ( uic, 1, iuic, comma, loccom, ids ) ! Find commas. IF ( dirmod ) THEN ! In named dir mode. DO 50 i = 2, lendir-1 ! Look for numbers. If IF ( ( defuic(i:i) .LT. '0' .OR. ! any non-numbers, then + defuic(i:i) .GT. '9' ) .AND. ! Skip rest of this + defuic(i:i) .NE. ',' ) THEN ! section of code. GO TO 80 ! END IF ! 50 CONTINUE ! DO 75 i = 1, iuic ! Check the input UIC. IF ( ( uic(i:i) .LT. '0' .OR. ! Any non-numbers or + uic(i:i) .GT. '9' ) .AND. ! non-commas means + uic(i:i) .NE. ',' .AND. ! accept as-is. + uic(i:i) .NE. ' ' .AND. ! + uic(i:i) .NE. '[' .AND. ! + uic(i:i) .NE. ']' ) THEN ! GO TO 80 ! END IF ! 75 CONTINUE ! locpt = INDEX ( defuic(1:lendir), comma ) ! Find any commas. IF ( locpt .GT. 0 ) THEN ! Got a comma. chst = defuic(1:locpt-1) ! Parse around it. chen = defuic(locpt+1:lendir) ! ichst = locpt-1 ! ichen = lendir - locpt ! commod = .TRUE. ! ELSE ! No comma, so use chst = defuic(2:4) ! the 6-character chen = defuic(5:7) ! dir mode. ichst = 3 ! ichen = 3 ! commod = .FALSE. ! END IF ! IF ( loccom(1) .GT. iuic ) THEN ! Ends with a comma. IF ( commod ) THEN ! Keep commas. uic(iuic+1:iuic+ichen) = ! + chen(1:ichen) ! iuic = iuic + ichen ! ELSE ! Remove commas. IF ( iuic .EQ. 3 ) THEN ! Force three character uic(3:3) = uic(2:2) ! values. Zero out uic(2:2) = uic(1:1) ! the blanks at INSZIP. uic(1:1) = space ! ELSE IF ( iuic .EQ. 2 ) THEN ! uic(3:3) = uic(1:1) ! uic(2:2) = space ! uic(1:1) = space ! END IF ! iuic = 4 ! uic(iuic:iuic+ichen-1) = ! + chen(1:ichen) ! iuic = iuic + ichen - 1 ! CALL INSZIP ( uic(1:iuic), 1, iuic ) ! END IF ! ELSE IF ( loccom(1) .EQ. 2 ) THEN ! Leading comma. IF ( commod ) THEN ! uic(ichst+1:iuic+ichst) = ! + uic(1:iuic) ! uic(1:ichst) = chst(1:ichst) ! iuic = iuic + ichst ! ELSE ! uic(ichst+1:iuic+ichst-1) = ! + uic(2:iuic) ! uic(1:ichst) = chst(1:ichst) ! iuic = iuic + ichst - 1 ! END IF ! ELSE IF ( loccom(1) .LE. 0 .AND. ! Check that there is no + iuic .LE. 3 ) THEN ! comma and only 3 or ! less digits. IF ( commod ) THEN ! uic(iuic+1:iuic+1) = comma ! uic(iuic+2:iuic+ichen+1) = ! + chen(1:ichen+1) ! iuic = iuic + ichen + 1 ! ELSE ! IF ( iuic .EQ. 2 ) THEN ! uic(3:3) = uic(2:2) ! uic(2:2) = uic(1:1) ! uic(1:1) = space ! ELSE IF ( iuic .EQ. 1 ) THEN ! uic(3:3) = uic(1:1) ! uic(2:2) = space ! uic(1:1) = space ! END IF ! CALL INSZIP ( uic(1:3), 1, 3 ) ! uic(4:ichen+3) = chen(1:ichen) ! iuic = ichen + 3 ! END IF ! ELSE IF ( loccom(1) .LE. 0 ) THEN ! Try for a space. loc = INDEX ( uic(1:iuic), space ) ! IF ( loc .GT. 0 .AND. commod ) THEN ! Found a space. uic(loc:loc) = comma ! Put a comma in. ELSE IF ( loc .GT. 0 .AND. ! + .NOT. commod ) THEN ! IF ( loc .EQ. 2 ) THEN ! uic(3:iuic+2) = uic(1:iuic) ! uic(1:1) = space ! uic(2:2) = space ! iuic = iuic + 2 ! ELSE IF ( loc .EQ. 3 ) THEN ! uic(2:iuic+1) = uic(1:iuic) ! uic(1:1) = space ! iuic = iuic + 1 ! END IF ! loc = INDEX ( uic(3:iuic), space ) + 2 ! Check for another IF ( iuic - loc .EQ. 3 ) THEN ! space. uic(loc:iuic-1) = uic(loc+1:iuic) ! iuic = iuic - 1 ! ELSE IF ( iuic - loc .EQ. 1 ) THEN ! uic(loc+1:iuic+1) = uic(loc:iuic) ! iuic = iuic + 1 ! END IF ! CALL INSZIP ( uic, 1, iuic ) ! END IF ! END IF ! 80 CONTINUE ! Used to skip on alpha ! directories. ELSE ! UIC mode. DO 100 i = 1, iuic ! IF ( ( uic(i:i) .LT. '0' .OR. ! Check that the + uic(i:i) .GT. '9' ) .AND. ! UIC string only + uic(i:i) .NE. ',' .AND. ! contains the chars. + uic(i:i) .NE. '[' .AND. ! 0-9, ',', '[', ' ', + uic(i:i) .NE. ']' .AND. ! and ']'. + uic(i:i) .NE. ' ' ) THEN iuic = 0 ! GO TO 9100 ! Exit loop and set err. END IF ! 100 CONTINUE ! IF ( loccom(1) .LE. 0 ) THEN ! No comma in string. IF ( locspc(isploc) .GT. 0 .AND. ! Insert comma into + locspc(isploc) .LE. iuic ) THEN ! next space. uic(locspc(isploc)-1:locspc(isploc)-1) = ! + comma ! ELSE IF ( locspc(isploc) .LE. 0 .OR. ! + locspc(isploc) .GT. iuic ) THEN ! End of line. uic(iuic+1:iuic+4) = defuic(5:8) ! Tack on default ! user number and comma. iuic = iuic + 4 ! Increment length. END IF ! ELSE IF ( loccom(1) .EQ. 2 ) THEN ! Lead off with comma. uic(4:iuic+3) = uic(1:iuic) ! Make room in UIC. uic(1:3) = defuic(2:4) ! Insert def group #. iuic = iuic + 3 ! Increment length. ELSE loctmp = INDEX ( uic(1:iuic), comma ) IF ( loctmp .EQ. iuic ) THEN uic(iuic+1:iuic+4) = defuic(6:8) iuic = iuic + 3 END IF END IF ! END IF ! CALL PARSE ( uic, 1, iuic, lftbrc, loclft, ids )! Find ['s. CALL PARSE ( uic, 1, iuic, rtbrc, locrt, ids ) ! Find ]'s IF ( loclft(1) .LE. 0 ) THEN ! Tack on [. uic(2:iuic+1) = uic(1:iuic) ! uic(1:1) = lftbrc ! iuic = iuic + 1 ! END IF ! IF ( locrt(1) .LE. 0 ) THEN ! Tack on ]. uic(iuic+1:iuic+1) = rtbrc ! iuic = iuic + 1 ! END IF ! WRITE ( setuic, 250 ) uic(1:iuic) ! 250 FORMAT ( 'SET /DEF=',A ) ! lenuic = iuic iuic = iuic + 9 ! ids = 1 C 9000 CONTINUE RETURN 9100 CONTINUE ids = -1 GO TO 9000 END