Fortran Wiki
d2u

!-------------------------------------------------------------------------------
!ident  "@(#)d2u(1f) convert printable ASCII files between Unix and DOS line terminator conventions.  John S. Urban, 20090622
!-------------------------------------------------------------------------------
! Purpose: An example of a simple utility that uses stream I/O per Fortran 2003
! Author:  urbanjost
! Date:    Mon Jun 22, 2009
!-------------------------------------------------------------------------------
! REQUIRES:
!#URL http://home.comcast.net/~urbanjost/LIBRARY/libCLI/arguments/src/kracken.f90
!-------------------------------------------------------------------------------
! LICENSE:
!  This program is free software; you can redistribute it and/or
!  modify it under the terms of the GNU General Public
!  License as published by the Free Software Foundation; either
!  version 2 of the License, or (at your option) any later version.
!
!  This program is distributed in the hope that it will be useful,
!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
!  General Public License for more details.
!
!  You should have received a copy of the GNU General Public
!  License along with this program; if not, write to the Free
!  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!-------------------------------------------------------------------------------
!  modeled loosely on d2u.c, a similar utility written in C.
!  Copyright 2001 Purple Sage Computing Solutions, Inc.
!  All Rights Reserved
!  Released under the GNU General Public License version 2
!  Contact:
!  Purple Sage Computing Solutions, Inc.
!    email .... dnagle@erols.com
!    fax ...... 703 471 0684 (USA)
!    mail ..... 12142 Purple Sage Ct.
!               Reston, VA 20194-5621 USA
!-------------------------------------------------------------------------------
subroutine usage()
print *,'______________________________________________________________________________'
print *,' d2u: Version 1.0 20090622                                                    '
print *,'  convert printable ASCII files between Unix and DOS conventions              '
print *,'   o  DOS  end-of-line is CR-LF(carriage-return, line-feed)                   '
print *,'   o  Unix end-of-line is conventionally line-feed(LF), often called "newline"'
print *,'______________________________________________________________________________'
print *,' usage:                                                                       '
print *,'   d2u [-makedos|-makeunix] [-z] [-v] -i input -o output                      '
print *,'                                                                              '
print *,' -makedos         convert Unix file to DOS           ( newline to CR-LF )     '
print *,' -makeunix        (default) convert DOS file to Unix ( CR-LF to newline )     '
print *,' -z               guarantee last character of DOS file is ^Z,                 '
print *,'                  guarantee last character of Unix file is not ^Z             '
print *,'                  otherwise, ^Z in input is copied or not as-is               '
print *,' -v               verbose mode reports character and line counts              '
print *,' -i input_file    (required) input file                                       '
print *,' -o output_file   (required) output file                                      '
print *,'______________________________________________________________________________'
end subroutine usage
!-------------------------------------------------------------------------------
module GLOBAL

!  constants
   character(len=1),parameter ::  CZ=CHAR(26) ! DOS eof (ctrl-Z)
   character(len=1),parameter ::  NL=CHAR(10) ! Unix end of line
   character(len=1),parameter ::  CR=CHAR(13) ! DOS carriage-return
   character(len=1),parameter ::  LF=CHAR(10) ! DOS line-feed

   character(len=*),parameter ::  version='d2u(1f) V1.0'

!  global variables
!  input & output files
   integer :: IUNIT=15                        ! input file unit
   integer :: OUNIT=16                        ! output file unit

!  flags indicating command line options
   logical  :: process_ctrl_z = .false.       ! process ^Z or not
   logical  :: verbose = .false.              ! print report or not

!  character and line counts
   integer  :: chars_read = 0                 ! count chars read
   integer  :: chars_written = 0              ! count chars written
   integer  :: lines_written = 0              ! count lines

end module GLOBAL
!-------------------------------------------------------------------------------
! procedures
!-------------------------------------------------------------------------------
subroutine dos_to_unix()                      ! copy CR-LF to newline
use GLOBAL
USE ISO_FORTRAN_ENV, ONLY : ERROR_UNIT        ! access computing environment
   character(len=1) :: c                      ! character to be copied
   character(len=1) :: prev_c                 ! look ahead character
   if( verbose ) write(ERROR_UNIT,'(a)')" mode: dos to unix"
   read(IUNIT,iostat=ios,pos=chars_read+1)prev_c  ! start prev_c, c pipeline
   if( ios /= 0 )then   ! check eof
      write(ERROR_UNIT,'(a)')"Empty input file"
      stop 1                                  ! quit if no work
   endif
   chars_read=chars_read+1                    ! count chars
                                              ! copy character by character

   do
      read(IUNIT,iostat=ios,pos=chars_read+1)c! read to eof
      if(ios /= 0 ) exit
      chars_read=chars_read+1                 ! count chars
