        PROGRAM GANGDCL
C
C   This program is designed to execute a DCL command against each
C   file name found in a file of file names. 
C   
C   The list of file names must be in the format one file name per 
C   line.
C
C   The DCL command may contain the file name in more than one 
C   position in the command
C
C   INPUTS:
C
C       The user is queried for the name of the file containing 
C       the list of filenames.
C
C       The user is also queried for the DCL command to execute
C       against the list of file names. The format of the DCL 
C       command should something like:
C       
C           $COPY #  [.dir]#
C
C               where $ - don't forget to start the DCL command with
C                         a $. I could have inserted the $ for you
C                         but I found myself inserting when I input
C                         the command out of habit anyway and the
C                         getting an error when I tried to execute 
C                         the command.
C
C                     # - Put the '#' character anywhere that you 
C                         want the the file name to be inserted.
C
C                The remainder of the DCL command would be any standard
C                DCL command.
C
C   OUTPUTS:    The output will vary depending on the type of DCL 
C               command you are executing.
C
C   TEMP FILES: FILEDCL.TMP is created and then deleted if all goes
C               okay.
C
C
        PARAMETER       (YES=1,NO=0)
C
        CHARACTER*1     Y_OR_N
C
        CHARACTER*255   LIST,   ! File name of file with list of names
     A                  CMND,   ! Command input string to parse
     A                  NAME,   ! Current name read in from the list
     A                  OUT_REC ! Parsed Command with Names inserted
C 
       INTEGER         CMND_LENGTH, ! Length of CMND
     A                  GET_LENGTH, ! Function definition
     A                  LIST_LENGTH ! Length of file name LIST
     A                  NAME_LENGTH, ! Length of current NAME
     A                  OUT_LENGTH, ! Length of OUT_REC
     A                  CMND_PNTR,  ! Parse pointer into CMND
     A                  OUT_PNTR,   ! Parse pointer into OUT_REC
     A                  NAME_PNTR,  ! Parse pointer into NAME
     A                  PARSE_DONE, ! Flag set when end of CMND reached
     A                  ISTAT,      ! Return code fro LIB functions
     A                  FOREVER,    ! Loop control variable
     A                  CLI$GET_VALUE
C
        FOREVER = YES
C
C       Get the file containing the list of files and the command to
C       execute against this list.
C
        ISTAT = CLI$GET_VALUE('IN_FILE',LIST,LIST_LENGTH)
        IF ( .NOT. ISTAT ) THEN
            STOP 'Error getting input file name'
        ENDIF
        ISTAT = CLI$GET_VALUE('CMND_STRING',CMND,CMND_LENGTH)
        IF ( .NOT. ISTAT ) THEN
            STOP 'Error getting input command string'
        ENDIF
        OPEN(UNIT=10,FILE=LIST,STATUS='OLD')
C
C       Read the list of names, substitute each place in command string
C       and write out to a temporary file.
C
        OPEN(UNIT=11,FILE='FILEDCL.TMP',STATUS='NEW',
     A       CARRIAGECONTROL='LIST')
C       READ loop --> At end of file transfer to label 1000
        DO WHILE ( FOREVER .EQ. YES )
            CALL FILL_STRING(NAME)        
            READ(10,90001,END=1000,ERR=2000) NAME
