PartMC
2.2.0
|
00001 ! ------------------------------------------------------------ 00002 ! Copyright 2008 by Mark Gates 00003 ! 00004 ! This program is free software; you can redistribute or modify it under 00005 ! the terms of the GNU general public license (GPL), version 2 or later. 00006 ! 00007 ! This program is distributed in the hope that it will be useful, but 00008 ! WITHOUT ANY WARRANTY; without even the implied warranty of 00009 ! merchantability or fitness for a particular purpose. 00010 ! 00011 ! If you wish to incorporate this into non-GPL software, please contact 00012 ! me regarding licensing terms. 00013 ! 00014 ! ------------------------------------------------------------ 00015 ! Fortran 95 getopt() and getopt_long(), similar to those in standard C library. 00016 ! 00017 ! ch = getopt( optstring, [longopts] ) 00018 ! Returns next option character from command line arguments. 00019 ! If an option is not recognized, it returns '?'. 00020 ! If no options are left, it returns a null character, char(0). 00021 ! 00022 ! optstring contains characters that are recognized as options. 00023 ! If a character is followed by a colon, then it takes a required argument. 00024 ! For example, "x" recognizes "-x", while "x:" recognizes "-x arg" or "-xarg". 00025 ! 00026 ! optopt is set to the option character, even if it isn't recognized. 00027 ! optarg is set to the option's argument. 00028 ! optind has the index of the next argument to process. Initially optind=1. 00029 ! Errors are printed by default. Set opterr=.false. to suppress them. 00030 ! 00031 ! Grouped options are allowed, so "-abc" is the same as "-a -b -c". 00032 ! 00033 ! If longopts is present, it is an array of type(option_s), where each entry 00034 ! describes one long option. 00035 ! 00036 ! type option_s 00037 ! character(len=80) :: name 00038 ! logical :: has_arg 00039 ! character :: val 00040 ! end type 00041 ! 00042 ! The name field is the option name, without the leading -- double dash. 00043 ! Set the has_arg field to true if it requires an argument, false if not. 00044 ! The val field is returned. Typically this is set to the corresponding short 00045 ! option, so short and long options can be processed together. (But there 00046 ! is no requirement that every long option has a short option, or vice-versa.) 00047 ! 00048 ! ----- 00049 ! EXAMPLE 00050 ! program test 00051 ! use getopt_m 00052 ! implicit none 00053 ! character:: ch 00054 ! type(option_s):: opts(2) 00055 ! opts(1) = option_s( "alpha", .false., 'a' ) 00056 ! opts(2) = option_s( "beta", .true., 'b' ) 00057 ! do 00058 ! select case( getopt( "ab:c", opts )) 00059 ! case( char(0)) 00060 ! exit 00061 ! case( 'a' ) 00062 ! print *, 'option alpha/a' 00063 ! case( 'b' ) 00064 ! print *, 'option beta/b=', optarg 00065 ! case( '?' ) 00066 ! print *, 'unknown option ', optopt 00067 ! stop 00068 ! case default 00069 ! print *, 'unhandled option ', optopt, ' (this is a bug)' 00070 ! end select 00071 ! end do 00072 ! end program test 00073 ! 00074 ! Differences from C version: 00075 ! - when options are finished, C version returns -1 instead of char(0), 00076 ! and thus stupidly requires an int instead of a char. 00077 ! - does not support optreset 00078 ! - does not support "--" as last argument 00079 ! - if no argument, optarg is blank, not NULL 00080 ! - argc and argv are implicit 00081 ! 00082 ! Differences for long options: 00083 ! - optional argument to getopt(), rather than separate function getopt_long() 00084 ! - has_arg is logical, and does not support optional_argument 00085 ! - does not support flag field (and thus always returns val) 00086 ! - does not support longindex 00087 ! - does not support "--opt=value" syntax, only "--opt value" 00088 ! - knows the length of longopts, so does not need an empty last record 00089 00090 module getopt_m 00091 implicit none 00092 character(len=80):: optarg 00093 character:: optopt 00094 integer:: optind=1 00095 logical:: opterr=.true. 00096 00097 type option_s 00098 character(len=80) :: name 00099 logical :: has_arg 00100 character :: val 00101 end type option_s 00102 00103 ! grpind is index of next option within group; always >= 2 00104 integer, private:: grpind=2 00105 00106 contains 00107 00108 ! ---------------------------------------- 00109 ! Return str(i:j) if 1 <= i <= j <= len(str), 00110 ! else return empty string. 00111 ! This is needed because Fortran standard allows but doesn't *require* short-circuited 00112 ! logical AND and OR operators. So this sometimes fails: 00113 ! if ( i < len(str) .and. str(i+1:i+1) == ':' ) then 00114 ! but this works: 00115 ! if ( substr(str, i+1, i+1) == ':' ) then 00116 00117 character function substr( str, i, j ) 00118 ! arguments 00119 character(len=*), intent(in):: str 00120 integer, intent(in):: i, j 00121 00122 if ( 1 <= i .and. i <= j .and. j <= len(str)) then 00123 substr = str(i:j) 00124 else 00125 substr = '' 00126 endif 00127 end function substr 00128 00129 00130 ! ---------------------------------------- 00131 character function getopt( optstring, longopts ) 00132 ! arguments 00133 character(len=*), intent(in):: optstring 00134 type(option_s), intent(in), optional:: longopts(:) 00135 00136 ! local variables 00137 character(len=80):: arg 00138 00139 optarg = '' 00140 if ( optind > iargc()) then 00141 getopt = char(0) 00142 endif 00143 00144 call getarg( optind, arg ) 00145 if ( present( longopts ) .and. arg(1:2) == '--' ) then 00146 getopt = process_long( longopts, arg ) 00147 elseif ( arg(1:1) == '-' ) then 00148 getopt = process_short( optstring, arg ) 00149 else 00150 getopt = char(0) 00151 endif 00152 end function getopt 00153 00154 00155 ! ---------------------------------------- 00156 character function process_long( longopts, arg ) 00157 ! arguments 00158 type(option_s), intent(in):: longopts(:) 00159 character(len=*), intent(in):: arg 00160 00161 ! local variables 00162 integer:: i 00163 00164 ! search for matching long option 00165 optind = optind + 1 00166 do i = 1, size(longopts) 00167 if ( arg(3:) == longopts(i)%name ) then 00168 optopt = longopts(i)%val 00169 process_long = optopt 00170 if ( longopts(i)%has_arg ) then 00171 if ( optind <= iargc()) then 00172 call getarg( optind, optarg ) 00173 optind = optind + 1 00174 elseif ( opterr ) then 00175 print '(a,a,a)', "Error: option '", trim(arg), "' requires an argument" 00176 endif 00177 endif 00178 return 00179 endif 00180 end do 00181 ! else not found 00182 process_long = '?' 00183 if ( opterr ) then 00184 print '(a,a,a)', "Error: unrecognized option '", trim(arg), "'" 00185 endif 00186 end function process_long 00187 00188 00189 ! ---------------------------------------- 00190 character function process_short( optstring, arg ) 00191 ! arguments 00192 character(len=*), intent(in):: optstring, arg 00193 00194 ! local variables 00195 integer:: i, arglen 00196 00197 arglen = len( trim( arg )) 00198 optopt = arg(grpind:grpind) 00199 process_short = optopt 00200 00201 i = index( optstring, optopt ) 00202 if ( i == 0 ) then 00203 ! unrecognized option 00204 process_short = '?' 00205 if ( opterr ) then 00206 print '(a,a,a)', "Error: unrecognized option '-", optopt, "'" 00207 endif 00208 endif 00209 if ( i > 0 .and. substr( optstring, i+1, i+1 ) == ':' ) then 00210 ! required argument 00211 optind = optind + 1 00212 if ( arglen > grpind ) then 00213 ! -xarg, return remainder of arg 00214 optarg = arg(grpind+1:arglen) 00215 elseif ( optind <= iargc()) then 00216 ! -x arg, return next arg 00217 call getarg( optind, optarg ) 00218 optind = optind + 1 00219 elseif ( opterr ) then 00220 print '(a,a,a)', "Error: option '-", optopt, "' requires an argument" 00221 endif 00222 grpind = 2 00223 elseif ( arglen > grpind ) then 00224 ! no argument (or unrecognized), go to next option in argument (-xyz) 00225 grpind = grpind + 1 00226 else 00227 ! no argument (or unrecognized), go to next argument 00228 grpind = 2 00229 optind = optind + 1 00230 endif 00231 end function process_short 00232 00233 end module getopt_m