Context Navigation

cfgparse.F90 @ 1793

Last change on this file since 1793 was 1793, checked in by jvatant, 7 years ago

Making Titan's hazy again, part I
+ Added the source folder libf/muphytitan which contains

YAMMS ( Titan's microphysical model ) from J. Burgalat

+ Modif. compilation files linked to this change
JVO

File size: 83.0 KB

Line
1	! Copyright Jérémie Burgalat (2010-2015)
2	!
3	! burgalat.jeremie@gmail.com
4	!
5	! This software is a computer program whose purpose is to provide configuration
6	! file and command line arguments parsing features to Fortran programs.
7	!
8	! This software is governed by the CeCILL-B license under French law and
9	! abiding by the rules of distribution of free software. You can use,
10	! modify and/ or redistribute the software under the terms of the CeCILL-B
11	! license as circulated by CEA, CNRS and INRIA at the following URL
12	! "http://www.cecill.info".
13	!
14	! As a counterpart to the access to the source code and rights to copy,
15	! modify and redistribute granted by the license, users are provided only
16	! with a limited warranty and the software's author, the holder of the
17	! economic rights, and the successive licensors have only limited
18	! liability.
19	!
20	! In this respect, the user's attention is drawn to the risks associated
21	! with loading, using, modifying and/or developing or reproducing the
22	! software by the user in light of its specific status of free software,
23	! that may mean that it is complicated to manipulate, and that also
24	! therefore means that it is reserved for developers and experienced
25	! professionals having in-depth computer knowledge. Users are therefore
26	! encouraged to load and test the software's suitability as regards their
27	! requirements in conditions enabling the security of their systems and/or
28	! data to be ensured and, more generally, to use and operate it in the
29	! same conditions as regards security.
30	!
31	! The fact that you are presently reading this means that you have had
32	! knowledge of the CeCILL-B license and that you accept its terms.
33
34	!! file: cfgparse.F90
35	!! summary: Configuration file parser source file
36	!! author: burgalat
37	!! date: 2013-2015, 2017
38
39	#include "defined.h"
40
41	MODULE CFGPARSE
42	!! Configuration file parsing module
43	!!
44	!! This module defines a set of derived types as well as methods to parse configuration files.
45	!! @todo
46	!! Add interpolation from environment and/or parser options
47	USE, INTRINSIC :: ISO_FORTRAN_ENV
48	USE ERRORS
49	USE STRINGS
50	USE FSYSTEM
51	IMPLICIT NONE
52
53	PRIVATE
54
55	PUBLIC :: cfg_clear, cfg_read_config, cfg_write_config, &
56	cfg_get_value, cfg_set_value, cfg_count, cfg_check_name, &
57	cfg_has_option, cfg_has_section, &
58	cfg_remove_option, cfg_remove_section, &
59	cfg_sort_options
60
61	PUBLIC :: noerror,error, error_to_string, aborting
62
63	! some public definitions from other modules
64	! from strings
65	PUBLIC :: str_to_lower,st_slen, st_llen
66
67	PUBLIC :: OPERATOR(==), OPERATOR(/=), ASSIGNMENT(=)
68
69	TYPE, PUBLIC :: option
70	!! Define an option
71	CHARACTER(len=st_slen), PRIVATE :: name = "" !! Name of the option
72	CHARACTER(len=st_slen), PRIVATE :: section = "" !! Associated section name.
73	TYPE(words), PRIVATE :: values !! Values of the option
74	END TYPE option
75
76	TYPE, PUBLIC :: cfgparser
77	!! Define a parser of options
78	!!
79	!! A [[cfgparser(type)]] stores [[option(type)]] objects.
80	TYPE(option), DIMENSION(:), ALLOCATABLE :: options !! list of options.
81	#if HAVE_FTNPROC
82	CONTAINS
83	PROCEDURE, PRIVATE :: cp_get_rv_sc
84	PROCEDURE, PRIVATE :: cp_get_dv_sc
85	PROCEDURE, PRIVATE :: cp_get_iv_sc
86	PROCEDURE, PRIVATE :: cp_get_lv_sc
87	PROCEDURE, PRIVATE :: cp_get_cv_sc
88	PROCEDURE, PRIVATE :: cp_get_sv_sc
89	PROCEDURE, PRIVATE :: cp_get_rv_ve
90	PROCEDURE, PRIVATE :: cp_get_dv_ve
91	PROCEDURE, PRIVATE :: cp_get_iv_ve
92	PROCEDURE, PRIVATE :: cp_get_lv_ve
93	PROCEDURE, PRIVATE :: cp_get_cv_ve
94	PROCEDURE, PRIVATE :: cp_get_sv_ve
95	PROCEDURE, PRIVATE :: cp_set_rv_sc
96	PROCEDURE, PRIVATE :: cp_set_dv_sc
97	PROCEDURE, PRIVATE :: cp_set_iv_sc
98	PROCEDURE, PRIVATE :: cp_set_lv_sc
99	PROCEDURE, PRIVATE :: cp_set_cv_sc
100	PROCEDURE, PRIVATE :: cp_set_sv_sc
101	PROCEDURE, PRIVATE :: cp_set_rv_ve
102	PROCEDURE, PRIVATE :: cp_set_dv_ve
103	PROCEDURE, PRIVATE :: cp_set_iv_ve
104	PROCEDURE, PRIVATE :: cp_set_lv_ve
105	PROCEDURE, PRIVATE :: cp_set_cv_ve
106	PROCEDURE, PRIVATE :: cp_set_sv_ve
107	!> Read configuration file
108	PROCEDURE, PUBLIC :: read_config => cfg_read_config
109	!> Write configuration file
110	PROCEDURE, PUBLIC :: write_config => cfg_write_config
111	!> Get the number of sections in the parser
112	PROCEDURE, PUBLIC :: count => cfg_count
113	!> Clean the parser (delete all options, free memory)
114	PROCEDURE, PUBLIC :: clear => cfg_clear
115	!> Get the names of the user-defined sections in the parser
116	PROCEDURE, PUBLIC :: section_names => cfg_section_names
117	!> Get the list of options names
118	PROCEDURE, PUBLIC :: option_names => cfg_option_names
119	!> Check if parser has option by name
120	PROCEDURE, PUBLIC :: has_option => cfg_has_option
121	!> Check if parser has section by name
122	PROCEDURE, PUBLIC :: has_section => cfg_has_section
123	!> Remove an option from the parser.
124	PROCEDURE, PUBLIC :: remove_option => cfg_remove_option
125	!> Remove a section (and all the associated options) from the parser.
126	PROCEDURE, PUBLIC :: remove_section => cfg_remove_section
127	!> Get value(s) of an option in the parser by name
128	!!
129	!! ```
130	!! FUNCTION cfg_get_value(this,name,output) RESULT(error)
131	!! ```
132	!!
133	!! The method attempts to get the value(s) of an option that matches _name_ in _this_ parser.
134	!!
135	!! On error, __output__ argument is undefined (that is, left unchanged
136	!! for scalar versions, unallocated for vector version).
137	!!
138	!! Errors occur in the following situations:
139	!! - The option has no value (-6)
140	!! - The option does not exist (-7)
141	!! - The option's value cannot be cast in the desired type (-10)
142	GENERIC, PUBLIC :: get_value => cp_get_rv_sc,cp_get_dv_sc,cp_get_iv_sc, &
143	cp_get_lv_sc,cp_get_cv_sc,cp_get_sv_sc, &
144	cp_get_rv_ve,cp_get_dv_ve,cp_get_iv_ve, &
145	cp_get_lv_ve,cp_get_cv_ve,cp_get_sv_ve
146	!> Set value(s) of an option in the parser by name
147	!!
148	!! ```
149	!! FUNCTION cfg_set_value(this,name,input,create) RESULT(error)
150	!! ```
151	!!
152	!! The method searches for the option matching the given _name_ in _this_ parser and sets new
153	!! values.
154	!!
155	!! If _create_ is set to .true. (default to .false.) the method creates the option if does not
156	!! exist in _this_ parser.
157	!! @warning
158	!! In such case, if the given is not valid, an assertion is raised !
159	!!
160	!! On error (i.e. no option matches the given _name_), no values are set.
161	GENERIC, PUBLIC :: set_value => cp_set_rv_sc,cp_set_dv_sc,cp_set_iv_sc, &
162	cp_set_lv_sc,cp_set_cv_sc,cp_set_sv_sc, &
163	cp_set_rv_ve,cp_set_dv_ve,cp_set_iv_ve, &
164	cp_set_lv_ve,cp_set_cv_ve,cp_set_sv_ve
165	#endif
166
167	END TYPE cfgparser
168
169	!> Get value(s) of an option in the parser by name.
170	!!
171	!! ```
172	!! FUNCTION cfg_get_value(parser,name,output) RESULT(error)
173	!! ```
174	!!
175	!! The method attempts to get the value(s) of an option that matches _name_ in _this_ parser.
176	!!
177	!! On error, __output__ argument is undefined (that is, left unchanged
178	!! for scalar versions, unallocated for vector version).
179	!!
180	!! Errors occur in the following situations:
181	!! - The option has no value (-6)
182	!! - The option does not exist (-7)
183	!! - The option's value cannot be cast in the desired type (-10)
184	INTERFACE cfg_get_value
185	MODULE PROCEDURE cp_get_rv_sc,cp_get_dv_sc,cp_get_iv_sc, &
186	cp_get_lv_sc,cp_get_cv_sc,cp_get_sv_sc, &
187	cp_get_rv_ve,cp_get_dv_ve,cp_get_iv_ve, &
188	cp_get_lv_ve,cp_get_cv_ve,cp_get_sv_ve
189	END INTERFACE
190
191	!> Set value(s) of an option in the parser by name
192	!!
193	!! ```
194	!! FUNCTION set_value(this,name,input,create) RESULT(error)
195	!! ```
196	!!
197	!! The method searches for the option matching the given _name_ in _this_ parser and sets new
198	!! values.
199	!!
200	!! If _create_ is set to .true. (default to .false.) the method quietly create the option if does not
201	!! exist in _this_ parser.
202	!! @warning
203	!! In such case, if the given is not valid, an assertion is raised !
204	!!
205	!! On error (i.e. no option matches the given _name_), no values are set.
206	INTERFACE cfg_set_value
207	MODULE PROCEDURE :: cp_set_rv_sc,cp_set_dv_sc,cp_set_iv_sc, &
208	cp_set_lv_sc,cp_set_cv_sc,cp_set_sv_sc, &
209	cp_set_rv_ve,cp_set_dv_ve,cp_set_iv_ve, &
210	cp_set_lv_ve,cp_set_cv_ve,cp_set_sv_ve
211	END INTERFACE
212
213	!> Derived type assignment operator
214	!!
215	!! This interface defines the assignment operator for the containers defined in the module.
216	INTERFACE ASSIGNMENT(=)
217	MODULE PROCEDURE cp_affect_sc, op_affect_sc
218	END INTERFACE
219
220	CONTAINS
221
222	SUBROUTINE op_affect_sc(this,other)
223	!! Option object assignment operator subroutine
224	!!
225	!! The subroutine assigns __other__ to __this__.
226	TYPE(option), INTENT(inout) :: this !! An option object to be assigned
227	TYPE(option), INTENT(in) :: other !! An option object to assign
228	CALL words_clear(this%values) ! normally not needed
229	this%name = other%name
230	this%section = other%section
231	this%values = other%values
232	END SUBROUTINE op_affect_sc
233
234	FUNCTION op_valid(opt) RESULT(ok)
235	!! Check whether or not the option is valid (i.e. has name)
236	TYPE(option), INTENT(in) :: opt !! An option object
237	LOGICAL :: ok !! True if the option is valid, false otherwise.
238	ok = LEN_TRIM(opt%name) > 0
239	END FUNCTION op_valid
240
241	SUBROUTINE op_clear(opt)
242	!! Clear and invalid the given option.
243	TYPE(option), INTENT(inout) :: opt !! An option object
244	opt%name = ''
245	opt%section = ''
246	CALL words_clear(opt%values)
247	END SUBROUTINE op_clear
248
249	FUNCTION op_full_name(opt) RESULT(name)
250	!! Get the full name of an option.
251	!!
252	!! @note
253	!! If no section is defined in the option (that should not happen), "__default__" is used
254	!! as the section part of the full name.
255	TYPE(option), INTENT(in) :: opt !! An option object
256	CHARACTER(len=:), ALLOCATABLE :: name !! The fullname of the option
257	IF (LEN_TRIM(opt%section) == 0) THEN
258	name = "__default__/"//TRIM(opt%name)
259	ELSE
260	name = TRIM(opt%section)//"/"//TRIM(opt%name)
261	ENDIF
262	END FUNCTION op_full_name
263
264	FUNCTION op_split_name(fname,sname,pname) RESULT(err)
265	!> Split a full name in section and option names
266	!!
267	!! The method splits a full name into (section,option) names. Output names (if any) are always
268	!! set to lower case.
269	!!
270	!! A full name simply consists in a section name and an option name separated by a single "/".
271	!!
272	!! The method never checks the validity of the output names. Consider using [[cfg_check_name(function)]]
273	!! to do so.
274	!! @note
275	!! If _fname_ does not contains any "/", the method set the special name "\_\_default\_\_" for the output
276	!! section name.
277	!! @note
278	!! On success, option and section names are set to lower case. Otherwise they are set to empty strings.
279	!! @warning
280	!! If _fname_ ends with a "/", an error (-6, invalid name) is raised: the method always assumes it can
281	!! find an option part in the name.
282	CHARACTER(len=*), INTENT(in) :: fname !! A name to split
283	CHARACTER(len=:), INTENT(out), ALLOCATABLE :: sname, & !! Section part of the name
284	pname !! Option part of the name
285	TYPE(error) :: err !! Error status of the method
286	INTEGER :: idx
287	err = noerror ; pname = "" ; sname = ""
288	! splits input name in sname, pname
289	idx = INDEX(fname,'/')
290	IF (idx == LEN_TRIM(fname)) THEN
291	err = error("Invalid option name ("//TRIM(fname)//")",-9)
292	RETURN
293	ELSE IF (idx <= 1) THEN
294	sname = "__default__" ; pname = TRIM(fname)
295	IF (idx == 1) pname=pname(2:)
296	ELSE
297	sname = fname(:idx-1)
298	pname = fname(idx+1:LEN_TRIM(fname))
299	ENDIF
300	! 17/12/2014: set option name to lower
301	pname = str_to_lower(pname)
302	sname = str_to_lower(sname)
303	END FUNCTION op_split_name
304
305	FUNCTION op_greater_than(left,right) RESULT(ret)
306	!> greater than operator for option derived type.
307	!!
308	!! the comparison is made on section and option name (in alphabetical order).
309	TYPE(option), INTENT(in) :: left !! LHS option.
310	TYPE(option), INTENT(in) :: right !! RHS option.
311	LOGICAL :: ret
312	!! .true. if LHS is _greater_ than RHS (based on section and option name)
313	ret = LGT(op_full_name(left),op_full_name(right))
314	END FUNCTION op_greater_than
315
316	FUNCTION op_less_than(left,right) RESULT(ret)
317	!> Less than operator for option derived type.
318	!!
319	!! the comparison is made on section and option name (in alphabetical order).
320	TYPE(option), INTENT(in) :: left !! LHS option.
321	TYPE(option), INTENT(in) :: right !! RHS option.
322	LOGICAL :: ret
323	!! .true. if LHS is _less_ than RHS (based on section and option name)
324	ret = LLT(op_full_name(left),op_full_name(right))
325	END FUNCTION op_less_than
326
327	FUNCTION op_to_str(opt,num_values) RESULT(str)
328	!! Get the string representation of a option object
329	!! @note
330	!! If the object is not valid an empty string is returned.
331	TYPE(option), INTENT(in) :: opt
332	!! A option object
333	INTEGER, INTENT(in), OPTIONAL :: num_values
334	!! Optional integer with the number of values to print per line
335	CHARACTER(len=:), ALLOCATABLE :: str
336	!! An allocated string with the representation of the option object
337	LOGICAL :: ret
338	INTEGER :: nv,np,i
339	CHARACTER(len=:), ALLOCATABLE :: nspcs
340	CHARACTER(len=st_slen), ALLOCATABLE, DIMENSION(:) :: vec
341	nv = 8 ; IF (PRESENT(num_values)) nv = MAX(1,num_values)
342	str = ""
343	str = TRIM(opt%name)//" = " ; np = LEN(str)
344	ALLOCATE(CHARACTER(len=np) :: nspcs) ; nspcs(1:) = " "
345	! stores the error but do not check...
346	ret = words_to_vector(opt%values,vec)
347	IF (.NOT.ALLOCATED(vec)) RETURN
348	DO i=1,SIZE(vec)
349	IF (string_is(TRIM(vec(i))) == st_string.AND.TRIM(vec(i))/="NULL") THEN
350	str = str//'"'//remove_quotes(TRIM(vec(i)))//'",'
351	ELSE
352	str = str//TRIM(vec(i))//','
353	ENDIF
354	IF (MOD(i,nv) == 0) THEN
355	str = str//NEW_LINE('A')//nspcs
356	ELSE
357	str = str//CHAR(32)
358	ENDIF
359	ENDDO
360	str = TRIM(str)
361	IF (str(LEN(str):) == ",") str=str(:LEN(str)-1)
362	END FUNCTION op_to_str
363
364	!-------------------------------
365	! DERIVED TYPE cfgparser METHODS
366	!-------------------------------
367
368	SUBROUTINE cfg_clear(parser)
369	!! Clear the cfgparser object ("destructor")
370	!!
371	!! This subroutine clears the given parser (deallocates memory).
372	OBJECT(cfgparser), INTENT(inout) :: parser !! A cfgparser object to clear
373	INTEGER :: i
374	IF (ALLOCATED(parser%options)) THEN
375	DO i = 1, SIZE(parser%options)
376	CALL op_clear(parser%options(i))
377	ENDDO
378	DEALLOCATE(parser%options)
379	ENDIF
380	END SUBROUTINE cfg_clear
381
382
383	FUNCTION cfg_check_name(name) RESULT(valid)
384	!! Check if a name is valid
385	!!
386	!! A valid option/section name begins with a letter and is followed by any
387	!! number of alphanumeric characters and underscore (`[A-Za-z][A-Za-z0-9\_]\*`).
388	CHARACTER(len=*), INTENT(in) :: name !! A string with the name to check.
389	LOGICAL :: valid !! .true. if the name is valid, .false. otherwise
390	INTEGER :: i
391	CHARACTER(len=26), PARAMETER :: alpha = "abcdefghijklmnopqrstuvwxyz"
392	CHARACTER(len=12), PARAMETER :: num = "0123456789_"
393	CHARACTER(len=:), ALLOCATABLE :: pname,sname
394	TYPE(error) :: err
395	valid = .false.
396	i = INDEX(TRIM(name),"/")
397	IF (i /= 0) THEN
398	err = op_split_name(name,sname,pname)
399	IF (err /= 0) THEN
400	RETURN
401	ENDIF
402	ELSE
403	pname = str_to_lower(TRIM(name))
404	sname = "__default__"
405	ENDIF
406	! check option:
407	i = INDEX(pname,CHAR(32))
408	IF (i /= 0.OR.LEN_TRIM(pname) <= 0) RETURN
409	valid = (VERIFY(pname(1:1),alpha) == 0 .AND.VERIFY(TRIM(pname),alpha//num) == 0)
410	IF (.NOT.valid) RETURN
411	! check section
412	IF (sname == "__default__") THEN
413	valid = .true.
414	RETURN
415	ELSE
416	i = INDEX(sname,CHAR(32))
417	IF (i /= 0.OR.LEN_TRIM(sname) <= 0) RETURN
418	valid = (VERIFY(sname(1:1),alpha) == 0 .AND.VERIFY(TRIM(sname),alpha//"/"//num) == 0)
419	ENDIF
420	END FUNCTION cfg_check_name
421
422	FUNCTION cfg_count(this) RESULT(num)
423	!! Get the total number of option in the parser.
424	!!
425	!! @internal
426	!! If no options are defined, then it implies that the internal vector of options is
427	!! not allocated.
428	OBJECT(cfgparser), INTENT(in) :: this !! A cfgparser object to search in
429	INTEGER :: num !! Number of current options registered in the parser.
430	num = 0
431	IF(.NOT.ALLOCATED(this%options)) RETURN
432	num = SIZE(this%options)
433	END FUNCTION cfg_count
434
435	FUNCTION cfg_section_names(this) RESULT(list)
436	!! Get the list of user-defined section names
437	!! @note
438	!! If the parser does not have user-defined sections, the vector is still
439	!! allocated but with 0 elements.
440	OBJECT(cfgparser), INTENT(in) :: this !! A cfgparser object to process.
441	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: list !! List of section names.
442	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: tmp
443	INTEGER :: i,j,k,no
444	LOGICAL :: found
445	no = cfg_count(this)
446	IF (no == 0) THEN
447	ALLOCATE(list(0))
448	RETURN
449	ENDIF
450	ALLOCATE(tmp(no))
451	tmp(1) = ''
452	! get the first non-default section
453	DO i=1,no
454	IF (this%options(i)%section /= "__default__") THEN
455	tmp(1) = this%options(i)%section
456	EXIT
457	ENDIF
458	ENDDO
459	! no user defined section
460	IF (LEN_TRIM(tmp(1)) == 0) THEN
461	DEALLOCATE(tmp)
462	ALLOCATE(list(0))
463	RETURN
464	ENDIF
465	k = 1
466	DO i=1,no
467	found = .false.
468	DO j=1,k
469	! Found a match so start looking again
470	found = (tmp(j) == this%options(i)%section .OR. &
471	this%options(i)%section == "__default__")
472	IF (found) EXIT
473	ENDDO
474	IF (.NOT.found) THEN
475	k = k + 1
476	tmp(k) = this%options(i)%section
477	ENDIF
478	ENDDO
479	ALLOCATE(list(k))
480	list(1:k) = tmp(1:k)
481	DEALLOCATE(tmp)
482	END FUNCTION cfg_section_names
483
484	FUNCTION cfg_option_names(this) RESULT(list)
485	!! Get the list of option names.
486	!!
487	!! @note
488	!! If the parser does not have options, the vector is still allocated but with 0 elements.
489	OBJECT(cfgparser), INTENT(in) :: this !! A cfgparser object to process.
490	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: list !! List of option names.
491	INTEGER :: i,no
492	no = cfg_count(this)
493	ALLOCATE(list(no))
494	IF (no == 0) RETURN
495	DO i=1,no
496	IF (this%options(i)%section == "__default__") THEN
497	list(i) = TRIM(this%options(i)%name)
498	ELSE
499	list(i) = TRIM(this%options(i)%section)//"/"//TRIM(this%options(i)%name)
500	ENDIF
501	ENDDO
502	END FUNCTION cfg_option_names
503
504	FUNCTION cfg_has_section(this,name) RESULT(yes)
505	!! Check if parser has section by name
506	OBJECT(cfgparser), INTENT(in) :: this !! cfgparser object
507	CHARACTER(len=*), INTENT(in) :: name !! Name of the section to search
508	LOGICAL :: yes !! .true. if the section exists, .false. otherwise
509	CHARACTER(len=:), ALLOCATABLE :: zname
510	INTEGER :: i,no
511	yes = .false.
512	no = cfg_count(this)
513	IF (no == 0) RETURN
514	zname = str_to_lower(name)
515	DO i = 1,no
516	IF (this%options(i)%section == zname) THEN
517	yes = .true.
518	RETURN
519	ENDIF
520	ENDDO
521	END FUNCTION cfg_has_section
522
523	FUNCTION cfg_has_option(this,name) RESULT(yes)
524	!! Check if parser has option by name
525	OBJECT(cfgparser), INTENT(in) :: this !! A cfgparser object
526	CHARACTER(len=*), INTENT(in) :: name !! (extended) Name of the option to search
527	LOGICAL :: yes !! .true. if the option is found, .false. otherwise
528	CHARACTER(len=:), ALLOCATABLE :: pname,zname
529	INTEGER :: i,no
530	yes = .false.
531	no = cfg_count(this)
532	IF (no == 0) RETURN
533	IF (SCAN(name,"/") <= 0) THEN
534	zname = "__default__"//"/"//str_to_lower(TRIM(name))
535	ELSE
536	zname = str_to_lower(TRIM(name))
537	ENDIF
538	DO i = 1,no
539	pname = op_full_name(this%options(i))
540	IF (pname == zname) THEN
541	yes = .true.
542	RETURN
543	ENDIF
544	ENDDO
545	END FUNCTION cfg_has_option
546
547	SUBROUTINE cfg_sort_options(this)
548	!! Sort the options in the parser (alphabetiCALLy).
549	OBJECT(cfgparser), INTENT(inout) :: this !! A cfgparser object
550	INTEGER :: no
551	no = cfg_count(this)
552	IF (no == 0) RETURN
553	CALL insertionSort(this%options)
554	END SUBROUTINE cfg_sort_options
555
556	SUBROUTINE cfg_remove_option(this,name)
557	!! Remove an option from parser by name.
558	OBJECT(cfgparser), INTENT(inout) :: this !! A cfgparser object to search in
559	CHARACTER(len=*), INTENT(in) :: name !! The name of the option to remove
560	CHARACTER(len=:), ALLOCATABLE :: zname,pname
561	INTEGER :: no,idx,i,j
562	TYPE(option), DIMENSION(:), ALLOCATABLE :: tmp
563	IF (SCAN(name,"/") <= 0) THEN
564	zname = "__default__"//"/"//str_to_lower(TRIM(name))
565	ELSE
566	zname = str_to_lower(TRIM(name))
567	ENDIF
568	idx = cp_get_opt_idx(this,zname)
569	no = cfg_count(this)
570	IF (idx == -1) RETURN
571	! only one opt
572	IF (no == 1) THEN
573	CALL op_clear(this%options(1))
574	DEALLOCATE(this%options)
575	RETURN
576	ENDIF
577	ALLOCATE(tmp(no-1))
578	j = 1
579	DO i=1,no
580	IF (i /= idx) THEN
581	tmp(j) = this%options(i)
582	j= j+1
583	ENDIF
584	CALL op_clear(this%options(i))
585	ENDDO
586	DEALLOCATE(this%options)
587	ALLOCATE(this%options(no-1))
588	DO i=1,no-1
589	this%options(i) = tmp(i)
590	CALL op_clear(tmp(i))
591	ENDDO
592	DEALLOCATE(tmp)
593	END SUBROUTINE cfg_remove_option
594
595	SUBROUTINE cfg_remove_section(this,name)
596	!! Remove a section from parser by name.
597	!!
598	!! The method removes all the options that belong to the given section name.
599	OBJECT(cfgparser), INTENT(inout) :: this
600	!! A cfgparser object to search in
601	CHARACTER(len=*), INTENT(in) :: name
602	!! The name of the section to remove
603	CHARACTER(len=:), ALLOCATABLE :: zname
604	INTEGER :: no,i,j,icount
605	INTEGER, DIMENSION(:), ALLOCATABLE :: idxs,itmp
606	TYPE(option), DIMENSION(:), ALLOCATABLE :: tmp
607
608	no = cfg_count(this)
609	IF (no == 0) RETURN
610	zname = str_to_lower(TRIM(name))
611	ALLOCATE(itmp(no))
612	itmp(:) = -1
613	icount = 0
614	DO i=1,no
615	IF (TRIM(this%options(i)%section) == zname) THEN
616	itmp(icount+1) = i
617	icount = icount + 1
618	ENDIF
619	ENDDO
620	IF (icount == 0) RETURN
621	ALLOCATE(idxs(icount))
622	idxs(:) = itmp(1:icount)
623	!DEALLOCATE(itmp)
624	! all options matches (should be rarely the case): remove all
625	IF (icount == no) THEN
626	DO i=1,no ; CALL op_clear(this%options(i)); ENDDO
627	DEALLOCATE(this%options)
628	RETURN
629	ENDIF
630	ALLOCATE(tmp(icount))
631	j = 1
632	DO i=1,no
633	IF (ANY(idxs == i)) THEN
634	tmp(j) = this%options(i)
635	j = j + 1
636	ENDIF
637	CALL op_clear(this%options(i))
638	ENDDO
639	DEALLOCATE(idxs)
640	DEALLOCATE(this%options)
641	ALLOCATE(this%options(icount))
642	DO i=1,icount
643	this%options(i) = tmp(i)
644	CALL op_clear(tmp(i))
645	ENDDO
646	DEALLOCATE(tmp)
647	END SUBROUTINE cfg_remove_section
648
649	FUNCTION cfg_read_config(parser,path,override) RESULT(err)
650	!! Read configuration file
651	!!
652	!! @note
653	!! If the library support C bindings, the method can read included files which are defined
654	!! by the __#include <...>__ directive (see [p_cfgparse](here) from more details).
655	OBJECT(cfgparser), INTENT(inout) :: parser
656	!! A cfgparser object that will store the configuration
657	CHARACTER(len=*), INTENT(in) :: path
658	!! Path of the configuration file
659	LOGICAL, INTENT(in), OPTIONAL :: override
660	!! An optional boolean flag with .true. to override previous value of duplicated options instead of raising an error.
661	TYPE(error) :: err
662	!! An error with the first error encountered
663	INTEGER :: i
664	LOGICAL :: zoverride,ok
665	TYPE(words) :: incfiles
666	CHARACTER(len=:), ALLOCATABLE :: name
667	CHARACTER(len=st_slen) :: isec
668	err = noerror
669	zoverride = .false. ; IF (PRESENT(override)) zoverride = override
670	isec = "__default__"
671	name = TRIM(path)
672	i = INDEX(name,'/',.true.) ; IF (i /= 0) name = name(i+1:)
673	IF (i == 0) THEN
674	name = fs_realpath("./"//path)
675	ELSE
676	name = fs_realpath(path)
677	ENDIF
678	CALL words_append(incfiles,name)
679	INQUIRE(FILE=TRIM(path), EXIST=ok)
680	IF (.NOT.ok) THEN
681	err = error(TRIM(path)//": no such file",-11)
682	ELSE
683	err = read_include(parser,TRIM(path),isec,incfiles,zoverride)
684	ENDIF
685	call words_clear(incfiles)
686	END FUNCTION cfg_read_config
687
688	FUNCTION cfg_write_config(this,lu,num_values) RESULT(err)
689	!> Write the content of the parser in the logical unit.
690	!!
691	!! the method expects the logical unit to be opened and does not close it
692	!! at the end of the process.
693	OBJECT(cfgparser), INTENT(inout) :: this
694	!! Parser to write.
695	INTEGER, INTENT(in) :: lu
696	!! Logical unit. It should be already opened or an error is raised.
697	INTEGER, INTENT(in), OPTIONAL :: num_values
698	!! Optional integer with the number of values to print per line for options (default to 8).
699	TYPE(error) :: err
700	!! Error status
701	CHARACTER(len=st_slen) :: sname
702	LOGICAL :: ok
703	INTEGER :: nv,no,i
704	err = noerror
705	INQUIRE(UNIT=lu,OPENED=ok)
706	IF (.NOT.ok) THEN
707	err = error("Logical unit not opened",-15)
708	RETURN
709	ENDIF
710	no = cfg_count(this)
711	IF (no == 0) THEN
712	err = error("No options to write",-7)
713	RETURN
714	ENDIF
715	! sort options.
716	CALL cfg_sort_options(this)
717	nv = 8 ; IF (PRESENT(num_values)) nv = MAX(1,num_values)
718	sname = this%options(1)%section
719	IF (sname /= "__default__") &
720	WRITE(lu,'(a)') "[ "//TRIM(sname)//" ]"
721	DO i=1,no
722	IF (this%options(i)%section /= sname) THEN
723	sname = this%options(i)%section
724	! write section first
725	WRITE(lu,*)
726	WRITE(lu,'(a)') "[ "//TRIM(sname)//" ]"
727	ENDIF
728	WRITE(lu,'(a)') op_to_str(this%options(i),nv)
729	ENDDO
730	END FUNCTION cfg_write_config
731
732	! internal (private methods)
733
734	SUBROUTINE cp_affect_sc(this,other)
735	!! cfgparser object assignment operator subroutine
736	!!
737	!! The subroutine assigns __other__ to __this__.
738	TYPE(cfgparser), INTENT(inout) :: this !! A cfgparser object to be assigned
739	TYPE(cfgparser), INTENT(in) :: other !! A cfgparser object to assign
740	INTEGER :: i,ono
741	CALL cfg_clear(this)
742	ono = cfg_count(other)
743	IF (ono == 0) RETURN
744	ALLOCATE(this%options(ono))
745	DO i=1,ono
746	this%options(i) = other%options(i)
747	ENDDO
748	RETURN
749	END SUBROUTINE cp_affect_sc
750
751	FUNCTION cp_get_opt_idx(this,name) RESULT(idx)
752	!! Get the index of an option by name in the parser.
753	!!
754	!! The method searches in the parser for the option with the given (full) __name__.
755	!! If found, it returns the index of the option in the internal vector of options. Otherwise
756	!! -1 is returned.
757	OBJECT(cfgparser), INTENT(in) :: this !! A cfgparser object
758	CHARACTER(len=*), INTENT(in) :: name !! A string with the name of the option
759	INTEGER :: idx !! Index of the option (-1 if not found).
760	CHARACTER(len=:), ALLOCATABLE :: zname,pname
761	INTEGER :: no,i
762	idx = -1
763	no = cfg_count(this)
764	IF (no == 0) RETURN
765	IF (SCAN(name,"/") <= 0) THEN
766	zname = "__default__"//"/"//str_to_lower(TRIM(name))
767	ELSE
768	zname = str_to_lower(TRIM(name))
769	ENDIF
770	DO i=1,no
771	pname = op_full_name(this%options(i))
772	IF (pname == zname) THEN
773	idx = i
774	RETURN
775	ENDIF
776	ENDDO
777	END FUNCTION cp_get_opt_idx
778
779	FUNCTION cp_update_opt(this,sname,pname,values) RESULT(err)
780	!! Update an option in the parser.
781	!!
782	!! The attempts to update the option in the parser that matches __opt__ name.
783	!!
784	!! If __name__ is given it is used instead of __opt__ name.
785	!!
786	!! If no option is found, __opt__ is appended in the parser. Otherwise the matched
787	!! option is updated (i.e. its values are set to __opt__ values).
788	!!
789	!! If the option is not valid, the method does nothing and -X error status is returned.
790	!!
791	!! @internal
792	!! The method performs the same kind of operations than the setters except that it
793	!! expects raw data ([[strings(module):words(type)]]).
794	OBJECT(cfgparser), INTENT(inout) :: this !! cfgparser object to process.
795	CHARACTER(len=*), INTENT(in) :: sname !! Name of the section.
796	CHARACTER(len=*), INTENT(in) :: pname !! Name of the option.
797	TYPE(words), INTENT(in) :: values !! Raw values.
798	TYPE(error) :: err !! Error status.
799	CHARACTER(len=:), ALLOCATABLE :: zsname,fname
800	INTEGER :: i
801	err = noerror
802	zsname = str_to_lower(TRIM(sname))
803	IF (LEN_TRIM(zsname) == 0 ) zsname = "__default__"
804	fname = zsname//"/"//str_to_lower(TRIM(pname))
805	!print*,"DEBUG6: ",fname
806	IF (.NOT.cfg_check_name(fname)) THEN
807	err = error("Invalid option (no name)",-9)
808	RETURN
809	ENDIF
810	i = cp_get_opt_idx(this,fname)
811	IF (i /= -1) THEN
812	CALL words_clear(this%options(i)%values)
813	this%options(i)%values = values
814	ELSE
815	err = cp_add_opt(this,zsname,pname,values)
816	ENDIF
817	END FUNCTION cp_update_opt
818
819
820	FUNCTION cp_add_opt(this,sname,pname,values) RESULT(err)
821	!! Add an option to the parser.
822	!!
823	!! In order to add an option to the default section, _sname_ should be left empty or set to "\_\_default\_\_".
824	!!
825	!! If given, _opt_ points to the new option on output. If an error occured the pointer is null.
826	!!
827	!! The following error code can be returned:
828	!! - 0, no error.
829	!! - -8, the option already exists.
830	!! - -9, option name is not valid.
831	OBJECT(cfgparser), INTENT(inout) :: this
832	!! A cfgparser object to process.
833	CHARACTER(len=*), INTENT(in) :: sname
834	!! Section name.
835	CHARACTER(len=*), INTENT(in) :: pname
836	!! Option name.
837	TYPE(words), INTENT(in) :: values
838	!! Values to set.
839	TYPE(error) :: err
840	!! Return error status.
841	CHARACTER(len=:), ALLOCATABLE :: zsname,fname
842	TYPE(option), DIMENSION(:), ALLOCATABLE :: tmp
843	INTEGER :: no,i
844
845	TYPE(option) :: sca
846
847	err = noerror
848	zsname = sname
849	no = cfg_count(this)
850	IF (LEN_TRIM(zsname) == 0) zsname = "__default__"
851	fname = TRIM(zsname)//"/"//TRIM(pname)
852	! check name
853	IF (.NOT.cfg_check_name(fname)) THEN
854	err = error("Invalid option name '"//fname//"'",-9)
855	RETURN
856	ENDIF
857	! check if opt exists in the parser
858	IF (no > 0) THEN
859	IF (cp_get_opt_idx(this,fname) /= -1) THEN
860	err = error("Duplicate option '"//TRIM(pname)//"' in "//TRIM(zsname),-8)
861	RETURN
862	ENDIF
863	ENDIF
864
865	! build option
866	CALL op_clear(sca)
867	sca%name = pname
868	sca%section = zsname
869	sca%values = values
870
871	IF (no == 0) THEN
872	! no options yet -> allocate
873	ALLOCATE(this%options(1))
874	!this%options(1) = sca
875	!this%options(1)%name = pname
876	!this%options(1)%section = zsname
877	!this%options(1)%values = values
878	ELSE
879	! parser has options: increase this%options size (ugly copy).
880	ALLOCATE(tmp(no))
881	DO i =1,no
882	tmp(i) = this%options(i)
883	CALL op_clear(this%options(i))
884	ENDDO
885	DEALLOCATE(this%options)
886	ALLOCATE(this%options(no+1))
887	DO i =1,no
888	this%options(i) = tmp(i)
889	CALL op_clear(tmp(i))
890	ENDDO
891	DEALLOCATE(tmp)
892	!this%options(no+1) = sca
893	!this%options(no+1)%name = pname
894	!this%options(no+1)%section = zsname
895	!this%options(no+1)%values = values
896	ENDIF
897	! always add the option at the end.
898	!print*, words_length(this%options(no+1)%values)
899	this%options(no+1) = sca
900	CALL op_clear(sca)
901	END FUNCTION cp_add_opt
902
903	FUNCTION cp_get_rv_sc(this,name,output) RESULT(err)
904	!! Get the first value of an option in the parser by name (real/scalar)
905	!!
906	!! The following error status can be returned by the method:
907	!! - -7, no option matches the given name.
908	!! - -6, the option does not have value(s).
909	!! - -10, the value cannot be converted in the output type.
910	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
911	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
912	REAL(kind=4), INTENT(out) :: output !! Output value
913	TYPE(error) :: err
914	!! Error status
915	INTEGER :: idx
916	CHARACTER(len=:), ALLOCATABLE :: tmp
917	err = noerror
918	idx = cp_get_opt_idx(this,name)
919	IF (idx == -1) THEN
920	err = error("Option "//TRIM(name)//" does not exist",-7)
921	RETURN
922	ENDIF
923	IF (words_length(this%options(idx)%values)== 0) THEN
924	err = error("Option "//TRIM(name)//" has no value",-6)
925	ELSE
926	tmp = TRIM(ADJUSTL(words_get(this%options(idx)%values,1)))
927	IF (LEN(tmp) == 0) THEN
928	err = error("Option "//TRIM(name)//" has no value",-6)
929	ELSE
930	IF(.NOT.from_string(tmp,output)) &
931	err = error(TRIM(name)//": Cannot convert "//tmp//" to real.",-10)
932	ENDIF
933	ENDIF
934	END FUNCTION cp_get_rv_sc
935
936	FUNCTION cp_get_dv_sc(this,name,output) RESULT(err)
937	!! Get the first value of an option in the parser by name (double/scalar)
938	!!
939	!! The following error status can be returned by the method:
940	!! - -7, no option matches the given name.
941	!! - -6, the option does not have value(s).
942	!! - -10, the value cannot be converted in the output type.
943	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
944	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
945	REAL(kind=8), INTENT(out) :: output !! Output value
946	TYPE(error) :: err
947	!! Error status
948	INTEGER :: idx
949	CHARACTER(len=:), ALLOCATABLE :: tmp
950	err = noerror
951	idx = cp_get_opt_idx(this,name)
952	IF (idx == -1) THEN
953	err = error("Option "//TRIM(name)//" does not exist",-7)
954	RETURN
955	ENDIF
956	IF (words_length(this%options(idx)%values)== 0) THEN
957	err = error("Option "//TRIM(name)//" has no value",-6)
958	ELSE
959	tmp = TRIM(ADJUSTL(words_get(this%options(idx)%values,1)))
960	IF (LEN(tmp) == 0) THEN
961	err = error("Option "//TRIM(name)//" has no value",-6)
962	ELSE
963	IF(.NOT.from_string(tmp,output)) &
964	err = error(TRIM(name)//": Cannot convert "//tmp//" to double.",-10)
965	ENDIF
966	ENDIF
967	END FUNCTION cp_get_dv_sc
968
969	FUNCTION cp_get_iv_sc(this,name,output) RESULT(err)
970	!! Get the first value of an option in the parser by name (integer/scalar)
971	!!
972	!! The following error status can be returned by the method:
973	!! - -7, no option matches the given name.
974	!! - -6, the option does not have value(s).
975	!! - -10, the value cannot be converted in the output type.
976	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
977	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
978	INTEGER, INTENT(out) :: output !! Output value
979	TYPE(error) :: err
980	!! Error status
981	INTEGER :: idx
982	CHARACTER(len=:), ALLOCATABLE :: tmp
983	err = noerror
984	idx = cp_get_opt_idx(this,name)
985	IF (idx == -1) THEN
986	err = error("Option "//TRIM(name)//" does not exist",-7)
987	RETURN
988	ENDIF
989	IF (words_length(this%options(idx)%values)== 0) THEN
990	err = error("Option "//TRIM(name)//" has no value",-6)
991	ELSE
992	tmp = TRIM(ADJUSTL(words_get(this%options(idx)%values,1)))
993	IF (LEN(tmp) == 0) THEN
994	err = error("Option "//TRIM(name)//" has no value",-6)
995	ELSE
996	IF(.NOT.from_string(tmp,output)) &
997	err = error(TRIM(name)//": Cannot convert "//tmp//" to integer.",-10)
998	ENDIF
999	ENDIF
1000	END FUNCTION cp_get_iv_sc
1001
1002	FUNCTION cp_get_lv_sc(this,name,output) RESULT(err)
1003	!! Get the first value of an option in the parser by name (logical/scalar)
1004	!!
1005	!! The following error status can be returned by the method:
1006	!! - -7, no option matches the given name.
1007	!! - -6, the option does not have value(s).
1008	!! - -10, the value cannot be converted in the output type.
1009	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1010	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1011	LOGICAL, INTENT(out) :: output !! Output value
1012	TYPE(error) :: err
1013	!! Error status
1014	INTEGER :: idx
1015	CHARACTER(len=:), ALLOCATABLE :: tmp
1016	err = noerror
1017	idx = cp_get_opt_idx(this,name)
1018	IF (idx == -1) THEN
1019	err = error("Option "//TRIM(name)//" does not exist",-7)
1020	RETURN
1021	ENDIF
1022	IF (words_length(this%options(idx)%values)== 0) THEN
1023	err = error("Option "//TRIM(name)//" has no value",-6)
1024	ELSE
1025	tmp = TRIM(ADJUSTL(words_get(this%options(idx)%values,1)))
1026	IF (LEN(tmp) == 0) THEN
1027	err = error("Option "//TRIM(name)//" has no value",-6)
1028	ELSE
1029	IF(.NOT.from_string(tmp,output)) &
1030	err = error(TRIM(name)//": Cannot convert "//tmp//" to logical.",-10)
1031	ENDIF
1032	ENDIF
1033	END FUNCTION cp_get_lv_sc
1034
1035	FUNCTION cp_get_cv_sc(this,name,output) RESULT(err)
1036	!! Get the first value of an option in the parser by name (complex/scalar)
1037	!!
1038	!! The following error status can be returned by the method:
1039	!! - -7, no option matches the given name.
1040	!! - -6, the option does not have value(s).
1041	!! - -10, the value cannot be converted in the output type.
1042	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1043	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1044	COMPLEX, INTENT(out) :: output !! Output value
1045	TYPE(error) :: err
1046	!! Error status
1047	INTEGER :: idx
1048	CHARACTER(len=:), ALLOCATABLE :: tmp
1049	err = noerror
1050	idx = cp_get_opt_idx(this,name)
1051	IF (idx == -1) THEN
1052	err = error("Option "//TRIM(name)//" does not exist",-7)
1053	RETURN
1054	ENDIF
1055	IF (words_length(this%options(idx)%values)== 0) THEN
1056	err = error("Option "//TRIM(name)//" has no value",-6)
1057	ELSE
1058	tmp = TRIM(ADJUSTL(words_get(this%options(idx)%values,1)))
1059	IF (LEN(tmp) == 0) THEN
1060	err = error("Option "//TRIM(name)//" has no value",-6)
1061	ELSE
1062	IF(.NOT.from_string(tmp,output)) &
1063	err = error(TRIM(name)//": Cannot convert "//tmp//" to complex.",-10)
1064	ENDIF
1065	ENDIF
1066	END FUNCTION cp_get_cv_sc
1067
1068	FUNCTION cp_get_sv_sc(this,name,output) RESULT(err)
1069	!! Get the first value of an option in the parser by name (string/scalar)
1070	!!
1071	!! The following error status can be returned by the method:
1072	!! - -7, no option matches the given name.
1073	!! - -6, the option does not have value(s).
1074	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1075	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1076	CHARACTER(len=*), INTENT(out) :: output !! Output value
1077	TYPE(error) :: err
1078	!! Error status
1079	INTEGER :: idx
1080	!CHARACTER(len=:), ALLOCATABLE :: tmp
1081	err = noerror
1082	idx = cp_get_opt_idx(this,name)
1083	IF (idx == -1) THEN
1084	err = error("Option "//TRIM(name)//" does not exist",-7)
1085	RETURN
1086	ENDIF
1087	IF (words_length(this%options(idx)%values)== 0) THEN
1088	err = error("Option "//TRIM(name)//" has no value",-6)
1089	ELSE
1090	output = TRIM(ADJUSTL(words_get(this%options(idx)%values,1)))
1091	err = noerror
1092	ENDIF
1093	END FUNCTION cp_get_sv_sc
1094
1095	FUNCTION cp_get_rv_ve(this,name,output) RESULT(err)
1096	!! Get the value(s) of an option in the parser by name (real/vector)
1097	!!
1098	!! On error, the output vector is not allocated.
1099	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1100	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1101	REAL(kind=4), INTENT(out), DIMENSION(:), ALLOCATABLE :: output !! Output values
1102	TYPE(error) :: err
1103	!! Error status of the method (see [[cfgparser(type):get_value(bound)]] documentation)
1104	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: tmp
1105	LOGICAL :: ok
1106	INTEGER :: i,idx
1107	CHARACTER(len=15) :: i2s
1108	err = noerror
1109	idx = cp_get_opt_idx(this,name)
1110	IF (idx == -1) THEN
1111	err = error("Option "//TRIM(name)//" does not exist",-7)
1112	RETURN
1113	ENDIF
1114	IF (words_length(this%options(idx)%values) == 0) THEN
1115	err = error("Option "//TRIM(name)//" has no value",-6)
1116	ELSE
1117	ALLOCATE(output(words_length(this%options(idx)%values)))
1118	ok = words_to_vector(this%options(idx)%values,tmp)
1119	DO i=1, SIZE(tmp)
1120	WRITE(i2s,'(I15)') i ; i2s=ADJUSTL(i2s)
1121	IF (LEN_TRIM(ADJUSTL(tmp(i))) == 0) THEN
1122	err = error("Cannot get value #"//TRIM(i2s)//" from option "//TRIM(name),-6)
1123	DEALLOCATE(output) ; EXIT
1124	ELSE IF (.NOT.from_string(tmp(i), output(i))) THEN
1125	err = error("Cannot convert value #"//TRIM(i2s)//" from option "//TRIM(name),-10)
1126	DEALLOCATE(output) ; EXIT
1127	ENDIF
1128	ENDDO
1129	ENDIF
1130	DEALLOCATE(tmp)
1131	RETURN
1132	END FUNCTION cp_get_rv_ve
1133
1134	FUNCTION cp_get_dv_ve(this,name,output) RESULT(err)
1135	!! Get the value(s) of an option in the parser by name (double/vector)
1136	!!
1137	!! On error, the output vector is not allocated.
1138	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1139	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1140	REAL(kind=8), INTENT(out), DIMENSION(:), ALLOCATABLE :: output !! Output values
1141	TYPE(error) :: err
1142	!! Error status of the method (see [[cfgparser(type):get_value(bound)]] documentation)
1143	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: tmp
1144	LOGICAL :: ok
1145	INTEGER :: i,idx
1146	CHARACTER(len=15) :: i2s
1147	err = noerror
1148	idx = cp_get_opt_idx(this,name)
1149	IF (idx == -1) THEN
1150	err = error("Option "//TRIM(name)//" does not exist",-7)
1151	RETURN
1152	ENDIF
1153	IF (words_length(this%options(idx)%values) == 0) THEN
1154	err = error("Option "//TRIM(name)//" has no value",-6)
1155	ELSE
1156	ALLOCATE(output(words_length(this%options(idx)%values)))
1157	ok = words_to_vector(this%options(idx)%values,tmp)
1158	DO i=1, SIZE(tmp)
1159	WRITE(i2s,'(I15)') i ; i2s=ADJUSTL(i2s)
1160	IF (LEN_TRIM(ADJUSTL(tmp(i))) == 0) THEN
1161	err = error("Cannot get value #"//TRIM(i2s)//" from option "//TRIM(name),-6)
1162	DEALLOCATE(output) ; EXIT
1163	ELSE IF (.NOT.from_string(tmp(i), output(i))) THEN
1164	err = error("Cannot convert value #"//TRIM(i2s)//" from option "//TRIM(name),-10)
1165	DEALLOCATE(output) ; EXIT
1166	ENDIF
1167	ENDDO
1168	ENDIF
1169	DEALLOCATE(tmp)
1170	RETURN
1171	END FUNCTION cp_get_dv_ve
1172
1173	FUNCTION cp_get_iv_ve(this,name,output) RESULT(err)
1174	!! Get the value(s) of an option in the parser by name (integer/vector)
1175	!!
1176	!! On error, the output vector is not allocated.
1177	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1178	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1179	INTEGER, INTENT(out), DIMENSION(:), ALLOCATABLE :: output !! Output values
1180	TYPE(error) :: err
1181	!! Error status of the method (see [[cfgparser(type):get_value(bound)]] documentation)
1182	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: tmp
1183	LOGICAL :: ok
1184	INTEGER :: i,idx
1185	CHARACTER(len=15) :: i2s
1186	err = noerror
1187	idx = cp_get_opt_idx(this,name)
1188	IF (idx == -1) THEN
1189	err = error("Option "//TRIM(name)//" does not exist",-7)
1190	RETURN
1191	ENDIF
1192	IF (words_length(this%options(idx)%values) == 0) THEN
1193	err = error("Option "//TRIM(name)//" has no value",-6)
1194	ELSE
1195	ALLOCATE(output(words_length(this%options(idx)%values)))
1196	ok = words_to_vector(this%options(idx)%values,tmp)
1197	DO i=1, SIZE(tmp)
1198	WRITE(i2s,'(I15)') i ; i2s=ADJUSTL(i2s)
1199	IF (LEN_TRIM(ADJUSTL(tmp(i))) == 0) THEN
1200	err = error("Cannot get value #"//TRIM(i2s)//" from option "//TRIM(name),-6)
1201	DEALLOCATE(output) ; EXIT
1202	ELSE IF (.NOT.from_string(tmp(i), output(i))) THEN
1203	err = error("Cannot convert value #"//TRIM(i2s)//" from option "//TRIM(name),-10)
1204	DEALLOCATE(output) ; EXIT
1205	ENDIF
1206	ENDDO
1207	ENDIF
1208	DEALLOCATE(tmp)
1209	RETURN
1210	END FUNCTION cp_get_iv_ve
1211
1212	FUNCTION cp_get_lv_ve(this,name,output) RESULT(err)
1213	!! Get the value(s) of an option in the parser by name (logical/vector)
1214	!!
1215	!! On error, the output vector is not allocated.
1216	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1217	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1218	LOGICAL, INTENT(out), DIMENSION(:), ALLOCATABLE :: output !! Output values
1219	TYPE(error) :: err
1220	!! Error status of the method (see [[cfgparser(type):get_value(bound)]] documentation)
1221	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: tmp
1222	LOGICAL :: ok
1223	INTEGER :: i,idx
1224	CHARACTER(len=15) :: i2s
1225	err = noerror
1226	idx = cp_get_opt_idx(this,name)
1227	IF (idx == -1) THEN
1228	err = error("Option "//TRIM(name)//" does not exist",-7)
1229	RETURN
1230	ENDIF
1231	IF (words_length(this%options(idx)%values) == 0) THEN
1232	err = error("Option "//TRIM(name)//" has no value",-6)
1233	ELSE
1234	ALLOCATE(output(words_length(this%options(idx)%values)))
1235	ok = words_to_vector(this%options(idx)%values,tmp)
1236	DO i=1, SIZE(tmp)
1237	WRITE(i2s,'(I15)') i ; i2s=ADJUSTL(i2s)
1238	IF (LEN_TRIM(ADJUSTL(tmp(i))) == 0) THEN
1239	err = error("Cannot get value #"//TRIM(i2s)//" from option "//TRIM(name),-6)
1240	DEALLOCATE(output) ; EXIT
1241	ELSE IF (.NOT.from_string(tmp(i), output(i))) THEN
1242	err = error("Cannot convert value #"//TRIM(i2s)//" from option "//TRIM(name),-10)
1243	DEALLOCATE(output) ; EXIT
1244	ENDIF
1245	ENDDO
1246	ENDIF
1247	DEALLOCATE(tmp)
1248	RETURN
1249	END FUNCTION cp_get_lv_ve
1250
1251	FUNCTION cp_get_cv_ve(this,name,output) RESULT(err)
1252	!! Get the value(s) of an option in the parser by name (complex/vector)
1253	!!
1254	!! On error, the output vector is not allocated.
1255	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1256	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1257	COMPLEX, INTENT(out), DIMENSION(:), ALLOCATABLE :: output !! Output values
1258	TYPE(error) :: err
1259	!! Error status of the method (see [[cfgparser(type):get_value(bound)]] documentation)
1260	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: tmp
1261	LOGICAL :: ok
1262	INTEGER :: i,idx
1263	CHARACTER(len=15) :: i2s
1264	err = noerror
1265	idx = cp_get_opt_idx(this,name)
1266	IF (idx == -1) THEN
1267	err = error("Option "//TRIM(name)//" does not exist",-7)
1268	RETURN
1269	ENDIF
1270	IF (words_length(this%options(idx)%values) == 0) THEN
1271	err = error("Option "//TRIM(name)//" has no value",-6)
1272	ELSE
1273	ALLOCATE(output(words_length(this%options(idx)%values)))
1274	ok = words_to_vector(this%options(idx)%values,tmp)
1275	DO i=1, SIZE(tmp)
1276	WRITE(i2s,'(I15)') i ; i2s=ADJUSTL(i2s)
1277	IF (LEN_TRIM(ADJUSTL(tmp(i))) == 0) THEN
1278	err = error("Cannot get value #"//TRIM(i2s)//" from option "//TRIM(name),-6)
1279	DEALLOCATE(output) ; EXIT
1280	ELSE IF (.NOT.from_string(tmp(i), output(i))) THEN
1281	err = error("Cannot convert value #"//TRIM(i2s)//" from option "//TRIM(name),-10)
1282	DEALLOCATE(output) ; EXIT
1283	ENDIF
1284	ENDDO
1285	ENDIF
1286	DEALLOCATE(tmp)
1287	RETURN
1288	END FUNCTION cp_get_cv_ve
1289
1290	FUNCTION cp_get_sv_ve(this,name,output) RESULT(err)
1291	!! Get the value(s) of an option in the parser by name (string/vector)
1292	!!
1293	!! On error, the output vector is not allocated.
1294	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1295	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1296	CHARACTER(len=*), INTENT(out), DIMENSION(:), ALLOCATABLE :: output !! Output values
1297	TYPE(error) :: err
1298	!! Error status of the method (see [[cfgparser(type):get_value(bound)]] documentation)
1299	LOGICAL :: ok
1300	INTEGER :: idx
1301	err = noerror
1302	idx = cp_get_opt_idx(this,name)
1303	IF (idx == -1) THEN
1304	err = error("Option "//TRIM(name)//" does not exist",-7)
1305	RETURN
1306	ENDIF
1307	IF (words_length(this%options(idx)%values) == 0) THEN
1308	err = error("Option "//TRIM(name)//" has no value",-6)
1309	ELSE
1310	ok = words_to_vector(this%options(idx)%values,output)
1311	ENDIF
1312	RETURN
1313	END FUNCTION cp_get_sv_ve
1314
1315	FUNCTION cp_set_rv_sc(this,name,input,create) RESULT(err)
1316	!! Set new value for the given option by name (real/scalar)
1317	!!
1318	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1319	!! the parser.
1320	!! In such case, an error (-6, invalid name) is raised if the option name is not valid.
1321	!!
1322	!! In other case, if the option is not defined in the parser the error status is set to -7.
1323	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1324	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to set
1325	REAL(kind=4), INTENT(in) :: input !! Input value
1326	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false).
1327	TYPE(error) :: err !! Error status
1328	LOGICAL :: zcreate
1329	INTEGER :: idx
1330	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1331	TYPE(words) :: values
1332	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1333	err = noerror
1334	idx = cp_get_opt_idx(this,name)
1335	CALL words_append(values,to_string(input))
1336	IF (idx == -1) THEN
1337	IF (zcreate) THEN
1338	err = op_split_name(name,sname,pname)
1339	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1340	ELSE
1341	err = error("Option "//TRIM(name)//" does not exist",-7)
1342	ENDIF
1343	ELSE
1344	this%options(idx)%values = values
1345	ENDIF
1346	CALL words_clear(values)
1347	END FUNCTION cp_set_rv_sc
1348
1349	FUNCTION cp_set_dv_sc(this,name,input,create) RESULT(err)
1350	!! Set new value for the given option by name (double/scalar)
1351	!!
1352	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1353	!! the parser.
1354	!! In such case, an error (-6, invalid name) is raised if the option name is not valid.
1355	!!
1356	!! In other case, if the option is not defined in the parser the error status is set to -7.
1357	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1358	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to set
1359	REAL(kind=8), INTENT(in) :: input !! Input value
1360	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false).
1361	TYPE(error) :: err !! Error status
1362	LOGICAL :: zcreate
1363	INTEGER :: idx
1364	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1365	TYPE(words) :: values
1366	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1367	err = noerror
1368	idx = cp_get_opt_idx(this,name)
1369	CALL words_append(values,to_string(input))
1370	IF (idx == -1) THEN
1371	IF (zcreate) THEN
1372	err = op_split_name(name,sname,pname)
1373	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1374	ELSE
1375	err = error("Option "//TRIM(name)//" does not exist",-7)
1376	ENDIF
1377	ELSE
1378	this%options(idx)%values = values
1379	ENDIF
1380	CALL words_clear(values)
1381	END FUNCTION cp_set_dv_sc
1382
1383	FUNCTION cp_set_iv_sc(this,name,input,create) RESULT(err)
1384	!! Set new value for the given option by name (double/scalar)
1385	!!
1386	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1387	!! the parser.
1388	!! In such case, an error (-6, invalid name) is raised if the option name is not valid.
1389	!!
1390	!! In other case, if the option is not defined in the parser the error status is set to -7.
1391	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1392	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to set
1393	INTEGER, INTENT(in) :: input !! Input value
1394	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false).
1395	TYPE(error) :: err !! Error status
1396	LOGICAL :: zcreate
1397	INTEGER :: idx
1398	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1399	TYPE(words) :: values
1400	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1401	err = noerror
1402	idx = cp_get_opt_idx(this,name)
1403	CALL words_append(values,to_string(input))
1404	IF (idx == -1) THEN
1405	IF (zcreate) THEN
1406	err = op_split_name(name,sname,pname)
1407	!IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1408	err = cp_add_opt(this,sname,pname,values)
1409	ELSE
1410	err = error("Option "//TRIM(name)//" does not exist",-7)
1411	ENDIF
1412	ELSE
1413	this%options(idx)%values = values
1414	ENDIF
1415	CALL words_clear(values)
1416	END FUNCTION cp_set_iv_sc
1417
1418	FUNCTION cp_set_lv_sc(this,name,input,create) RESULT(err)
1419	!! Set new value for the given option by name (logical/scalar)
1420	!!
1421	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1422	!! the parser.
1423	!! In such case, an error (-6, invalid name) is raised if the option name is not valid.
1424	!!
1425	!! In other case, if the option is not defined in the parser the error status is set to -7.
1426	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1427	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to set
1428	LOGICAL, INTENT(in) :: input !! Input value
1429	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false).
1430	TYPE(error) :: err !! Error status
1431	LOGICAL :: zcreate
1432	INTEGER :: idx
1433	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1434	TYPE(words) :: values
1435	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1436	err = noerror
1437	idx = cp_get_opt_idx(this,name)
1438	CALL words_append(values,to_string(input))
1439	IF (idx == -1) THEN
1440	IF (zcreate) THEN
1441	err = op_split_name(name,sname,pname)
1442	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1443	ELSE
1444	err = error("Option "//TRIM(name)//" does not exist",-7)
1445	ENDIF
1446	ELSE
1447	this%options(idx)%values = values
1448	ENDIF
1449	CALL words_clear(values)
1450	END FUNCTION cp_set_lv_sc
1451
1452	FUNCTION cp_set_cv_sc(this,name,input,create) RESULT(err)
1453	!! Set new value for the given option by name (complex/scalar)
1454	!!
1455	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1456	!! the parser.
1457	!! In such case, an error (-6, invalid name) is raised if the option name is not valid.
1458	!!
1459	!! In other case, if the option is not defined in the parser the error status is set to -7.
1460	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1461	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to set
1462	COMPLEX, INTENT(in) :: input !! Input value
1463	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false).
1464	TYPE(error) :: err !! Error status
1465	LOGICAL :: zcreate
1466	INTEGER :: idx
1467	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1468	TYPE(words) :: values
1469	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1470	err = noerror
1471	idx = cp_get_opt_idx(this,name)
1472	CALL words_append(values,to_string(input))
1473	IF (idx == -1) THEN
1474	IF (zcreate) THEN
1475	err = op_split_name(name,sname,pname)
1476	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1477	ELSE
1478	err = error("Option "//TRIM(name)//" does not exist",-7)
1479	ENDIF
1480	ELSE
1481	this%options(idx)%values = values
1482	ENDIF
1483	CALL words_clear(values)
1484	END FUNCTION cp_set_cv_sc
1485
1486	FUNCTION cp_set_sv_sc(this,name,input,create) RESULT(err)
1487	!! Set new value for the given option by name (string/scalar)
1488	!!
1489	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1490	!! the parser.
1491	!! In such case, an error (-6, invalid name) is raised if the option name is not valid.
1492	!!
1493	!! In other case, if the option is not defined in the parser the error status is set to -7.
1494	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1495	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to set
1496	CHARACTER(len=*), INTENT(in) :: input !! Input value
1497	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false).
1498	TYPE(error) :: err !! Error status
1499	LOGICAL :: zcreate
1500	INTEGER :: idx
1501	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1502	TYPE(words) :: values
1503	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1504	err = noerror
1505	idx = cp_get_opt_idx(this,name)
1506	CALL words_append(values,input)
1507	IF (idx == -1) THEN
1508	IF (zcreate) THEN
1509	err = op_split_name(name,sname,pname)
1510	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1511	ELSE
1512	err = error("Option "//TRIM(name)//" does not exist",-7)
1513	ENDIF
1514	ELSE
1515	this%options(idx)%values = values
1516	ENDIF
1517	CALL words_clear(values)
1518	END FUNCTION cp_set_sv_sc
1519
1520	FUNCTION cp_set_rv_ve(this,name,input,create) RESULT(err)
1521	!! Set new value for the given option by name (real/vector)
1522	!!
1523	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1524	!! the parser.
1525	!! In such case, an error (-6, invalid name) is raised if the option name is not valid.
1526	!!
1527	!! In other case, if the option is not defined in the parser the error status is set to -7.
1528	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1529	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1530	REAL(kind=4), INTENT(in), DIMENSION(:) :: input !! Input values
1531	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false)
1532	TYPE(error) :: err !! Error status
1533	LOGICAL :: zcreate
1534	INTEGER :: i,idx
1535	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1536	TYPE(words) :: values
1537	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1538	err = noerror
1539	idx = cp_get_opt_idx(this,name)
1540	DO i=1,SIZE(input) ; CALL words_append(values,to_string(input(i))); ENDDO
1541	IF (idx == -1) THEN
1542	IF (zcreate) THEN
1543	err = op_split_name(name,sname,pname)
1544	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1545	ELSE
1546	err = error("Option "//TRIM(name)//" does not exist",-7)
1547	ENDIF
1548	ELSE
1549	this%options(idx)%values = values
1550	ENDIF
1551	CALL words_clear(values)
1552	END FUNCTION cp_set_rv_ve
1553
1554	FUNCTION cp_set_dv_ve(this,name,input,create) RESULT(err)
1555	!! Set new value for the given option by name (double/vector))
1556	!!
1557	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1558	!! the parser.
1559	!! In such case, an error (-6, invalid name) is raised if the option name is not valid.
1560	!!
1561	!! In other case, if the option is not defined in the parser the error status is set to -7.
1562	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1563	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1564	REAL(kind=8), INTENT(in), DIMENSION(:) :: input !! Input values
1565	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false)
1566	TYPE(error) :: err !! Error status
1567	LOGICAL :: zcreate
1568	INTEGER :: i,idx
1569	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1570	TYPE(words) :: values
1571	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1572	err = noerror
1573	idx = cp_get_opt_idx(this,name)
1574	DO i=1,SIZE(input) ; CALL words_append(values,to_string(input(i))); ENDDO
1575	IF (idx == -1) THEN
1576	IF (zcreate) THEN
1577	err = op_split_name(name,sname,pname)
1578	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1579	ELSE
1580	err = error("Option "//TRIM(name)//" does not exist",-7)
1581	ENDIF
1582	ELSE
1583	this%options(idx)%values = values
1584	ENDIF
1585	CALL words_clear(values)
1586	END FUNCTION cp_set_dv_ve
1587
1588	FUNCTION cp_set_iv_ve(this,name,input,create) RESULT(err)
1589	!! Set new value for the given option by name (integer/vector)
1590	!!
1591	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1592	!! the parser.
1593	!! In such case, an error (-6, invalid name) is raised if the option name is not valid.
1594	!!
1595	!! In other case, if the option is not defined in the parser the error status is set to -7.
1596	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1597	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1598	INTEGER, INTENT(in), DIMENSION(:) :: input !! Input values
1599	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false)
1600	TYPE(error) :: err !! Error status
1601	LOGICAL :: zcreate
1602	INTEGER :: i,idx
1603	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1604	TYPE(words) :: values
1605	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1606	err = noerror
1607	idx = cp_get_opt_idx(this,name)
1608	DO i=1,SIZE(input) ; CALL words_append(values,to_string(input(i))); ENDDO
1609	IF (idx == -1) THEN
1610	IF (zcreate) THEN
1611	err = op_split_name(name,sname,pname)
1612	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1613	ELSE
1614	err = error("Option "//TRIM(name)//" does not exist",-7)
1615	ENDIF
1616	ELSE
1617	this%options(idx)%values = values
1618	ENDIF
1619	CALL words_clear(values)
1620	END FUNCTION cp_set_iv_ve
1621
1622	FUNCTION cp_set_lv_ve(this,name,input,create) RESULT(err)
1623	!! Set new value for the given option by name (logical/vector)
1624	!!
1625	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1626	!! the parser.
1627	!! In such case, an error (-6, invalid name) is raised if the option name is not valid.
1628	!!
1629	!! In other case, if the option is not defined in the parser the error status is set to -7.
1630	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1631	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1632	LOGICAL, INTENT(in), DIMENSION(:) :: input !! Input values
1633	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false)
1634	TYPE(error) :: err !! Error status
1635	LOGICAL :: zcreate
1636	INTEGER :: i,idx
1637	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1638	TYPE(words) :: values
1639	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1640	err = noerror
1641	idx = cp_get_opt_idx(this,name)
1642	DO i=1,SIZE(input) ; CALL words_append(values,to_string(input(i))); ENDDO
1643	IF (idx == -1) THEN
1644	IF (zcreate) THEN
1645	err = op_split_name(name,sname,pname)
1646	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1647	ELSE
1648	err = error("Option "//TRIM(name)//" does not exist",-7)
1649	ENDIF
1650	ELSE
1651	this%options(idx)%values = values
1652	ENDIF
1653	CALL words_clear(values)
1654	END FUNCTION cp_set_lv_ve
1655
1656	FUNCTION cp_set_cv_ve(this,name,input,create) RESULT(err)
1657	!! Set new value for the given option by name (complex/vector)
1658	!!
1659	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1660	!! the parser.
1661	!! In such case, an error (-6, invalid name) is raised if the option name is not valid.
1662	!!
1663	!! In other case, if the option is not defined in the parser the error status is set to -7.
1664	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1665	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1666	COMPLEX, INTENT(in), DIMENSION(:) :: input !! Input values
1667	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false)
1668	TYPE(error) :: err !! Error status
1669	LOGICAL :: zcreate
1670	INTEGER :: i,idx
1671	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1672	TYPE(words) :: values
1673	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1674	err = noerror
1675	idx = cp_get_opt_idx(this,name)
1676	DO i=1,SIZE(input) ; CALL words_append(values,to_string(input(i))); ENDDO
1677	IF (idx == -1) THEN
1678	IF (zcreate) THEN
1679	err = op_split_name(name,sname,pname)
1680	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1681	ELSE
1682	err = error("Option "//TRIM(name)//" does not exist",-7)
1683	ENDIF
1684	ELSE
1685	this%options(idx)%values = values
1686	ENDIF
1687	CALL words_clear(values)
1688	END FUNCTION cp_set_cv_ve
1689
1690	FUNCTION cp_set_sv_ve(this,name,input,create) RESULT(err)
1691	!! Set new value for the given option by name (complex/vector)
1692	!!
1693	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1694	!! the parser.
1695	!! In such case, an error (-6, invalid name) is raised if the option name is not valid.
1696	!!
1697	!! In other case, if the option is not defined in the parser the error status is set to -7.
1698	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1699	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1700	CHARACTER(len=*), INTENT(in), DIMENSION(:) :: input !! Input values
1701	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false)
1702	TYPE(error) :: err !! Error status
1703	LOGICAL :: zcreate
1704	INTEGER :: i,idx
1705	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1706	TYPE(words) :: values
1707	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1708	err = noerror
1709	idx = cp_get_opt_idx(this,name)
1710	DO i=1,SIZE(input) ; CALL words_append(values,trim(input(i))); ENDDO
1711	IF (idx == -1) THEN
1712	IF (zcreate) THEN
1713	err = op_split_name(name,sname,pname)
1714	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1715	ELSE
1716	err = error("Option "//TRIM(name)//" does not exist",-7)
1717	ENDIF
1718	ELSE
1719	this%options(idx)%values = values
1720	ENDIF
1721	CALL words_clear(values)
1722	END FUNCTION cp_set_sv_ve
1723
1724	! i/o functions
1725	!--------------
1726
1727	RECURSIVE FUNCTION read_include(parser,path,isec,ipaths,override) RESULT(err)
1728	!! Read and parse an included configuration file (internal)
1729	!! @note
1730	!! On error, the cfgparser object is left unchanged.
1731	TYPE(cfgparser), INTENT(inout) :: parser
1732	!! A cfgparser object that will store the configuration
1733	CHARACTER(len=*), INTENT(in) :: path
1734	!! A string with the path of the input file to read
1735	CHARACTER(len=st_slen), INTENT(inout) :: isec
1736	!! Current section name
1737	TYPE(words), INTENT(inout) :: ipaths
1738	!! List of paths of already included files
1739	LOGICAL, INTENT(in), OPTIONAL :: override
1740	!! An optional boolean flag with .true. to override previous value of duplicated options instead of raising an error.
1741	TYPE(error) :: err
1742	!! An error with the first error encountered
1743	TYPE(option) :: curopt
1744	LOGICAL :: zoverride,ok,has_opt
1745	INTEGER :: lineno,lu,i
1746	CHARACTER(len=2), PARAMETER :: space = CHAR(32)//"," ! check if , is really wanted..
1747	CHARACTER(len=2), PARAMETER :: blanks = CHAR(9)//CHAR(32) ! currently not used because blanks truncate.
1748	CHARACTER(len=15) :: sln
1749	CHARACTER(len=:), ALLOCATABLE :: fulp,dirp,basp
1750	CHARACTER(len=:), ALLOCATABLE :: curval,ipath
1751	CHARACTER(len=:), ALLOCATABLE :: line,name,value
1752	INTEGER, PARAMETER :: cfg_UNKNOWN = -1, &
1753	cfg_SECTION = 0, &
1754	cfg_OPTION = 1
1755
1756	zoverride = .false. ; IF (PRESENT(override)) zoverride = override
1757	! initialize local variables
1758	curval = '' ; line = '' ; name = '' ; value = ''
1759	lineno = 0 ; lu = free_lun()
1760	IF (LEN_TRIM(isec) == 0) isec = "__default__"
1761	i = INDEX(TRIM(path),"/",.true.)
1762	IF (i == 0) THEN
1763	fulp = fs_realpath("./"//TRIM(ADJUSTL(path)))
1764	ELSE
1765	fulp = fs_realpath(TRIM(ADJUSTL(path)))
1766	ENDIF
1767	basp = fs_basename(fulp)
1768	dirp = fs_dirname(fulp)
1769	! check for file
1770	INQUIRE(FILE=TRIM(path),EXIST=ok)
1771	IF (.NOT.ok) THEN
1772	err = error(TRIM(path)//": no such file",-11)
1773	RETURN
1774	ENDIF
1775	! check for lun
1776	IF (lu == -1) THEN ; err = error("No available logical unit",-12) ; RETURN ; ENDIF
1777	OPEN(lu,FILE=TRIM(path),STATUS='old',ACTION='READ')
1778	DO WHILE(readline(lu,line))
1779	lineno = lineno + 1
1780	WRITE(sln,'(I15)') lineno ; sln=ADJUSTL(sln)
1781	! comment or blank line ?
1782	IF (is_comment(line,ipath)) THEN
1783	! check for includes
1784	IF (LEN(ipath) > 0) THEN
1785	! 1) get relative path
1786	ipath = fs_relpath(ipath,dirp)
1787	! 2) compute asbolute path)
1788	ipath = TRIM(dirp)//"/"//TRIM(ipath)
1789	ipath = fs_realpath(ipath)
1790	IF (.NOT.check_include(ipaths,ipath)) THEN
1791	ipath = fs_basename(ipath)
1792	err = error(basp//'(L'//TRIM(sln)//"): Circular include &
1793	&reference to "//ipath,-14)
1794	EXIT
1795	ENDIF
1796	IF (op_valid(curopt) .AND. LEN(curval) > 0) THEN
1797	CALL words_extend(curopt%values,TRIM(ADJUSTL(curval)),space,.true.,.true.)
1798	IF (zoverride) THEN
1799	err = cp_update_opt(parser,curopt%section,curopt%name,curopt%values)
1800	ELSE
1801	err = cp_add_opt(parser,curopt%section,curopt%name,curopt%values)
1802	ENDIF
1803	CALL op_clear(curopt); curval = ''
1804	ENDIF
1805	err = read_include(parser,ipath,isec,ipaths,zoverride)
1806	IF (err /= 0) EXIT
1807	ENDIF
1808	CYCLE
1809	ENDIF
1810	! continuation line ?
1811	IF (SCAN(line(1:1),blanks) /= 0 .AND. op_valid(curopt)) THEN
1812	IF (LEN(curval) == 0) THEN
1813	curval = strip_comment(line)
1814	ELSE
1815	curval = curval//CHAR(32)//strip_comment(line)
1816	ENDIF
1817	ELSE
1818	! 1. Remove comment part and left adjust line
1819	line = strip_comment(line)
1820	! a section header or option header?
1821	SELECT CASE (get_kind(line,name,value))
1822	CASE(cfg_SECTION)
1823	! 1. add current value to current option (if any)
1824	! 2. update "isec" variable
1825	IF (op_valid(curopt)) THEN
1826	IF (LEN(curval) > 0) &
1827	CALL words_extend(curopt%values,TRIM(ADJUSTL(curval)),space,.true.,.true.)
1828	IF (zoverride) THEN
1829	err = cp_update_opt(parser,curopt%section,curopt%name,curopt%values)
1830	ELSE
1831	err = cp_add_opt(parser,curopt%section,curopt%name,curopt%values)
1832	ENDIF
1833	ENDIF
1834	CALL op_clear(curopt) ; curval = ''
1835	IF (cfg_has_section(parser,name) .AND. &
1836	TRIM(name)/="__default__" .AND. &
1837	.NOT.zoverride) THEN
1838	err = error(basp//'(L'//TRIM(sln)//"): Duplicate section '"//name,-8)
1839	EXIT
1840	ENDIF
1841	!print*,"DEBUG0: New section ",TRIM(name), " <- ",isec
1842	isec = TRIM(name)
1843	CASE(cfg_OPTION)
1844	! 1. add current value to current option (if any)
1845	! 2. search for option in cursect:
1846	! --> duplicate option error if it exists
1847	! --> create new option if it does not exist (using curopt)
1848	! 3. curval is set to value
1849	! 4. update curval
1850	IF (op_valid(curopt)) THEN
1851	!print*,"DEBUG3: new opt: ",TRIM(isec)//"/"//TRIM(name)," <- ",op_full_name(curopt)
1852	IF (LEN(curval) > 0) &
1853	CALL words_extend(curopt%values,TRIM(ADJUSTL(curval)),space,.true.,.true.)
1854	IF (zoverride) THEN
1855	err = cp_update_opt(parser,curopt%section,curopt%name,curopt%values)
1856	ELSE
1857	err = cp_add_opt(parser,curopt%section,curopt%name,curopt%values)
1858	ENDIF
1859	ENDIF
1860	CALL op_clear(curopt) ; curval = ''
1861	has_opt = cfg_has_option(parser,TRIM(isec)//"/"//TRIM(name))
1862
1863	IF (has_opt.AND..NOT.zoverride) THEN
1864	! it is an error: no duplicate allowed
1865	err = error(basp//'(L'//TRIM(sln)//"): Duplicate option '"//TRIM(name)//"' in "//isec,-8)
1866	EXIT
1867	ENDIF
1868	curopt%name = TRIM(name)
1869	curopt%section = TRIM(isec)
1870	CALL words_clear(curopt%values)
1871	curval = value
1872	CASE(cfg_UNKNOWN)
1873	! unknown handles also invalid name: it is a critical error
1874	IF (err == -9) EXIT
1875	END SELECT
1876	ENDIF
1877	ENDDO
1878	IF (op_valid(curopt)) THEN
1879	IF (LEN(curval) > 0) &
1880	CALL words_extend(curopt%values,TRIM(ADJUSTL(curval)),space,.true.,.true.)
1881	IF (zoverride) THEN
1882	err = cp_update_opt(parser,curopt%section,curopt%name,curopt%values)
1883	ELSE
1884	err = cp_add_opt(parser,curopt%section,curopt%name,curopt%values)
1885	ENDIF
1886	ENDIF
1887	CALL op_clear(curopt) ; curval = ''
1888
1889	CLOSE(lu)
1890
1891	CONTAINS
1892	FUNCTION get_kind(string,name,value) RESULT(kind)
1893	!! Split input line and attempt to guess its relevant kind of statement
1894	!!
1895	!! The input line is searched for section header format or option assignment.
1896	!!
1897	!! - If line begins with '[', has ']' and no '=#' between '[' and ']'
1898	!! it is a section header.
1899	!! - Otherwise, if line has '=', without '#' before '=', it is an option.
1900	!!
1901	!! Then the method returns an integer with the kind flag of the statement which is one of
1902	!! -1 (cfg_UNKNOWN), 0 (cfg_SECTION) or 1 (cfg_OPTION).
1903	CHARACTER(len=*), INTENT(in) :: string !! Input string to process
1904	CHARACTER(len=:), INTENT(out), ALLOCATABLE :: name, & !! Name of the relevant option/section if any, otherwise an empty string.
1905	value !! Value of the relevant option (if any), otherwise an empty string
1906	INTEGER :: kind !! An integer with the kind of statement.
1907	CHARACTER(len=:), ALLOCATABLE :: copy
1908	INTEGER :: bi,ei
1909	CHARACTER(len=2), PARAMETER :: quotes=CHAR(34)//CHAR(39)
1910	kind = cfg_UNKNOWN
1911	! get a trimmed (and left adjusted) copy
1912	copy = TRIM(string)
1913	! Is it a section ?
1914	! ---> search for subscripts of '[' and ']'
1915	! ---> check that '[' is 1st char and ']' is last char
1916	bi = INDEX(copy,'[') ; ei = INDEX(copy,']')
1917	IF (bi == 1 .AND. ei == LEN(copy) .AND. bi < ei) THEN
1918	! it is a section header
1919	kind = cfg_SECTION
1920	! get section name: adjust and trim to remove extra blank spaces
1921	name = str_to_lower(TRIM(ADJUSTL(copy(bi+1:ei-1))))
1922	IF (TRIM(name) /= "__default__" .AND. .NOT.cfg_check_name(name)) THEN
1923	kind = cfg_UNKNOWN
1924	err = error("Invalid section name ("//name//")",-9)
1925	RETURN
1926	ENDIF
1927	value = ''
1928	ELSE
1929	! Is it an option ?
1930	! --> search for '=' and check if it is set before
1931	! 1st quote (if any)
1932	bi = INDEX(copy,"=")
1933	! search for quotes
1934	ei = SCAN(copy,quotes) ; IF (ei==0) ei = LEN(copy)+1
1935	IF (bi /= 0 .AND. bi < ei) THEN
1936	kind = cfg_OPTION
1937	name = str_to_lower(TRIM(copy(1:bi-1)))
1938	IF (.NOT.cfg_check_name(name)) THEN
1939	kind = cfg_UNKNOWN
1940	err = error("Invalid option name ("//TRIM(name)//")",-9)
1941	RETURN
1942	ENDIF
1943	IF (bi == LEN(copy)) THEN
1944	value = ''
1945	ELSE
1946	value = TRIM(copy(bi+1:))
1947	ENDIF
1948	ELSE
1949	! not an option and not a section: malformed statement !
1950	err = error('Malformed statement at line '//TRIM(sln),-13)
1951	ENDIF
1952	ENDIF
1953	RETURN
1954	END FUNCTION get_kind
1955
1956	FUNCTION strip_comment(line) RESULT(stripped)
1957	!! Replace comments part of a string by blank spaces
1958	!! The method replaces every characters after '#' (included) by spaces.
1959	!! @note
1960	!! Output string is also left adjusted, thus only trailing blank can be present.
1961	CHARACTER(len=*), INTENT(in) :: line !! A string to process
1962	CHARACTER(len=LEN(line)) :: stripped !! A string of same length than 'line' but without comment(s)
1963
1964	INTEGER :: idx
1965	stripped = ADJUSTL(line)
1966	idx = INDEX(stripped,"#")
1967	IF (idx > 0) stripped(idx:) = REPEAT(CHAR(32),LEN(line)-idx+1)
1968	RETURN
1969	END FUNCTION strip_comment
1970
1971	FUNCTION readline(lun,string) RESULT(not_eof)
1972	!! Read a complete line
1973	!!
1974	!! Each time it is CALLed, the function reads a complete of the file opened in 'lun' logical
1975	!! unit and returns .false. if EOF has been reached, .true. otherwise.
1976	!!
1977	!! The function is intended to read a file line by line:
1978	!!
1979	!! ```fortran
1980	!! lu = 1
1981	!! open(lu,file="path/to/the/file/to/read")
1982	!! l=0 ! A line counter
1983	!! DO WHILE(readline(lu,line))
1984	!! l = l + 1
1985	!! WRITE(*,'("L",I2.2,": ",(a))') il,line
1986	!! ENDDO
1987	!! CLOSE(1)
1988	!! ```
1989	INTEGER, INTENT(in) :: lun !! Logical unit with the opened file to read.
1990	CHARACTER(len=:), INTENT(out), ALLOCATABLE :: string !! Output processed line
1991	LOGICAL :: not_eof !! .true. if EOF has NOT been reached yet, .false. otherwise
1992	CHARACTER(len=50) :: buf
1993	INTEGER :: e,sz
1994	not_eof = .true. ; string = ''
1995	DO
1996	READ(lun,'(a)',ADVANCE="no",SIZE=sz,IOSTAT=e) buf
1997	IF (e == IOSTAT_END) THEN
1998	not_eof = .false.
1999	IF (sz > 0) THEN
2000	string=string//buf(1:sz)
2001	ENDIF
2002	EXIT
2003	ELSE IF (e == IOSTAT_EOR) THEN
2004	string = string//buf(1:sz)
2005	EXIT
2006	ELSE
2007	string = string//TRIM(buf)
2008	ENDIF
2009	ENDDO
2010	END FUNCTION readline
2011
2012	FUNCTION is_comment(str,incpath) RESULT(res)
2013	!! Check if line is a comment or an empty string
2014	!! @warning
2015	!! Currently, if an '#include' statement is found, the method assumes a single path is set after the directive.
2016	CHARACTER(len=*), INTENT(in) :: str
2017	!! The string to check
2018	CHARACTER(len=:), INTENT(out), ALLOCATABLE :: incpath
2019	!! A string with the filepath to be included if '#include' statement is found, empty string otherwise
2020	LOGICAL :: res
2021	!! .true. if line is a comment or an empty string, .false. otherwise
2022	CHARACTER(len=:), ALLOCATABLE :: copy
2023	res = .false. ; incpath = ''
2024	copy = TRIM(ADJUSTL(str))
2025	IF (LEN(copy) == 0) THEN
2026	res = .true.
2027	ELSE IF (INDEX(copy,"#") == 1) THEN
2028	res = .true.
2029	! search for include statement
2030	! IMPORTANT: assume that there is only a path after include statement
2031	IF (INDEX(copy,"#include ") == 1) incpath = TRIM(ADJUSTL(copy(10:)))
2032	ENDIF
2033	RETURN
2034	END FUNCTION is_comment
2035
2036	FUNCTION check_include(list,incpath) RESULT(ok)
2037	!! Check if path is not in list
2038	!! @note
2039	!! If path is not in list it is added to the list.
2040	TYPE(words), INTENT(inout) :: list !! A list of paths
2041	CHARACTER(len=*), INTENT(in) :: incpath !! Path to check in list
2042	LOGICAL :: ok !! .true. if 'path' is __not__ in list, .false. otherwise
2043	CALL words_reset(list)
2044	ok = .true.
2045	DO WHILE(words_valid(list))
2046	IF (TRIM(incpath) == TRIM(words_current(list))) THEN
2047	ok = .false. ; EXIT
2048	ENDIF
2049	CALL words_next(list)
2050	ENDDO
2051	IF (ok) CALL words_append(list,TRIM(incpath))
2052	END FUNCTION check_include
2053
2054	END FUNCTION read_include
2055
2056	! insertion sort... internal
2057
2058	SUBROUTINE insertionSort(opts)
2059	!! Sort an array of Options using insertion sort algorithm
2060	TYPE(option), INTENT(inout), DIMENSION(:) :: opts !! Array to sort.
2061	TYPE(option) :: temp
2062	INTEGER :: i, j
2063	DO i = 2, SIZE(opts)
2064	j = i - 1
2065	temp = opts(i)
2066	DO WHILE (j>=1) ! .AND. op_greater_than(opts(j),temp))
2067	IF (op_greater_than(opts(j),temp)) THEN
2068	opts(j+1) = opts(j)
2069	j = j - 1
2070	ELSE
2071	EXIT
2072	ENDIF
2073	ENDDO
2074	opts(j+1) = temp
2075	CALL op_clear(temp)
2076	ENDDO
2077	END SUBROUTINE insertionSort
2078
2079	FUNCTION free_lun() RESULT(lu)
2080	!> Get the first free logical unit
2081	!!
2082	!! The function loops from 7 to 9999 and returns the first free logical unit.
2083	!! @note
2084	!! According to Fortran standard, the maximum value for a lun is processor
2085	!! dependent. I just assume that [7,9999] is a valid range and I believe that
2086	!! 9992 files to be opened is far enough for any program !
2087	!! @note
2088	!! If you intend to use loggers object from this library, you should keep in
2089	!! mind that loggers open files with the first free logical unit. Consequently
2090	!! if you need to perform I/O operations you should use this function to get a
2091	!! free lun instead of just randomly set a lun !
2092	INTEGER :: lu
2093	!! First free logical unit in the range [7,999] or -1 if no lun is available
2094	INTEGER, PARAMETER :: mxlu = 9999
2095	LOGICAL :: notfree
2096	lu = 6 ; notfree = .true.
2097	DO WHILE(notfree.AND.lu<=mxlu)
2098	lu=lu+1 ; INQUIRE(unit=lu,OPENED=notfree)
2099	ENDDO
2100	IF (lu >= mxlu) lu = -1
2101	END FUNCTION free_lun
2102
2103	END MODULE CFGPARSE
2104

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format