Fortran Wiki
ttee

!-----------------------------------------------------------------------------------------------------------------------------------
! this program needs the following file to crack the command line
! http://home.comcast.net/~urbanjost/LIBRARY/libCLI/arguments/src/kracken.f90
! 
include "kracken.f90"
!-----------------------------------------------------------------------------------------------------------------------------------
PROGRAM ttee
!
! "@(#) ttee(1) writes stdin to stdout and another file with an optional timestamp prefix"
!
   USE m_kracken                    ! command line parameter cracking module
   IMPLICIT NONE

   integer , parameter :: clen=1024 !
   CHARACTER(len=clen) :: string    ! input line limit

   CHARACTER :: prefix*20           ! prefix string
   CHARACTER(LEN=8) :: date         ! date for use in prefix
   CHARACTER(LEN=10) :: time        ! time for use in prefix
   CHARACTER(LEN=10) :: access      ! whether to append or overwrite output file

   CHARACTER :: file*4096           ! output filenames
   INTEGER :: outfile               ! unit number for output file

   INTEGER :: ios                   ! value of iostat on i/o errors

   INTEGER :: iend1,iend2,ilen,ier
   INTEGER :: len1,len2,len3        ! scratch variables for accumulating output filenames

   CHARACTER(LEN=1024) :: strtok    ! token function
   CHARACTER(LEN=clen) :: token     ! individual filenames
   CHARACTER(LEN=4)   :: delimiters ! token delimiters
   INTEGER :: i10                   ! counter for looping through file names
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!  crack command line
   CALL kracken('ttee','-o --output -a .F. --append .F. --timestamp none --help .F. --version .F.')
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!  display version number if --version is present
   IF(lget('ttee_-version'))THEN
      WRITE(*,*)'ttee(1): version 1.0'
      STOP
   ENDIF
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!  display help text and exit if --help is present
   IF(lget('ttee_-help'))THEN
      CALL usage()
   ENDIF
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!  decide whether to append to output file or overwrite it if -a or --append is present
   access='sequential'
   IF(lget('ttee_a'))THEN
      access='append'
   ENDIF
   IF(lget('ttee_-append'))THEN
      access='append'
   ENDIF
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!  open optional output file ... simply append FILENAME, -o FILENAME, -output FILENAME
   file=' '
   CALL retrev('ttee_oo', file, len1, ier)              ! get any filename before any keywords
   len2=min(clen,len1+2)
   CALL retrev('ttee_o', file(len2:), len1, ier)        ! append any filenames after -o keyword
   len2=MIN(clen,len2+2+len1+2)
   CALL retrev('ttee_-output', file(len2:), len1, ier)  ! append any filenames after -output keyword
   len3=LEN_TRIM(file)                                  ! length of appended filenames

   IF(len3.NE.0)THEN
      outfile=9                                         ! initialize value used to get unit numbers for output files
                                                        ! get list of filename separators
      delimiters(1:1)=' '                               !   space
      delimiters(2:2)=CHAR(9)                           !   horizontal tab
      delimiters(3:3)=CHAR(13)                          !   carriage return
      delimiters(4:4)=CHAR(10)                          !   line feed (new line)

      token = strtok(file, delimiters)                  ! get first filename from list
      DO WHILE (token .NE. char(0))
	 outfile=outfile+1
         OPEN(UNIT=outfile,FILE=token(:LEN_TRIM(token)),ACCESS=access,IOSTAT=ios,ERR=444)
         token = strtok(CHAR(0), delimiters)
      ENDDO
   ELSE 
      outfile=-1                                        ! flag there is no output file specified
   ENDIF
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!  set prefix length to 0 or 20 depending on whether --timestamp value flags file to have timestamp prefix
   iend1=20 ! number of prefix characters for stdout
   iend2=20 ! number of prefix characters for outfiles
   prefix=''! initialize prefix string
   CALL retrev('ttee_-timestamp', file, ilen, ier)
   IF(file(:ilen).EQ.'all')THEN
      iend1=20
      iend2=20
   ELSEIF(ilen.EQ.0)THEN ! blank
      iend1=20
      iend2=20
   ELSEIF(file(:ilen).EQ.'stdout')THEN
      iend1=20
      iend2=0
   ELSEIF(file(:ilen).EQ.'output')THEN
      iend1=0
      iend2=20
   ELSEIF(file(:ilen).EQ.'none')THEN
      iend1=0
      iend2=0
   ELSE
      CALL stderr('unknown timestamp value [stdout|all|output|none]')
      STOP
   ENDIF
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!  loop reading stdin till end-of-file or error and write to stdout and output file with optional timestamp prefix
   DO
      READ(*,'(A)',ERR=111,END=999,IOSTAT=ios) string
      ilen=LEN_TRIM(string)
      IF(iend1.NE.0.OR.iend2.NE.0)THEN
         CALL DATE_AND_TIME(DATE=date,TIME=time)
         prefix(1:8)=date
         prefix(10:19)=time
         prefix(9:9)=' '
         prefix(20:20)=':'
      ENDIF
      WRITE(*,'(A,A)',ERR=222,IOSTAT=ios)   prefix(:iend1),string(:ilen)
      IF(outfile.GE.0)THEN
         DO I10=10,outfile
            WRITE(I10,'(A,A)',ERR=333,IOSTAT=ios)  prefix(:iend2),string(:ilen)
	 ENDDO
      ENDIF
   ENDDO
   GOTO 999
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! some error messages
111 CONTINUE
   ! CALL stderr('error reading from stdin')
   ! WRITE(string,'(''IOSTAT='',i10)')ios
   ! CALL stderr(string)
   GOTO 999
