Fortran · 6238 bytes Raw Blame History
1 module toml_parser_mod
2 implicit none
3 private
4
5 public :: toml_file_t
6 public :: toml_open, toml_close
7 public :: toml_get_string, toml_get_integer, toml_get_real, toml_get_logical
8
9 integer, parameter :: MAX_LINE_LEN = 512
10 integer, parameter :: MAX_KEYS = 128
11
12 ! Key-value pair storage
13 type :: toml_entry_t
14 character(len=64) :: section = ''
15 character(len=64) :: key = ''
16 character(len=256) :: value = ''
17 end type toml_entry_t
18
19 type :: toml_file_t
20 type(toml_entry_t) :: entries(MAX_KEYS)
21 integer :: count = 0
22 logical :: loaded = .false.
23 end type toml_file_t
24
25 contains
26
27 ! Open and parse a TOML file
28 function toml_open(path) result(tf)
29 character(len=*), intent(in) :: path
30 type(toml_file_t) :: tf
31 integer :: unit_num, ios
32 character(len=MAX_LINE_LEN) :: line
33 character(len=64) :: current_section
34 logical :: file_exists
35
36 tf%count = 0
37 tf%loaded = .false.
38 current_section = ''
39
40 ! Check if file exists
41 inquire(file=path, exist=file_exists)
42 if (.not. file_exists) return
43
44 ! Open file
45 open(newunit=unit_num, file=path, status='old', action='read', iostat=ios)
46 if (ios /= 0) return
47
48 ! Parse line by line
49 do
50 read(unit_num, '(A)', iostat=ios) line
51 if (ios /= 0) exit
52
53 call parse_line(tf, line, current_section)
54 end do
55
56 close(unit_num)
57 tf%loaded = .true.
58
59 end function toml_open
60
61 ! Close/cleanup TOML file (nothing to do for now)
62 subroutine toml_close(tf)
63 type(toml_file_t), intent(inout) :: tf
64 tf%count = 0
65 tf%loaded = .false.
66 end subroutine toml_close
67
68 ! Parse a single line
69 subroutine parse_line(tf, line, current_section)
70 type(toml_file_t), intent(inout) :: tf
71 character(len=*), intent(in) :: line
72 character(len=64), intent(inout) :: current_section
73 character(len=MAX_LINE_LEN) :: trimmed
74 integer :: eq_pos, end_pos
75
76 trimmed = adjustl(line)
77
78 ! Skip empty lines
79 if (len_trim(trimmed) == 0) return
80
81 ! Skip comments
82 if (trimmed(1:1) == '#') return
83
84 ! Check for section header [section]
85 if (trimmed(1:1) == '[') then
86 end_pos = index(trimmed, ']')
87 if (end_pos > 2) then
88 current_section = trimmed(2:end_pos-1)
89 end if
90 return
91 end if
92
93 ! Parse key = value
94 eq_pos = index(trimmed, '=')
95 if (eq_pos > 1) then
96 if (tf%count >= MAX_KEYS) return
97
98 tf%count = tf%count + 1
99 tf%entries(tf%count)%section = current_section
100 tf%entries(tf%count)%key = adjustl(trimmed(1:eq_pos-1))
101 ! Trim trailing spaces from key
102 tf%entries(tf%count)%key = trim(tf%entries(tf%count)%key)
103
104 ! Parse value (skip leading spaces)
105 tf%entries(tf%count)%value = adjustl(trimmed(eq_pos+1:))
106 call parse_value(tf%entries(tf%count)%value)
107 end if
108
109 end subroutine parse_line
110
111 ! Clean up a value (remove quotes, handle types)
112 subroutine parse_value(value)
113 character(len=*), intent(inout) :: value
114 integer :: len_val
115
116 value = adjustl(value)
117 len_val = len_trim(value)
118
119 if (len_val == 0) return
120
121 ! Remove surrounding double quotes for strings
122 if (value(1:1) == '"' .and. len_val >= 2) then
123 if (value(len_val:len_val) == '"') then
124 value = value(2:len_val-1)
125 end if
126 end if
127
128 ! Remove inline comments (# after value)
129 call remove_inline_comment(value)
130
131 end subroutine parse_value
132
133 ! Remove inline comments from value
134 subroutine remove_inline_comment(value)
135 character(len=*), intent(inout) :: value
136 integer :: i
137 logical :: in_string
138
139 in_string = .false.
140 do i = 1, len_trim(value)
141 if (value(i:i) == '"') then
142 in_string = .not. in_string
143 else if (value(i:i) == '#' .and. .not. in_string) then
144 value = value(1:i-1)
145 value = trim(value)
146 return
147 end if
148 end do
149 end subroutine remove_inline_comment
150
151 ! Get a string value from the TOML file
152 function toml_get_string(tf, section, key, default) result(val)
153 type(toml_file_t), intent(in) :: tf
154 character(len=*), intent(in) :: section, key
155 character(len=*), intent(in) :: default
156 character(len=256) :: val
157 integer :: i
158
159 val = default
160
161 do i = 1, tf%count
162 if (trim(tf%entries(i)%section) == trim(section) .and. &
163 trim(tf%entries(i)%key) == trim(key)) then
164 val = tf%entries(i)%value
165 return
166 end if
167 end do
168
169 end function toml_get_string
170
171 ! Get an integer value from the TOML file
172 function toml_get_integer(tf, section, key, default) result(val)
173 type(toml_file_t), intent(in) :: tf
174 character(len=*), intent(in) :: section, key
175 integer, intent(in) :: default
176 integer :: val
177 character(len=256) :: str_val
178 integer :: ios
179
180 val = default
181 str_val = toml_get_string(tf, section, key, '')
182
183 if (len_trim(str_val) > 0) then
184 read(str_val, *, iostat=ios) val
185 if (ios /= 0) val = default
186 end if
187
188 end function toml_get_integer
189
190 ! Get a real value from the TOML file
191 function toml_get_real(tf, section, key, default) result(val)
192 type(toml_file_t), intent(in) :: tf
193 character(len=*), intent(in) :: section, key
194 real, intent(in) :: default
195 real :: val
196 character(len=256) :: str_val
197 integer :: ios
198
199 val = default
200 str_val = toml_get_string(tf, section, key, '')
201
202 if (len_trim(str_val) > 0) then
203 read(str_val, *, iostat=ios) val
204 if (ios /= 0) val = default
205 end if
206
207 end function toml_get_real
208
209 ! Get a logical value from the TOML file
210 function toml_get_logical(tf, section, key, default) result(val)
211 type(toml_file_t), intent(in) :: tf
212 character(len=*), intent(in) :: section, key
213 logical, intent(in) :: default
214 logical :: val
215 character(len=256) :: str_val
216
217 val = default
218 str_val = toml_get_string(tf, section, key, '')
219
220 if (len_trim(str_val) > 0) then
221 select case (trim(adjustl(str_val)))
222 case ('true', 'True', 'TRUE', 'yes', 'Yes', 'YES', '1')
223 val = .true.
224 case ('false', 'False', 'FALSE', 'no', 'No', 'NO', '0')
225 val = .false.
226 case default
227 val = default
228 end select
229 end if
230
231 end function toml_get_logical
232
233 end module toml_parser_mod
234