libsim Versione 7.2.6

◆ optionparser_printhelpmd()

subroutine optionparser_printhelpmd ( type(optionparser), intent(in) this)
private

Print on stdout a markdown representation of the help message.

It can be called by the user program and it is called anyway if the program has been called with the --help md option.

Parametri
[in]thisoptionparser object with correctly initialised options

Definizione alla linea 1739 del file optionparser_class.F90.

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