222 CONTINUE
   CALL stderr('error writing to stout')
   WRITE(string,'(''IOSTAT='',i10)')ios
   CALL stderr(string)
   GOTO 999
333 CONTINUE
   CALL stderr('error writing to output')
   WRITE(string,'(''IOSTAT='',i10)')ios
   CALL stderr(string)
   GOTO 999
444 CONTINUE
   CALL stderr('error opening output')
   WRITE(string,'(''IOSTAT='',i10)')ios
   CALL stderr(string)
   GOTO 999
999 CONTINUE
   STOP
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
END PROGRAM 
!-----------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE stderr(message)
   !
   ! "@(#) stderr writes a message to standard error using a standard f2003 method"
   !
   USE ISO_FORTRAN_ENV, ONLY : ERROR_UNIT             ! access computing environment
   CHARACTER(LEN=*) :: message
   WRITE(ERROR_UNIT,'(a)')message(:len_trim(message)) ! write message to standard error
END SUBROUTINE stderr
!-----------------------------------------------------------------------------------------------------------------------------------
subroutine usage()
   !
   ! "@(#) usage(3f90) writes program help to stdout and exits
   !
      write(*,*)'NAME'
      write(*,*)'       ttee(1)'
      write(*,*)''
      write(*,*)'SYNOPSIS'
      write(*,*)'       ttee [[-o|--output] filename] [-a|--append] [--timestamp FLAG] ...'
      write(*,*)'             [--help ] [--version]'
      write(*,*)'       ttee [OPTION]... [FILE]...'
      write(*,*)''
      write(*,*)'DESCRIPTION'
      write(*,*)'       Read from standard input and write to standard output and files'
      write(*,*)'       with an optional timestamp in front of each line.'
      write(*,*)''
      write(*,*)'       -o --output'
      write(*,*)'             specify name of output log file'
      write(*,*)''
      write(*,*)'       -a --append'
      write(*,*)'	      append to the given FILEs, do not overwrite'
      write(*,*)''
      write(*,*)'       --timestamp'
      write(*,*)'              which files to add the timestamp to. Default is "none"'
      write(*,*)'              Allowed values are stdout, output, all, none.'
      write(*,*)''
      write(*,*)'       --help display this help and exit'
      write(*,*)''
      write(*,*)'       --version'
      write(*,*)'	      output version information and exit'
      write(*,*)''
      write(*,*)'EXAMPLES'
      write(*,*)''
      write(*,*)'       program|ttee --output ttee.out --timestamp output|grep -i iteration'
      write(*,*)''
      write(*,*)'AUTHOR'
      write(*,*)'       John S. Urban'
      write(*,*)''
      write(*,*)'COPYRIGHT'
      write(*,*)'       Copyright (C) 2009 John S. Urban'
      write(*,*)'       This is free software: you are free to change and redistribute it.'
      write(*,*)'       There is NO WARRANTY, to the extent permitted by law.'
      write(*,*)''
      write(*,*)'LIMITS'
      write(*,*)''
      write(*,*)'       Input line width maximum is 1024 characters.'
      write(*,*)'       Maximum length of output filenames is 4098, individual filename  is 1024.'
      write(*,*)'       Minimum number of output files is probably at least 90; may be system dependent.'
      write(*,*)''
      write(*,*)''
      write(*,*)'SEE ALSO'
      write(*,*)'        tee(1), cat(1), xargs(1)'
      stop