!     check for a CR-LF sequence
      if( (prev_c == CR) .and. (c == LF) )then! found CR-LF
         write(OUNIT)NL                       ! write char
         chars_written=chars_written+1        ! count chars
         lines_written=lines_written+1        ! count lines

         read(IUNIT,iostat=ios,pos=chars_read+1)c ! reload pipeline
         if( ios /= 0 )then                   ! check eof
            prev_c = c                        ! set flag
            exit                              ! quit at eof
         endif
         chars_read=chars_read+1
      else                                    ! any other
         write(OUNIT)prev_c                   ! write char
         chars_written=chars_written+1        ! count chars
      endif
      prev_c = c                              ! cycle pipeline
   enddo
                                              ! ctrl-Z as-is
   if( process_ctrl_z)then                    ! write last character
      if( prev_c /= CZ ) then
         write(OUNIT)prev_c                   ! write char
         chars_written=chars_written+1        ! count it
      endif
   else                                       ! guarantee no ^Z
      if((prev_c /= CZ)) then                 ! char is not ^Z
         write(OUNIT)prev_c                   ! write char
         chars_written=chars_written+1        ! count it
      endif
   endif
   return                                     ! done dos_to_unix()
end subroutine dos_to_unix
!-------------------------------------------------------------------------------
subroutine unix_to_dos()                      ! copy newline to CR-LF
use GLOBAL
USE ISO_FORTRAN_ENV, ONLY : ERROR_UNIT        ! access computing environment
   character(len=1) :: c                      ! character to be copied
   character(len=1) :: prev_c
   if( verbose ) write(ERROR_UNIT,'(a)')" mode: unix to dos"
                                              ! copy character by character
   do
   read(IUNIT,iostat=ios,pos=chars_read+1)c   ! read to eof
   if( ios /= 0 ) exit
      chars_read=chars_read+1                 ! count chars
      if( c == NL ) then                      ! if newline
         write(OUNIT)CR                       ! write CR
         chars_written=chars_written+1        ! count char
         write(OUNIT)LF                       ! write LF
         chars_written=chars_written+1        ! count char
         lines_written=lines_written+1        ! count line
      else                                    ! any other char
         write(OUNIT)c                        ! write char
         chars_written=chars_written+1        ! count char
      endif
      prev_c = c                              ! check to guarantee ^Z
   enddo
                                              ! complain if input empty
   if( chars_read == 0 ) then                 ! nothing was read
      write(ERROR_UNIT,'(a)')"Empty input file"
      stop 1                                  ! quit if no work
   endif
                                              ! check last character
   if( process_ctrl_z)then                    ! guarantee ^Z
      if( prev_c /= CZ ) then                 ! last char is not ^Z
         write(OUNIT)CZ                       ! write CZ
         chars_written=chars_written+1        ! count char
      endif
   endif
   return                                     ! done unix_to_dos()
end subroutine unix_to_dos
!-------------------------------------------------------------------------------
! read command line, process file and optionally print statistics
program d2u
use GLOBAL
use M_kracken
USE ISO_FORTRAN_ENV, ONLY : ERROR_UNIT        ! access computing environment
   character(len=255) :: input                ! input file
   character(len=255) :: output               ! output file

!  usage: d2u [-makedos|-makeunix] [-z] [-v] -i input [-o output]
   call kracken('d2u',' &
   & -makeunix .true.   &
   & -makedos .false.   &
   & -z .false.         &
   & -v .false.         &
   & -i "-"             &
   & -o "-"             &
   & -version .false. --version .false.  &
   & -h @ --help @ -help @ -usage @ --usage @ &
   & ')
                                              ! quick check if help requested
   if (min(                      &
          & sget('d2u_h',1),     &
          & sget('d2u_-help',1), &
          & sget('d2u_help',1),  &
          & sget('d2u_usage',1), &
          & sget('d2u_-usage',1) &
      & ) <= ' ')then
      call usage()
      stop 2
   endif
   if(lget('d2u_version') .or. lget('d2u_-version') )then
      write(ERROR_UNIT,*) "VERSION: ",version
   endif

   process_ctrl_z= lget('d2u_z')           ! set flag to force ctrl-Z processing
   verbose= lget('d2u_v')                  ! report character & line counts

   call retrev('d2u_i',input,iflen,ier)    ! get -i FILENAME
   if(input /= '-' )then
      IUNIT=15
      open( &
        & unit=IUNIT,                   &
        & file=input(:len_trim(input)), &
        & status="old",                 &
        & access="stream"               &
      & )
   else
!!!!! this does not work
      IUNIT=5
      write(ERROR_UNIT,*)'E-R-R-O-R: missing input file'
      stop 3
      open(unit=IUNIT,access="stream",form="unformatted")
   endif

   call retrev('d2u_o',output,iflen,ier)      ! get -o FILENAME
   if(output /= '-' )then
      OUNIT=16
      open( &
        & unit=OUNIT,                     &
        & file=output(:len_trim(output)), &
        & status="replace",               &
        & access="stream"                 &
      & )
   else
!!!!! this does not work
      OUNIT=6
      write(ERROR_UNIT,*)'E-R-R-O-R: missing output file'
      stop 4
      open(unit=OUNIT,access="stream",form="unformatted")
   endif

!  process DOS file to Unix or Unix to DOS
   if (lget('d2u_makedos')) then
      call unix_to_dos()                      ! Unix to DOS
   else
      call dos_to_unix()                      ! DOS to Unix
   endif

   if( verbose ) write(ERROR_UNIT,*)                    &
                 & "input: ",input(:len_trim(input)),   &
		 & " output: ",output(:len_trim(output))
   if( verbose ) write(ERROR_UNIT,*)                    &
                 & "chars read: ",chars_read,                 &
		 & " chars  written: ",chars_written,          &
		 & " lines: ",lines_written   ! if verbose, report counts
end program d2u                               ! successful end of d2u
!-------------------------------------------------------------------------------