C           Parse CMND with current NAME
            NAME_LENGTH = GET_LENGTH(NAME)
            CMND_PNTR = 1
            OUT_PNTR  = 1
            CALL FILL_STRING(OUT_REC)
            PARSE_DONE = NO
            DO WHILE ( PARSE_DONE .EQ. NO )
                DO WHILE ((CMND(CMND_PNTR:CMND_PNTR) .NE. '#') .AND.
     A                (PARSE_DONE .EQ. NO)  )
                    OUT_REC(OUT_PNTR:OUT_PNTR) = 
     A                      CMND(CMND_PNTR:CMND_PNTR)
                    OUT_PNTR = OUT_PNTR + 1
                    CMND_PNTR = CMND_PNTR + 1
                    IF (CMND_LENGTH .LT. CMND_PNTR) THEN
                        PARSE_DONE = YES
                    ENDIF
                ENDDO
                NAME_PNTR = 1
                DO WHILE ((NAME_LENGTH .GE. NAME_PNTR) .AND.
     A                (PARSE_DONE .EQ. NO) )
                    OUT_REC(OUT_PNTR:OUT_PNTR) = 
     A                      NAME(NAME_PNTR:NAME_PNTR)
                    OUT_PNTR = OUT_PNTR + 1
                    NAME_PNTR = NAME_PNTR + 1
                ENDDO
                CMND_PNTR = CMND_PNTR + 1
            ENDDO
            OUT_LENGTH = GET_LENGTH(OUT_REC)
C           Parse complete --> Write parsed command 
            WRITE(11,90001) OUT_REC(1:OUT_LENGTH)
        ENDDO   ! End of DO FOREVER
C
C       End of input file processing here. 
C
1000    CONTINUE
        CLOSE(UNIT=10)
        REWIND(UNIT=11)
C       Display list of parsed commands
        WRITE(*,90000) 'The commands to be executed are:'
        WRITE(*,90000) '  '
        DO WHILE ( FOREVER .EQ. YES)
            CALL FILL_STRING(CMND)
            READ(11,90001,END=1200) CMND
            CMND_LENGTH = GET_LENGTH(CMND)
            WRITE(*,90000) CMND(1:CMND_LENGTH)
        ENDDO
1200    CONTINUE
        REWIND(UNIT=11)
        WRITE(*,90000) '  '
C       Give the fool a chance to back out .
        WRITE(*,90001) '$Do you really want to execute them? '        
        READ(*,90001) Y_OR_N
        IF ((Y_OR_N .EQ. 'Y') .OR. (Y_OR_N .EQ. 'y')) THEN
            DO WHILE ( FOREVER .EQ. YES )
                READ(11,90001,END=1300) CMND
C               Call LIB$SPAWN to execute the file of commands
                ISTAT = LIB$SPAWN(CMND)
                IF ( .NOT. ISTAT ) THEN
                    STOP 'Error in execution of command list'
                ENDIF
            ENDDO
1300        CONTINUE
            CLOSE(UNIT=11)
C           Delete the command file since it is no longer needed.
            ISTAT = LIB$DELETE_FILE('FILEDCL.TMP;*')
            IF ( .NOT. ISTAT ) THEN
                STOP 'Error in execution of TEMP file deletion'
            ENDIF
        ENDIF            
        STOP 'Normal Completion'
C
C       Here on READ errors
C
2000    CONTINUE
        WRITE(*,90000) '*** ERROR ON INPUT FILE READ --> ABORTING ***'
        STOP 'ERROR'
C
C       FORMAT Statements
C
90000   FORMAT(' ',A)
90001   FORMAT(A)
        END

C
C       Subroutine to fill the string with blanks.
C
        SUBROUTINE FILL_STRING(STRING)
        CHARACTER*255   STRING
        INTEGER         I
        DO I = 1,255
            STRING(I:I) = ' '
        ENDDO
        RETURN
        END
C
C       Function to find the actual length of the string. This is done
C       by searching backwards from the end of the character variable
C       till a none blank character is found. 
C
C       NOTE: In order for this function to work as designed the
C             string must be blank filled before any thing is 
C             inserted into it.
C
        INTEGER FUNCTION  GET_LENGTH(STRING)
C
        CHARACTER*255   STRING
        INTEGER         I
C
        I = 255
        DO WHILE (STRING(I:I) .EQ. ' ')
            I = I - 1
            IF (I .EQ. 1) THEN
                STOP 'Trying to find length of empty string'
            ENDIF
        ENDDO
        GET_LENGTH = I 
        RETURN
        END