end subroutine usage
!-----------------------------------------------------------------------------------------------------------------------------------
CHARACTER*1024 FUNCTION strtok (source_string, delimiters)

!     @(#) Tokenize a string in a similar manner to C routine strtok(3c). 
!
!  DESCRIPTION:
!       The  `STRTOK'  function is used to isolate sequential tokens
!       in a null-terminated string, `*SOURCE_STRING'. These tokens are
!       delimited in the  string by  at  least  one  of the characters
!       in `*DELIMITERS'.  The first time that `STRTOK' is called,
!       `*SOURCE_STRING'  should  be  specified;  subsequent calls,
!       wishing  to  obtain further tokens from the same string, should
!       pass a null pointer instead.  The separator string, `*DELIMITERS',
!       must be supplied each time and may change between calls.
!
!  USAGE:
!        First call STRTOK() with the string to tokenize as SOURCE_STRING,
!        and the delimiter list used to tokenize SOURCE_STRING in DELIMITERS.
!
!        then, if the returned value is not equal to CHAR(0), keep calling until it is
!        with SOURCE_STRING set to CHAR(0).
!
!        STRTOK will return a token on each call until the entire line is processed,
!        which it signals by returning CHAR(0). 
!
!     Input:  source_string =   Source string to tokenize. 
!             delimiters    =   Delimiter string.  Used to determine the beginning/end of each token in a string.
!
!     Output: strtok()
!
!     LIMITATIONS:
!     can not be called with a different string until current string is totally processed, even from different procedures
!     input string length limited to set size
!     function returns fixed 1024 character length
!     length of returned string not given

!     PARAMETERS:
      CHARACTER(len=*),intent(in)  :: source_string
      CHARACTER(len=*),intent(in)  :: delimiters

!     SAVED VALUES:
      CHARACTER(len=1024),save :: saved_string
      INTEGER,save :: isaved_start  ! points to beginning of unprocessed data
      INTEGER,save :: isource_len   ! length of original input string

!     LOCAL VALUES:
      INTEGER :: ibegin        ! beginning of token to return
      INTEGER :: ifinish       ! end of token to return

      ! initialize stored copy of input string and pointer into input string on first call
      IF (source_string(1:1) .NE. CHAR(0)) THEN
          isaved_start = 1                 ! beginning of unprocessed data
          saved_string = source_string     ! save input string from first call in series
          isource_len = LEN(saved_string)  ! length of input string from first call
      ENDIF

      ibegin = isaved_start

      DO
         IF ( (ibegin .LE. isource_len) .AND. (INDEX(delimiters,saved_string(ibegin:ibegin)) .NE. 0)) THEN
             ibegin = ibegin + 1
         ELSE
             EXIT
         ENDIF
      ENDDO

      IF (ibegin .GT. isource_len) THEN
          strtok = CHAR(0)
          RETURN
      ENDIF

      ifinish = ibegin

      DO
         IF ((ifinish .LE. isource_len) .AND.  (INDEX(delimiters,saved_string(ifinish:ifinish)) .EQ. 0)) THEN
             ifinish = ifinish + 1
         ELSE
             EXIT
         ENDIF
      ENDDO

      !strtok = "["//saved_string(ibegin:ifinish-1)//"]"
      strtok = saved_string(ibegin:ifinish-1)
      isaved_start = ifinish

END FUNCTION strtok
!-----------------------------------------------------------------------------------------------------------------------------------

category: code