Clicky
Showing changes from revision #5 to #6:
(追記) Added (追記ここまで) | (削除) Removed (削除ここまで) | (削除) Chan (削除ここまで)(追記) ged (追記ここまで)
!-------------------------------------------------------------------------------
!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://www.urbanjost.altervista.org/LIBRARY/libCLI/arguments/src/kracken.f90 (削除ここまで)(追記) http://www.urbanjost.altervista.org/LIBRARY/libGPF/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
!-------------------------------------------------------------------------------