libsim Versione 7.2.6

◆ optionparser_make_completion()

subroutine optionparser_make_completion ( type(optionparser), intent(in) this)
private
Parametri
[in]thisoptionparser object with correctly initialised options

Definizione alla linea 1818 del file optionparser_class.F90.

1819! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
1820! authors:
1821! Davide Cesari <dcesari@arpa.emr.it>
1822! Paolo Patruno <ppatruno@arpa.emr.it>
1823
1824! This program is free software; you can redistribute it and/or
1825! modify it under the terms of the GNU General Public License as
1826! published by the Free Software Foundation; either version 2 of
1827! the License, or (at your option) any later version.
1828
1829! This program is distributed in the hope that it will be useful,
1830! but WITHOUT ANY WARRANTY; without even the implied warranty of
1831! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1832! GNU General Public License for more details.
1833!> Module for parsing command-line optons.
1834!! This module defines a class for parsing command-line arguments and
1835!! generating help messages similar to the one found in the Python
1836!! library.
1837!!
1838!! This is an example of use:
1839!! \include example_optionparser.F90
1840!!
1841!! \ingroup base
1842#include "config.h"
1843
1844MODULE optionparser_class
1845USE log4fortran
1846USE err_handling
1847USE kinds
1851IMPLICIT NONE
1852
1853
1854! private class
1855TYPE option
1856 CHARACTER(len=1) :: short_opt=''
1857 CHARACTER(len=80) :: long_opt=''
1858 INTEGER :: opttype=-1
1859 INTEGER :: need_arg=0 ! 0=no, 1=optional, 2=yes, was .FALSE.
1860 LOGICAL :: has_default=.false.
1861 CHARACTER(len=1),POINTER :: destc=>null()
1862 INTEGER :: destclen=0
1863 INTEGER :: helpformat=0 ! 0=txt, 1=markdown, 2=htmlform, improve!
1864 INTEGER,POINTER :: desti=>null()
1865 TYPE(arrayof_integer),POINTER :: destiarr=>null()
1866 REAL,POINTER :: destr=>null()
1867 TYPE(arrayof_real),POINTER :: destrarr=>null()
1868 DOUBLE PRECISION, POINTER :: destd=>null()
1869 TYPE(arrayof_doubleprecision),POINTER :: destdarr=>null()
1870 LOGICAL,POINTER :: destl=>null()
1871 TYPE(arrayof_logical),POINTER :: destlarr=>null()
1872 INTEGER,POINTER :: destcount=>null()
1873 INTEGER(kind=int_b),ALLOCATABLE :: help_msg(:)
1874END TYPE option
1875
1876#define ARRAYOF_ORIGTYPE TYPE(option)
1877#define ARRAYOF_TYPE arrayof_option
1878#define ARRAYOF_ORIGDESTRUCTOR(x) CALL option_delete(x)
1879#define ARRAYOF_PRIVATE 1
1880#include "arrayof_pre_nodoc.F90"
1881! from arrayof
1882!PUBLIC insert, append, remove, packarray
1883!PUBLIC insert_unique, append_unique
1884
1885!> This class allows to parse the command-line options of a program in
1886!! an object-oriented way, similarly to the optparse class found in
1887!! Python library.
1888!!
1889!! The class handles both GNU-style long options, introduced by a
1890!! double dash \c -- and containing any printable ASCII character
1891!! except the equal sign \c = , and the traditional Unix short
1892!! options, introduced by a single dash \c - and containing a single
1893!! character which can be any printable ASCII character except the
1894!! dash itself.
1895!!
1896!! Options may require an argument, which can be integer, real, double
1897!! precision or character, in that case the argument may be given in
1898!! any of the following ways (long and short options):
1899!!
1900!! - <tt>--lon=34.5</tt>
1901!! - <tt>--lon 34.5</tt>
1902!! - <tt>-l34.5</tt>
1903!! - <tt>-l 34.5</tt>
1904!!
1905!! By default, the argument to an option is compulsory, so any
1906!! following string, even empty or starting with a dash \c - , is
1907!! interpreted as the argument to the option, while its absence
1908!! (i.e. end of command line) determines an error condition in the
1909!! parsing phase. However the argument to character options can be
1910!! declared as optional in the corresponding definition method; in
1911!! those cases the following argument, if any, is interpreted as the
1912!! argument to the option only if it does not start with a dash \c -
1913!! (no chance to quote a dash in these cases); if no optional argument
1914!! is found, then the variable associated to the option is set to the
1915!! missing value of the corresponding type, without raising an error
1916!! condition.
1917!!
1918!! Array options (only for integer, real and double precision) must be
1919!! provided as comma-separated values, similarly to a record of a csv
1920!! file, an empty field generates a missing value of the proper type
1921!! in the resulting array, the length of the array is not a priori
1922!! limited.
1923!!
1924!! Grouping of short options, like \c -xvf is not allowed. When a
1925!! double dash \c -- or an argument (which is not an argument to an
1926!! option) not starting by a dash \c - is encountered, the parsing of
1927!! options stops and the management of the remaining arguments
1928!! (typically a list of files) is left to the calling program.
1929!!
1930!! Options can be of the following kinds:
1931!!
1932!! - character (with additional argument, possibly optional)
1933!! - integer (with additional argument)
1934!! - real (with additional argument)
1935!! - double precision (with additional argument)
1936!! - array of integer (with additional argument)
1937!! - array of real (with additional argument)
1938!! - array of double precision (with additional argument)
1939!! - logical (without additional argument)
1940!! - count (without additional argument)
1941!! - help (with additional optional argument)
1942!! - separator (without additional argument)
1943!!
1944!! If the same option is encountered multiple times on the command
1945!! line, the value set in the last occurrence takes precedence, the
1946!! only exception is count options where every repetition increments
1947!! the corresponding counter by one.
1948!!
1949!! Options are added through the generic \a optionparser_add method
1950!! (for character, integer, floating point or logical options,
1951!! including array variants) or through the specific methods \a
1952!! optionparser_add_count, \a optionparser_add_help \a
1953!! optionparser_add_sep (for count, help and separator options).
1954!!
1955!! The effect of command line parsing is to set some desired variables
1956!! according to the information provided on the command line.
1957!!
1958!! Array options set the values of objects of derived types \a
1959!! arrayof_integer, \a arrayof_real and \a arrayof_doubleprecision
1960!! which are dynamically growable 1-d arrays defined in the \a
1961!! array_utilities module.
1962TYPE optionparser
1963 PRIVATE
1964 INTEGER(kind=int_b),POINTER :: usage_msg(:), description_msg(:)
1965 TYPE(arrayof_option) :: options
1966 LOGICAL :: httpmode=.false.
1967END TYPE optionparser
1968
1969
1970!> Add a new option of a specific type. Although the generic name
1971!! optionparser_add should be used, refer to the members of the interface
1972!! for a detailed documentation.
1973INTERFACE optionparser_add
1974 MODULE PROCEDURE optionparser_add_c, optionparser_add_i, optionparser_add_r, &
1975 optionparser_add_d, optionparser_add_l, &
1976 optionparser_add_iarray, optionparser_add_rarray, optionparser_add_darray
1977END INTERFACE
1978
1979INTERFACE c_e
1980 MODULE PROCEDURE option_c_e
1981END INTERFACE
1982
1983!> Destructor for the optionparser class.
1984!! It destroys the \a optionparser object freeing all the associated
1985!! memory. The values assigned through command line parsing are
1986!! conserved after deleting the \a optionparser object, but it is not
1987!! possible to show the help with the optionparser_printhelp method.
1988!!
1989!! \param this TYPE(optionparser) object to be destroyed
1990INTERFACE delete
1991 MODULE PROCEDURE optionparser_delete!?, option_delete
1992END INTERFACE
1993
1994
1995INTEGER,PARAMETER :: opttype_c = 1, opttype_i = 2, opttype_r = 3, &
1996 opttype_d = 4, opttype_l = 5, opttype_count = 6, opttype_help = 7, &
1997 opttype_sep = 8, opttype_carr = 11, opttype_iarr = 12, opttype_rarr = 13, &
1998 opttype_darr = 14, opttype_larr = 15
1999
2000INTEGER,PARAMETER :: optionparser_ok = 0 !< constants indicating the status returned by optionparser_parse, status of parsing: OK
2001INTEGER,PARAMETER :: optionparser_help = 1 !< status of parsing: help has been requested
2002INTEGER,PARAMETER :: optionparser_err = 2 !< status of parsing: an error was encountered
2003
2004
2005PRIVATE
2006PUBLIC optionparser, optionparser_new, delete, optionparser_add, &
2007 optionparser_add_count, optionparser_add_help, optionparser_add_sep, &
2008 optionparser_parse, optionparser_printhelp, &
2009 optionparser_ok, optionparser_help, optionparser_err
2010
2011
2012CONTAINS
2013
2014#include "arrayof_post_nodoc.F90"
2015
2016! Constructor for the option class
2017FUNCTION option_new(short_opt, long_opt, default, help) RESULT(this)
2018CHARACTER(len=*),INTENT(in) :: short_opt
2019CHARACTER(len=*),INTENT(in) :: long_opt
2020CHARACTER(len=*),INTENT(in) :: default
2021CHARACTER(len=*),OPTIONAL :: help
2022TYPE(option) :: this
2023
2024IF (short_opt == '' .AND. long_opt == '') THEN
2025#ifdef DEBUG
2026! programmer error condition, option empty
2027 CALL l4f_log(l4f_error, 'in optionparser, both short and long options empty')
2028 CALL raise_fatal_error()
2029#else
2030 CALL l4f_log(l4f_warn, 'in optionparser, both short and long options empty')
2031#endif
2032 RETURN
2033ENDIF
2034
2035this%short_opt = short_opt
2036this%long_opt = long_opt
2037IF (PRESENT(help)) THEN
2038 this%help_msg = fchar_to_cstr(trim(help)//trim(default)) ! f2003 automatic alloc
2039ENDIF
2040this%has_default = (len_trim(default) > 0)
2041
2042END FUNCTION option_new
2043
2044
2045! Destructor for the \a option class, the memory associated with
2046! the object is freed.
2047SUBROUTINE option_delete(this)
2048TYPE(option),INTENT(inout) :: this ! object to destroy
2049
2050IF (ALLOCATED(this%help_msg)) DEALLOCATE(this%help_msg)
2051NULLIFY(this%destc)
2052NULLIFY(this%desti)
2053NULLIFY(this%destr)
2054NULLIFY(this%destd)
2055NULLIFY(this%destl)
2056NULLIFY(this%destcount)
2057
2058END SUBROUTINE option_delete
2059
2060
2061FUNCTION option_found(this, optarg) RESULT(status)
2062TYPE(option),INTENT(inout) :: this
2063CHARACTER(len=*),INTENT(in),OPTIONAL :: optarg
2064INTEGER :: status
2065
2066TYPE(csv_record) :: arrparser
2067INTEGER :: ibuff
2068REAL :: rbuff
2069DOUBLE PRECISION :: dbuff
2070
2071status = optionparser_ok
2072
2073SELECT CASE(this%opttype)
2074CASE(opttype_c)
2075 CALL dirty_char_assignment(this%destc, this%destclen, trim(optarg))
2076! this%destc(1:this%destclen) = optarg
2077 IF (len_trim(optarg) > this%destclen) THEN
2078 CALL l4f_log(l4f_warn, &
2079 'in optionparser, argument '''//trim(optarg)//''' too long, truncated')
2080 ENDIF
2081CASE(opttype_i)
2082 READ(optarg,'(I12)',err=100)this%desti
2083CASE(opttype_iarr)
2084 CALL delete(this%destiarr) ! delete default values
2085 CALL init(arrparser, optarg)
2086 DO WHILE(.NOT.csv_record_end(arrparser))
2087 CALL csv_record_getfield(arrparser, ibuff)
2088 CALL insert(this%destiarr, ibuff)
2089 ENDDO
2090 CALL packarray(this%destiarr)
2091 CALL delete(arrparser)
2092CASE(opttype_r)
2093 READ(optarg,'(F20.0)',err=102)this%destr
2094CASE(opttype_rarr)
2095 CALL delete(this%destrarr) ! delete default values
2096 CALL init(arrparser, optarg)
2097 DO WHILE(.NOT.csv_record_end(arrparser))
2098 CALL csv_record_getfield(arrparser, rbuff)
2099 CALL insert(this%destrarr, rbuff)
2100 ENDDO
2101 CALL packarray(this%destrarr)
2102 CALL delete(arrparser)
2103CASE(opttype_d)
2104 READ(optarg,'(F20.0)',err=102)this%destd
2105CASE(opttype_darr)
2106 CALL delete(this%destdarr) ! delete default values
2107 CALL init(arrparser, optarg)
2108 DO WHILE(.NOT.csv_record_end(arrparser))
2109 CALL csv_record_getfield(arrparser, dbuff)
2110 CALL insert(this%destdarr, dbuff)
2111 ENDDO
2112 CALL packarray(this%destdarr)
2113 CALL delete(arrparser)
2114CASE(opttype_l)
2115 this%destl = .true.
2116CASE(opttype_count)
2117 this%destcount = this%destcount + 1
2118CASE(opttype_help)
2119 status = optionparser_help
2120 SELECT CASE(optarg) ! set help format
2121 CASE('md', 'markdown')
2122 this%helpformat = 1
2123 CASE('htmlform')
2124 this%helpformat = 2
2125 END SELECT
2126END SELECT
2127
2128RETURN
2129
2130100 status = optionparser_err
2131CALL l4f_log(l4f_error, &
2132 'in optionparser, argument '''//trim(optarg)//''' not valid as integer')
2133RETURN
2134102 status = optionparser_err
2135CALL l4f_log(l4f_error, &
2136 'in optionparser, argument '''//trim(optarg)//''' not valid as real')
2137RETURN
2138
2139END FUNCTION option_found
2140
2141
2142! Return a string which gives a short representation of the
2143! option \a this, without help message. The resulting string is quite
2144! long and it should be trimmed with the \a TRIM() intrinsic
2145! function.
2146FUNCTION option_format_opt(this) RESULT(format_opt)
2147TYPE(option),INTENT(in) :: this
2148
2149CHARACTER(len=100) :: format_opt
2150
2151CHARACTER(len=20) :: argname
2152
2153SELECT CASE(this%opttype)
2154CASE(opttype_c)
2155 argname = 'STRING'
2156CASE(opttype_i)
2157 argname = 'INT'
2158CASE(opttype_iarr)
2159 argname = 'INT[,INT...]'
2160CASE(opttype_r, opttype_d)
2161 argname = 'REAL'
2162CASE(opttype_rarr, opttype_darr)
2163 argname = 'REAL[,REAL...]'
2164CASE default
2165 argname = ''
2166END SELECT
2167
2168format_opt = ''
2169IF (this%short_opt /= '') THEN
2170 format_opt(len_trim(format_opt)+1:) = ' -'//this%short_opt
2171 IF (argname /= '') THEN
2172 format_opt(len_trim(format_opt)+1:) = ' '//trim(argname)
2173 ENDIF
2174ENDIF
2175IF (this%short_opt /= '' .AND. this%long_opt /= '') THEN
2176 format_opt(len_trim(format_opt)+1:) = ','
2177ENDIF
2178IF (this%long_opt /= '') THEN
2179 format_opt(len_trim(format_opt)+1:) = ' --'//this%long_opt
2180 IF (argname /= '') THEN
2181 format_opt(len_trim(format_opt)+1:) = '='//trim(argname)
2182 ENDIF
2183ENDIF
2184
2185END FUNCTION option_format_opt
2186
2187
2188! print on stdout a human-readable text representation of a single option
2189SUBROUTINE option_format_help(this, ncols)
2190TYPE(option),INTENT(in) :: this
2191INTEGER,INTENT(in) :: ncols
2192
2193INTEGER :: j
2194INTEGER, PARAMETER :: indent = 10
2195TYPE(line_split) :: help_line
2196
2197
2198IF (this%opttype == opttype_sep) THEN ! special treatment for separator type
2199 IF (ALLOCATED(this%help_msg)) THEN
2200! help2man is quite picky about the treatment of arbitrary lines
2201! within options, the only universal way seems to be unindented lines
2202! with an empty line before and after
2203 help_line = line_split_new(cstr_to_fchar(this%help_msg), ncols)
2204 WRITE(*,'()')
2205 DO j = 1, line_split_get_nlines(help_line)
2206 WRITE(*,'(A)')trim(line_split_get_line(help_line,j))
2207 ENDDO
2208 CALL delete(help_line)
2209 WRITE(*,'()')
2210 ENDIF
2211ELSE ! ordinary option
2212! print option brief representation
2213 WRITE(*,'(A)')trim(option_format_opt(this))
2214! print option help
2215 IF (ALLOCATED(this%help_msg)) THEN
2216 help_line = line_split_new(cstr_to_fchar(this%help_msg), ncols-indent)
2217 DO j = 1, line_split_get_nlines(help_line)
2218 WRITE(*,'(T10,A)')trim(line_split_get_line(help_line,j))
2219 ENDDO
2220 CALL delete(help_line)
2221 ENDIF
2222ENDIF
2223
2224END SUBROUTINE option_format_help
2225
2226
2227! print on stdout a markdown representation of a single option
2228SUBROUTINE option_format_md(this, ncols)
2229TYPE(option),INTENT(in) :: this
2230INTEGER,INTENT(in) :: ncols
2231
2232INTEGER :: j
2233INTEGER, PARAMETER :: indent = 2
2234TYPE(line_split) :: help_line
2235
2236IF (this%opttype == opttype_sep) THEN ! special treatment for separator type
2237 IF (ALLOCATED(this%help_msg)) THEN
2238 help_line = line_split_new(cstr_to_fchar(this%help_msg), ncols)
2239 WRITE(*,'()')
2240 DO j = 1, line_split_get_nlines(help_line)
2241 WRITE(*,'(A)')trim(line_split_get_line(help_line,j))
2242 ENDDO
2243 CALL delete(help_line)
2244 WRITE(*,'()')
2245 ENDIF
2246ELSE ! ordinary option
2247! print option brief representation
2248 WRITE(*,'(''`'',A,''`'')')trim(option_format_opt(this))
2249! print option help
2250 IF (ALLOCATED(this%help_msg)) THEN
2251 help_line = line_split_new(cstr_to_fchar(this%help_msg), ncols-indent)
2252 DO j = 1, line_split_get_nlines(help_line)
2253 WRITE(*,'(''> '',A)')trim(line_split_get_line(help_line,j))
2254 ENDDO
2255 CALL delete(help_line)
2256 WRITE(*,'()')
2257 ENDIF
2258ENDIF
2259
2260END SUBROUTINE option_format_md
2261
2262
2263! print on stdout an html form representation of a single option
2264SUBROUTINE option_format_htmlform(this)
2265TYPE(option),INTENT(in) :: this
2266
2267CHARACTER(len=80) :: opt_name, opt_id, opt_default ! check len of default
2268
2269IF (.NOT.c_e(this)) RETURN
2270IF (this%long_opt == '') THEN
2271 opt_name = this%short_opt
2272 opt_id = 'short_opt_'//this%short_opt
2273ELSE
2274 opt_name = this%long_opt
2275 opt_id = this%long_opt
2276ENDIF
2277
2278SELECT CASE(this%opttype)
2279CASE(opttype_c)
2280 CALL option_format_html_openspan('text')
2281
2282 IF (this%has_default .AND. ASSOCIATED(this%destc) .AND. this%destclen > 0) THEN
2283! opt_default = TRANSFER(this%destc(1:MIN(LEN(opt_default),this%destclen)), &
2284! opt_default) ! improve
2285 opt_default = ''
2286 WRITE(*,'(A)')' value="'//trim(opt_default)//'"'
2287 ENDIF
2288 CALL option_format_html_help()
2289 CALL option_format_html_closespan()
2290
2291CASE(opttype_i,opttype_r,opttype_d)
2292 CALL option_format_html_openspan('text')
2293 IF (this%has_default) THEN
2294 SELECT CASE(this%opttype)
2295 CASE(opttype_i)
2296 WRITE(*,'(3A)')' value="',t2c(this%desti),'"'
2297! todo CASE(opttype_iarr)
2298 CASE(opttype_r)
2299 WRITE(*,'(3A)')' value="',t2c(this%destr),'"'
2300 CASE(opttype_d)
2301 WRITE(*,'(3A)')' value="',t2c(this%destd),'"'
2302 END SELECT
2303 ENDIF
2304 CALL option_format_html_help()
2305 CALL option_format_html_closespan()
2306
2307! todo CASE(opttype_iarr)
2308
2309CASE(opttype_l)
2310 CALL option_format_html_openspan('checkbox')
2311 CALL option_format_html_help()
2312 CALL option_format_html_closespan()
2313
2314CASE(opttype_count)
2315 CALL option_format_html_openspan('number')
2316 CALL option_format_html_help()
2317 CALL option_format_html_closespan()
2318
2319CASE(opttype_sep)
2320END SELECT
2321
2322
2323CONTAINS
2324
2325SUBROUTINE option_format_html_openspan(formtype)
2326CHARACTER(len=*),INTENT(in) :: formtype
2327
2328WRITE(*,'(A)')'<span class="libsim_optbox" id="span_'//trim(opt_id)//'">'//trim(opt_name)//':'
2329! size=? maxlen=?
2330WRITE(*,'(A)')'<input class_"libsim_opt" id="'//trim(opt_id)//'" type="'//formtype// &
2331 '" name="'//trim(opt_id)//'" '
2332
2333END SUBROUTINE option_format_html_openspan
2334
2335SUBROUTINE option_format_html_closespan()
2336
2337WRITE(*,'(A)')'/></span>'
2338
2339END SUBROUTINE option_format_html_closespan
2340
2341SUBROUTINE option_format_html_help()
2342INTEGER :: j
2343TYPE(line_split) :: help_line
2344CHARACTER(len=20) :: form
2345
2346IF (ALLOCATED(this%help_msg)) THEN
2347 WRITE(*,'(A,$)')' title="'
2348
2349 help_line = line_split_new(cstr_to_fchar(this%help_msg), 80)
2350 form = '(A,'' '')'
2351 DO j = 1, line_split_get_nlines(help_line)
2352 IF (j == line_split_get_nlines(help_line)) form = '(A,''"'',$)'
2353 WRITE(*,form)trim(line_split_get_line(help_line,j)) ! lines should be properly quoted here
2354 ENDDO
2355
2356ENDIF
2357
2358END SUBROUTINE option_format_html_help
2359
2360END SUBROUTINE option_format_htmlform
2361
2362
2363FUNCTION option_c_e(this) RESULT(c_e)
2364TYPE(option),INTENT(in) :: this
2365
2366LOGICAL :: c_e
2367
2368c_e = this%long_opt /= ' ' .OR. this%short_opt /= ' '
2369
2370END FUNCTION option_c_e
2371
2372
2373!> Create a new instance of an optionparser object.
2374!! General usage and description messages can be optionally provided,
2375!! the options will be added later.
2376FUNCTION optionparser_new(usage_msg, description_msg) RESULT(this)
2377CHARACTER(len=*), INTENT(in), OPTIONAL :: usage_msg !< short help message which describes the program usage, if not provided, a standard message will be printed
2378CHARACTER(len=*), INTENT(in), OPTIONAL :: description_msg !< long help message which describes the program purpose, if not provided, nothing will be printed
2379
2380TYPE(optionparser) :: this
2381
2382IF (PRESENT(usage_msg)) THEN
2383 CALL fchar_to_cstr_alloc(trim(usage_msg), this%usage_msg)
2384ELSE
2385 NULLIFY(this%usage_msg)
2386ENDIF
2387IF (PRESENT(description_msg)) THEN
2388 CALL fchar_to_cstr_alloc(trim(description_msg), this%description_msg)
2389ELSE
2390 NULLIFY(this%description_msg)
2391ENDIF
2392
2393END FUNCTION optionparser_new
2394
2395
2396SUBROUTINE optionparser_delete(this)
2397TYPE(optionparser),INTENT(inout) :: this
2398
2399IF (ASSOCIATED(this%usage_msg)) DEALLOCATE(this%usage_msg)
2400IF (ASSOCIATED(this%description_msg)) DEALLOCATE(this%description_msg)
2401CALL delete(this%options)
2402
2403END SUBROUTINE optionparser_delete
2404
2405
2406!> Add a new option with a character type argument.
2407!! When parsing will be performed, if the requested option is
2408!! encountered, its corresponding compulsory argument will be copied
2409!! into the provided destination, truncating it if it is too long. An
2410!! optional default value can be provided for the destination. Please
2411!! use the generic \a optionparser_add method rather than this
2412!! particular method.
2413SUBROUTINE optionparser_add_c(this, short_opt, long_opt, dest, default, help, isopt)
2414TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2415CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2416CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2417CHARACTER(len=*),TARGET :: dest !< the destination of the option parse result
2418CHARACTER(len=*),OPTIONAL :: default !< the default value to give to dest if option is not found
2419CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2420LOGICAL,INTENT(in),OPTIONAL :: isopt !< if provided and \c .TRUE. the argument is considered optional
2421
2422CHARACTER(LEN=60) :: cdefault
2423INTEGER :: i
2424TYPE(option) :: myoption
2425
2426
2427IF (PRESENT(default)) THEN
2428 cdefault = ' [default='//t2c(default, 'MISSING')//']'
2429ELSE
2430 cdefault = ''
2431ENDIF
2432
2433! common initialisation
2434myoption = option_new(short_opt, long_opt, cdefault, help)
2435IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2436
2437myoption%destc => dest(1:1)
2438myoption%destclen = len(dest) ! needed to avoid exceeding the length of dest
2439IF (PRESENT(default)) &
2440 CALL dirty_char_assignment(myoption%destc, myoption%destclen, default)
2441!IF (PRESENT(default)) myoption%destc(1:myoption%destclen) = default
2442myoption%opttype = opttype_c
2443IF (optio_log(isopt)) THEN
2444 myoption%need_arg = 1
2445ELSE
2446 myoption%need_arg = 2
2447ENDIF
2448
2449i = arrayof_option_append(this%options, myoption)
2450
2451END SUBROUTINE optionparser_add_c
2452
2453
2454!> Add a new option with an integer type argument.
2455!! When parsing will be performed, if the requested option is
2456!! encountered, its corresponding compulsory argument will be copied
2457!! into the provided destination. An optional default value can be
2458!! provided for the destination. Please use the generic \a
2459!! optionparser_add method rather than this particular method.
2460SUBROUTINE optionparser_add_i(this, short_opt, long_opt, dest, default, help)
2461TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2462CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2463CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2464INTEGER,TARGET :: dest !< the destination of the option parse result
2465INTEGER,OPTIONAL :: default !< the default value to give to dest if option is not found
2466CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2467
2468CHARACTER(LEN=40) :: cdefault
2469INTEGER :: i
2470TYPE(option) :: myoption
2471
2472IF (PRESENT(default)) THEN
2473 cdefault = ' [default='//t2c(default, 'MISSING')//']'
2474ELSE
2475 cdefault = ''
2476ENDIF
2477
2478! common initialisation
2479myoption = option_new(short_opt, long_opt, cdefault, help)
2480IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2481
2482myoption%desti => dest
2483IF (PRESENT(default)) myoption%desti = default
2484myoption%opttype = opttype_i
2485myoption%need_arg = 2
2486
2487i = arrayof_option_append(this%options, myoption)
2488
2489END SUBROUTINE optionparser_add_i
2490
2491
2492!> Add a new option with an integer type array argument.
2493!! When parsing will be performed, if the requested option is
2494!! encountered, its corresponding compulsory argument will be copied
2495!! into the provided destination. The argument must be provided in the
2496!! form of comma-separated list of values and is stored in an object
2497!! of type arrayof_integer (module \a array_utilities). An optional
2498!! default value can be provided for the destination. Please use the
2499!! generic \a optionparser_add method rather than this particular
2500!! method.
2501SUBROUTINE optionparser_add_iarray(this, short_opt, long_opt, dest, default, help)
2502TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2503CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2504CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2505TYPE(arrayof_integer),TARGET :: dest !< the destination of the option parse result
2506INTEGER,OPTIONAL :: default(:) !< the default value to give to dest if option is not found
2507CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2508
2509CHARACTER(LEN=40) :: cdefault
2510INTEGER :: i
2511TYPE(option) :: myoption
2512
2513cdefault = ''
2514IF (PRESENT(default)) THEN
2515 IF (SIZE(default) == 1) THEN
2516 cdefault = ' [default='//trim(to_char(default(1)))//']'
2517 ELSE IF (SIZE(default) > 1) THEN
2518 cdefault = ' [default='//trim(to_char(default(1)))//',...]'
2519 ENDIF
2520ENDIF
2521
2522! common initialisation
2523myoption = option_new(short_opt, long_opt, cdefault, help)
2524IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2525
2526myoption%destiarr => dest
2527IF (PRESENT(default)) THEN
2528 CALL insert(myoption%destiarr, default)
2529 CALL packarray(myoption%destiarr)
2530ENDIF
2531myoption%opttype = opttype_iarr
2532myoption%need_arg = 2
2533
2534i = arrayof_option_append(this%options, myoption)
2535
2536END SUBROUTINE optionparser_add_iarray
2537
2538
2539!> Add a new option with a real type argument.
2540!! When parsing will be performed, if the requested option is
2541!! encountered, its corresponding compulsory argument will be copied
2542!! into the provided destination. An optional value default can be
2543!! provided for the destination. Please use the generic \a
2544!! optionparser_add method rather than this particular method.
2545SUBROUTINE optionparser_add_r(this, short_opt, long_opt, dest, default, help)
2546TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2547CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2548CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2549REAL,TARGET :: dest !< the destination of the option parse result
2550REAL,OPTIONAL :: default !< the default value to give to dest if option is not found
2551CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2552
2553CHARACTER(LEN=40) :: cdefault
2554INTEGER :: i
2555TYPE(option) :: myoption
2556
2557IF (PRESENT(default)) THEN
2558 cdefault = ' [default='//t2c(default, 'MISSING')//']'
2559ELSE
2560 cdefault = ''
2561ENDIF
2562
2563! common initialisation
2564myoption = option_new(short_opt, long_opt, cdefault, help)
2565IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2566
2567myoption%destr => dest
2568IF (PRESENT(default)) myoption%destr = default
2569myoption%opttype = opttype_r
2570myoption%need_arg = 2
2571
2572i = arrayof_option_append(this%options, myoption)
2573
2574END SUBROUTINE optionparser_add_r
2575
2576
2577!> Add a new option with a real type array argument.
2578!! When parsing will be performed, if the requested option is
2579!! encountered, its corresponding compulsory argument will be copied
2580!! into the provided destination. The argument must be provided in the
2581!! form of comma-separated list of values and is stored in an object
2582!! of type arrayof_real (module \a array_utilities). An optional
2583!! default value can be provided for the destination. Please use the
2584!! generic \a optionparser_add method rather than this particular
2585!! method.
2586SUBROUTINE optionparser_add_rarray(this, short_opt, long_opt, dest, default, help)
2587TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2588CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2589CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2590TYPE(arrayof_real),TARGET :: dest !< the destination of the option parse result
2591REAL,OPTIONAL :: default(:) !< the default value to give to dest if option is not found
2592CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2593
2594CHARACTER(LEN=40) :: cdefault
2595INTEGER :: i
2596TYPE(option) :: myoption
2597
2598cdefault = ''
2599IF (PRESENT(default)) THEN
2600 IF (SIZE(default) == 1) THEN
2601 cdefault = ' [default='//trim(to_char(default(1)))//']'
2602 ELSE IF (SIZE(default) > 1) THEN
2603 cdefault = ' [default='//trim(to_char(default(1)))//',...]'
2604 ENDIF
2605ENDIF
2606
2607! common initialisation
2608myoption = option_new(short_opt, long_opt, cdefault, help)
2609IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2610
2611myoption%destrarr => dest
2612IF (PRESENT(default)) THEN
2613 CALL insert(myoption%destrarr, default)
2614 CALL packarray(myoption%destrarr)
2615ENDIF
2616myoption%opttype = opttype_rarr
2617myoption%need_arg = 2
2618
2619i = arrayof_option_append(this%options, myoption)
2620
2621END SUBROUTINE optionparser_add_rarray
2622
2623
2624!> Add a new option with a double precision type argument.
2625!! When parsing will be performed, if the requested option is
2626!! encountered, its corresponding compulsory argument will be copied
2627!! into the provided destination. An optional default value can be
2628!! provided for the destination. Please use the generic \a
2629!! optionparser_add method rather than this particular method.
2630SUBROUTINE optionparser_add_d(this, short_opt, long_opt, dest, default, help)
2631TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2632CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2633CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2634DOUBLE PRECISION,TARGET :: dest !< the destination of the option parse result
2635DOUBLE PRECISION,OPTIONAL :: default !< the default value to give to dest if option is not found
2636CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2637
2638CHARACTER(LEN=40) :: cdefault
2639INTEGER :: i
2640TYPE(option) :: myoption
2641
2642IF (PRESENT(default)) THEN
2643 IF (c_e(default)) THEN
2644 cdefault = ' [default='//trim(adjustl(to_char(default,form='(G15.9)')))//']'
2645 ELSE
2646 cdefault = ' [default='//t2c(default, 'MISSING')//']'
2647 ENDIF
2648ELSE
2649 cdefault = ''
2650ENDIF
2651
2652! common initialisation
2653myoption = option_new(short_opt, long_opt, cdefault, help)
2654IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2655
2656myoption%destd => dest
2657IF (PRESENT(default)) myoption%destd = default
2658myoption%opttype = opttype_d
2659myoption%need_arg = 2
2660
2661i = arrayof_option_append(this%options, myoption)
2662
2663END SUBROUTINE optionparser_add_d
2664
2665
2666!> Add a new option with a double precision type array argument.
2667!! When parsing will be performed, if the requested option is
2668!! encountered, its corresponding compulsory argument will be copied
2669!! into the provided destination. The argument must be provided in the
2670!! form of comma-separated list of values and is stored in an object
2671!! of type arrayof_doubleprecision (module \a array_utilities). An optional
2672!! default value can be provided for the destination. Please use the
2673!! generic \a optionparser_add method rather than this particular
2674!! method.
2675SUBROUTINE optionparser_add_darray(this, short_opt, long_opt, dest, default, help)
2676TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2677CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2678CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2679TYPE(arrayof_doubleprecision),TARGET :: dest !< the destination of the option parse result
2680DOUBLE PRECISION,OPTIONAL :: default(:) !< the default value to give to dest if option is not found
2681CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2682
2683CHARACTER(LEN=40) :: cdefault
2684INTEGER :: i
2685TYPE(option) :: myoption
2686
2687cdefault = ''
2688IF (PRESENT(default)) THEN
2689 IF (SIZE(default) == 1) THEN
2690 cdefault = ' [default='//trim(adjustl(to_char(default(1),form='(G15.9)')))//']'
2691 ELSE IF (SIZE(default) > 1) THEN
2692 cdefault = ' [default='//trim(adjustl(to_char(default(1),form='(G15.9)')))//',...]'
2693 ENDIF
2694ENDIF
2695
2696! common initialisation
2697myoption = option_new(short_opt, long_opt, cdefault, help)
2698IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2699
2700myoption%destdarr => dest
2701IF (PRESENT(default)) THEN
2702 CALL insert(myoption%destdarr, default)
2703 CALL packarray(myoption%destdarr)
2704ENDIF
2705myoption%opttype = opttype_darr
2706myoption%need_arg = 2
2707
2708i = arrayof_option_append(this%options, myoption)
2709
2710END SUBROUTINE optionparser_add_darray
2711
2712
2713!> Add a new logical option, without optional argument.
2714!! When parsing will be performed, if the requested option is
2715!! encountered, the provided destination will be set to \a
2716!! .TRUE. . The provided destination is initially set to \a
2717!! .FALSE. . Please use the generic \a optionparser_add method
2718!! rather than this particular method.
2719SUBROUTINE optionparser_add_l(this, short_opt, long_opt, dest, help)
2720TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2721CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2722CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2723LOGICAL,TARGET :: dest !< the destination of the option parse result
2724CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2725
2726INTEGER :: i
2727TYPE(option) :: myoption
2728
2729! common initialisation
2730myoption = option_new(short_opt, long_opt, '', help)
2731IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2732
2733myoption%destl => dest
2734myoption%destl = .false. ! unconditionally set to false, option can only set it to true
2735myoption%opttype = opttype_l
2736myoption%need_arg = 0
2737
2738i = arrayof_option_append(this%options, myoption)
2739
2740END SUBROUTINE optionparser_add_l
2741
2742
2743!> Add a new counter option, without optional argument.
2744!! When parsing will be performed, the provided destination will be
2745!! incremented by one, starting from \a start, each time the requested
2746!! option is encountered.
2747SUBROUTINE optionparser_add_count(this, short_opt, long_opt, dest, start, help)
2748TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2749CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2750CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2751INTEGER,TARGET :: dest !< the destination of the option parse result
2752INTEGER,OPTIONAL :: start !< initial value for \a dest
2753CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2754
2755INTEGER :: i
2756TYPE(option) :: myoption
2757
2758! common initialisation
2759myoption = option_new(short_opt, long_opt, '', help)
2760IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2761
2762myoption%destcount => dest
2763IF (PRESENT(start)) myoption%destcount = start
2764myoption%opttype = opttype_count
2765myoption%need_arg = 0
2766
2767i = arrayof_option_append(this%options, myoption)
2768
2769END SUBROUTINE optionparser_add_count
2770
2771
2772!> Add a new help option, with an optional argument.
2773!! When parsing will be performed, the full help message will be
2774!! printed if this option is encountered. The message can be directly
2775!! printed as well by calling the optparser_printhelp method. The
2776!! optional argument given by the user to the option specifies the
2777!! format of the help message, it can be one fo the following:
2778!!
2779!! - \c txt or no extra argument: generic plain-text format suitable
2780!! for printing to screen and to be fed to the \c help2man command
2781!! for generating man pages
2782!! - <tt>md</tt> or <tt>markdown</tt>: print help in markdown format,
2783!! suitable for wiki/github/doxygen etc. pages
2784!! - <tt>htmlform</tt>: print help as an html form suitable for
2785!! providing the options through a web interface (experimental)
2786SUBROUTINE optionparser_add_help(this, short_opt, long_opt, help)
2787TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2788CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2789CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2790CHARACTER(len=*),OPTIONAL :: help !< the help message that will be formatted and pretty-printed on screen
2791
2792INTEGER :: i
2793TYPE(option) :: myoption
2794
2795! common initialisation
2796myoption = option_new(short_opt, long_opt, '', help)
2797IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2798
2799myoption%opttype = opttype_help
2800myoption%need_arg = 1
2801
2802i = arrayof_option_append(this%options, myoption)
2803
2804END SUBROUTINE optionparser_add_help
2805
2806
2807!> Add a new separator option, with a text.
2808!! This is a dummy option that inserts a separator line with a text
2809!! within the list of options when the help is printed. It is useful
2810!! to insert a visual separator between options or an explanation
2811!! which is not associated with a specific options but applies to all
2812!! the subsequent options. The text provided will be formatted into
2813!! many lines if necessary. Any number of separator options can be
2814!! added within the option list; they have no effect on the
2815!! interpretation of the options associated with the optionparser
2816!! object.
2817SUBROUTINE optionparser_add_sep(this, help)
2818TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object
2819!CHARACTER(len=*),INTENT(in) :: short_opt !< the short option (may be empty)
2820!CHARACTER(len=*),INTENT(in) :: long_opt !< the long option (may be empty)
2821CHARACTER(len=*) :: help !< the help message that will be formatted and pretty-printed on screen
2822
2823INTEGER :: i
2824TYPE(option) :: myoption
2825
2826! common initialisation
2827myoption = option_new('_', '_', '', help)
2828IF (.NOT.c_e(myoption)) RETURN ! error in creating option, ignore it
2829
2830myoption%opttype = opttype_sep
2831myoption%need_arg = 0
2832
2833i = arrayof_option_append(this%options, myoption)
2834
2835END SUBROUTINE optionparser_add_sep
2836
2837
2838!> This method performs the parsing of the command-line options
2839!! which have been previously added using the optionparser_add family
2840!! of methods. The destination variables set through the
2841!! optionparser_add methods are assigned according to the options
2842!! encountered on the command line. If any optional argument remains
2843!! after interpretation of all command-line options, the index of the
2844!! first of them is returned in \a nextarg, otherwise \a nextarg is
2845!! equal to \a iargc() \a + \a 1. The status of the parsing process
2846!! should be checked via the \a status argument.
2847SUBROUTINE optionparser_parse(this, nextarg, status)
2848TYPE(optionparser),INTENT(inout) :: this !< \a optionparser object with correctly initialised options
2849INTEGER,INTENT(out) :: nextarg !< index of the first optional argument after interpretation of all command-line options
2850INTEGER,INTENT(out) :: status !< status of the parsing process, to be compared with the constants \a optionparser_ok, ecc.
2851
2852INTEGER :: i, j, endopt, indeq, iargc
2853CHARACTER(len=16384) :: arg, optarg
2854
2855status = optionparser_ok
2856i = 1
2857DO WHILE(i <= iargc())
2858 CALL getarg(i, arg)
2859 IF (arg == '--') THEN ! explicit end of options
2860 i = i + 1 ! skip present option (--)
2861 EXIT
2862 ELSE IF (arg == '-') THEN ! a single - is not an option
2863 EXIT
2864 ELSE IF (arg(1:2) == '--') THEN ! long option
2865 indeq = index(arg, '=')
2866 IF (indeq /= 0) THEN ! = present
2867 endopt = indeq - 1
2868 ELSE ! no =
2869 endopt = len_trim(arg)
2870 ENDIF
2871 find_longopt: DO j = 1, this%options%arraysize
2872 IF (this%options%array(j)%long_opt == arg(3:endopt)) THEN ! found option
2873 SELECT CASE(this%options%array(j)%need_arg)
2874 CASE(2) ! compulsory
2875 IF (indeq /= 0) THEN
2876 optarg = arg(indeq+1:)
2877 status = max(option_found(this%options%array(j), optarg), &
2878 status)
2879 ELSE
2880 IF (i < iargc()) THEN
2881 i=i+1
2882 CALL getarg(i, optarg)
2883 status = max(option_found(this%options%array(j), optarg), &
2884 status)
2885 ELSE
2886 status = optionparser_err
2887 CALL l4f_log(l4f_error, &
2888 'in optionparser, option '''//trim(arg)//''' requires an argument')
2889 ENDIF
2890 ENDIF
2891 CASE(1) ! optional
2892 IF (indeq /= 0) THEN
2893 optarg = arg(indeq+1:)
2894 ELSE
2895 IF (i < iargc()) THEN
2896 CALL getarg(i+1, optarg)
2897 IF (optarg(1:1) == '-') THEN
2898 optarg = cmiss ! refused
2899 ELSE
2900 i=i+1 ! accepted
2901 ENDIF
2902 ELSE
2903 optarg = cmiss ! refused
2904 ENDIF
2905 ENDIF
2906 status = max(option_found(this%options%array(j), optarg), &
2907 status)
2908 CASE(0)
2909 status = max(option_found(this%options%array(j)), &
2910 status)
2911 END SELECT
2912 EXIT find_longopt
2913 ENDIF
2914 ENDDO find_longopt
2915 IF (j > this%options%arraysize) THEN
2916 status = optionparser_err
2917 CALL l4f_log(l4f_error, &
2918 'in optionparser, option '''//trim(arg)//''' not valid')
2919 ENDIF
2920 ELSE IF (arg(1:1) == '-') THEN ! short option
2921 find_shortopt: DO j = 1, this%options%arraysize
2922 IF (this%options%array(j)%short_opt == arg(2:2)) THEN ! found option
2923 SELECT CASE(this%options%array(j)%need_arg)
2924 CASE(2) ! compulsory
2925 IF (len_trim(arg) > 2) THEN
2926 optarg = arg(3:)
2927 status = max(option_found(this%options%array(j), optarg), &
2928 status)
2929 ELSE
2930 IF (i < iargc()) THEN
2931 i=i+1
2932 CALL getarg(i, optarg)
2933 status = max(option_found(this%options%array(j), optarg), &
2934 status)
2935 ELSE
2936 status = optionparser_err
2937 CALL l4f_log(l4f_error, &
2938 'in optionparser, option '''//trim(arg)//''' requires an argument')
2939 ENDIF
2940 ENDIF
2941 CASE(1) ! optional
2942 IF (len_trim(arg) > 2) THEN
2943 optarg = arg(3:)
2944 ELSE
2945 IF (i < iargc()) THEN
2946 CALL getarg(i+1, optarg)
2947 IF (optarg(1:1) == '-') THEN
2948 optarg = cmiss ! refused
2949 ELSE
2950 i=i+1 ! accepted
2951 ENDIF
2952 ELSE
2953 optarg = cmiss ! refused
2954 ENDIF
2955 ENDIF
2956 status = max(option_found(this%options%array(j), optarg), &
2957 status)
2958 CASE(0)
2959 status = max(option_found(this%options%array(j)), &
2960 status)
2961 END SELECT
2962 EXIT find_shortopt
2963 ENDIF
2964 ENDDO find_shortopt
2965 IF (j > this%options%arraysize) THEN
2966 status = optionparser_err
2967 CALL l4f_log(l4f_error, &
2968 'in optionparser, option '''//trim(arg)//''' not valid')
2969 ENDIF
2970 ELSE ! unrecognized = end of options
2971 EXIT
2972 ENDIF
2973 i = i + 1
2974ENDDO
2975
2976nextarg = i
2977SELECT CASE(status)
2978CASE(optionparser_err, optionparser_help)
2979 CALL optionparser_printhelp(this)
2980END SELECT
2981
2982END SUBROUTINE optionparser_parse
2983
2984
2985!> Print on stdout a human-readable text representation of the help message.
2986!! It can be called by the user program and it is called anyway in
2987!! case of error in the interpretation of the command line.
2988SUBROUTINE optionparser_printhelp(this)
2989TYPE(optionparser),INTENT(in) :: this !< \a optionparser object with correctly initialised options
2990
2991INTEGER :: i, form
2992
2993form = 0
2994DO i = 1, this%options%arraysize ! loop over options
2995 IF (this%options%array(i)%opttype == opttype_help) THEN
2996 form = this%options%array(i)%helpformat
2997 ENDIF
2998ENDDO
2999
3000SELECT CASE(form)
3001CASE(0)
3002 CALL optionparser_printhelptxt(this)
3003CASE(1)
3004 CALL optionparser_printhelpmd(this)
3005CASE(2)
3006 CALL optionparser_printhelphtmlform(this)
3007END SELECT
3008
3009END SUBROUTINE optionparser_printhelp
3010
3011
3012!> Print on stdout a human-readable text representation of the help message.
3013!! It can be called by the user program and it is called anyway in
3014!! case of error in the interpretation of the command line.
3015SUBROUTINE optionparser_printhelptxt(this)
3016TYPE(optionparser),INTENT(in) :: this !< \a optionparser object with correctly initialised options
3017
3018INTEGER :: i, j, ncols
3019CHARACTER(len=80) :: buf
3020TYPE(line_split) :: help_line
3021
3022ncols = default_columns()
3023
3024! print usage message
3025IF (ASSOCIATED(this%usage_msg)) THEN
3026 help_line = line_split_new(cstr_to_fchar(this%usage_msg), ncols)
3027 DO j = 1, line_split_get_nlines(help_line)
3028 WRITE(*,'(A)')trim(line_split_get_line(help_line,j))
3029 ENDDO
3030 CALL delete(help_line)
3031ELSE
3032 CALL getarg(0, buf)
3033 i = index(buf, '/', back=.true.) ! remove directory part
3034 IF (buf(i+1:i+3) == 'lt-') i = i + 3 ! remove automake prefix
3035 WRITE(*,'(A)')'Usage: '//trim(buf(i+1:))//' [options] [arguments]'
3036ENDIF
3037
3038! print description message
3039IF (ASSOCIATED(this%description_msg)) THEN
3040 WRITE(*,'()')
3041 help_line = line_split_new(cstr_to_fchar(this%description_msg), ncols)
3042 DO j = 1, line_split_get_nlines(help_line)
3043 WRITE(*,'(A)')trim(line_split_get_line(help_line,j))
3044 ENDDO
3045 CALL delete(help_line)
3046ENDIF
3047
3048WRITE(*,'(/,A)')'Options:'
3049
3050DO i = 1, this%options%arraysize ! loop over options
3051 CALL option_format_help(this%options%array(i), ncols)
3052ENDDO
3053
3054END SUBROUTINE optionparser_printhelptxt
3055
3056
3057!> Print on stdout a markdown representation of the help message.
3058!! It can be called by the user program and it is called anyway if the
3059!! program has been called with the `--help md` option.
3060SUBROUTINE optionparser_printhelpmd(this)
3061TYPE(optionparser),INTENT(in) :: this !< \a optionparser object with correctly initialised options
3062
3063INTEGER :: i, j, ncols
3064CHARACTER(len=80) :: buf
3065TYPE(line_split) :: help_line
3066
3067ncols = default_columns()
3068
3069! print usage message
3070WRITE(*,'(A)')'### Synopsis'
3071
3072IF (ASSOCIATED(this%usage_msg)) THEN
3073 help_line = line_split_new(mdquote_usage_msg(cstr_to_fchar(this%usage_msg)), ncols)
3074 DO j = 1, line_split_get_nlines(help_line)
3075 WRITE(*,'(A)')trim(line_split_get_line(help_line,j))
3076 ENDDO
3077 CALL delete(help_line)
3078ELSE
3079 CALL getarg(0, buf)
3080 i = index(buf, '/', back=.true.) ! remove directory part
3081 IF (buf(i+1:i+3) == 'lt-') i = i + 3 ! remove automake prefix
3082 WRITE(*,'(A)')'Usage: `'//trim(buf(i+1:))//' [options] [arguments]`'
3083ENDIF
3084
3085! print description message
3086IF (ASSOCIATED(this%description_msg)) THEN
3087 WRITE(*,'()')
3088 WRITE(*,'(A)')'### Description'
3089 help_line = line_split_new(cstr_to_fchar(this%description_msg), ncols)
3090 DO j = 1, line_split_get_nlines(help_line)
3091 WRITE(*,'(A)')trim(line_split_get_line(help_line,j))
3092 ENDDO
3093 CALL delete(help_line)
3094
3095ENDIF
3096
3097WRITE(*,'(/,A)')'### Options'
3098
3099DO i = 1, this%options%arraysize ! loop over options
3100 CALL option_format_md(this%options%array(i), ncols)
3101ENDDO
3102
3103CONTAINS
3104
3105FUNCTION mdquote_usage_msg(usage_msg)
3106CHARACTER(len=*),INTENT(in) :: usage_msg
3107
3108CHARACTER(len=LEN(usage_msg)+2) :: mdquote_usage_msg
3109INTEGER :: colon
3110
3111colon = index(usage_msg, ':') ! typically 'Usage: cp [options] origin destination'
3112IF (colon > 0 .AND. colon < len(usage_msg)-1) THEN
3113 mdquote_usage_msg = usage_msg(:colon+1)//'`'//usage_msg(colon+2:)//'`'
3114ELSE
3115 mdquote_usage_msg = usage_msg
3116ENDIF
3117
3118END FUNCTION mdquote_usage_msg
3119
3120END SUBROUTINE optionparser_printhelpmd
3121
3122!> Print on stdout an html form reflecting the command line options set up.
3123!! It can be called by the user program and it is called anyway if the
3124!! program has been called with the `--help htmlform` option.
3125SUBROUTINE optionparser_printhelphtmlform(this)
3126TYPE(optionparser),INTENT(in) :: this !< \a optionparser object with correctly initialised options
3127
3128INTEGER :: i
3129
3130DO i = 1, this%options%arraysize ! loop over options
3131 CALL option_format_htmlform(this%options%array(i))
3132ENDDO
3133
3134WRITE(*,'(A)')'<input class="libsim_sub" type="submit" value="runprogram" />'
3135
3136END SUBROUTINE optionparser_printhelphtmlform
3137
3138
3139SUBROUTINE optionparser_make_completion(this)
3140TYPE(optionparser),INTENT(in) :: this !< \a optionparser object with correctly initialised options
3141
3142INTEGER :: i
3143CHARACTER(len=512) :: buf
3144
3145CALL getarg(0, buf)
3146
3147WRITE(*,'(A/A/A)')'_'//trim(buf)//'()','{','local cur'
3148
3149WRITE(*,'(A/A/A/A)')'COMPREPLY=()','cur=${COMP_WORDS[COMP_CWORD]}', &
3150 'case "$cur" in','-*)'
3151
3152!-*)
3153! COMPREPLY=( $( compgen -W
3154DO i = 1, this%options%arraysize ! loop over options
3155 IF (this%options%array(i)%need_arg == 2) THEN
3156 ENDIF
3157ENDDO
3158
3159WRITE(*,'(A/A/A)')'esac','return 0','}'
3160
3161END SUBROUTINE optionparser_make_completion
3162
3163
3164SUBROUTINE dirty_char_assignment(destc, destclen, src)
3165USE kinds
3166IMPLICIT NONE
3167
3168CHARACTER(len=1) :: destc(*)
3169CHARACTER(len=*) :: src
3170INTEGER :: destclen
3171
3172INTEGER :: i
3173
3174DO i = 1, min(destclen, len(src))
3175 destc(i) = src(i:i)
3176ENDDO
3177DO i = len(src)+1, destclen
3178 destc(i) = ' '
3179ENDDO
3180
3181END SUBROUTINE dirty_char_assignment
3182
3183END MODULE optionparser_class
Set of functions that return a trimmed CHARACTER representation of the input variable.
Set of functions that return a CHARACTER representation of the input variable.
Methods for successively obtaining the fields of a csv_record object.
Constructor for the class csv_record.
Index method.
Destructor for the optionparser class.
Add a new option of a specific type.
This module defines usefull general purpose function and subroutine.
Utilities for CHARACTER variables.
Gestione degli errori.
Utilities for managing files.
Definition of constants to be used for declaring variables of a desired type.
Definition kinds.F90:245
classe per la gestione del logging
Module for parsing command-line optons.
This class allows to parse the command-line options of a program in an object-oriented way,...

Generated with Doxygen.