Fortran · 6326 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
118 ! Remove inline comments FIRST (before removing quotes)
119 ! This correctly handles "#FFFFFF" as a quoted string, not a comment
120 call remove_inline_comment(value)
121
122 len_val = len_trim(value)
123 if (len_val == 0) return
124
125 ! Remove surrounding double quotes for strings
126 if (value(1:1) == '"' .and. len_val >= 2) then
127 if (value(len_val:len_val) == '"') then
128 value = value(2:len_val-1)
129 end if
130 end if
131
132 end subroutine parse_value
133
134 ! Remove inline comments from value
135 subroutine remove_inline_comment(value)
136 character(len=*), intent(inout) :: value
137 integer :: i
138 logical :: in_string
139
140 in_string = .false.
141 do i = 1, len_trim(value)
142 if (value(i:i) == '"') then
143 in_string = .not. in_string
144 else if (value(i:i) == '#' .and. .not. in_string) then
145 value = value(1:i-1)
146 value = trim(value)
147 return
148 end if
149 end do
150 end subroutine remove_inline_comment
151
152 ! Get a string value from the TOML file
153 function toml_get_string(tf, section, key, default) result(val)
154 type(toml_file_t), intent(in) :: tf
155 character(len=*), intent(in) :: section, key
156 character(len=*), intent(in) :: default
157 character(len=256) :: val
158 integer :: i
159
160 val = default
161
162 do i = 1, tf%count
163 if (trim(tf%entries(i)%section) == trim(section) .and. &
164 trim(tf%entries(i)%key) == trim(key)) then
165 val = tf%entries(i)%value
166 return
167 end if
168 end do
169
170 end function toml_get_string
171
172 ! Get an integer value from the TOML file
173 function toml_get_integer(tf, section, key, default) result(val)
174 type(toml_file_t), intent(in) :: tf
175 character(len=*), intent(in) :: section, key
176 integer, intent(in) :: default
177 integer :: val
178 character(len=256) :: str_val
179 integer :: ios
180
181 val = default
182 str_val = toml_get_string(tf, section, key, '')
183
184 if (len_trim(str_val) > 0) then
185 read(str_val, *, iostat=ios) val
186 if (ios /= 0) val = default
187 end if
188
189 end function toml_get_integer
190
191 ! Get a real value from the TOML file
192 function toml_get_real(tf, section, key, default) result(val)
193 type(toml_file_t), intent(in) :: tf
194 character(len=*), intent(in) :: section, key
195 real, intent(in) :: default
196 real :: val
197 character(len=256) :: str_val
198 integer :: ios
199
200 val = default
201 str_val = toml_get_string(tf, section, key, '')
202
203 if (len_trim(str_val) > 0) then
204 read(str_val, *, iostat=ios) val
205 if (ios /= 0) val = default
206 end if
207
208 end function toml_get_real
209
210 ! Get a logical value from the TOML file
211 function toml_get_logical(tf, section, key, default) result(val)
212 type(toml_file_t), intent(in) :: tf
213 character(len=*), intent(in) :: section, key
214 logical, intent(in) :: default
215 logical :: val
216 character(len=256) :: str_val
217
218 val = default
219 str_val = toml_get_string(tf, section, key, '')
220
221 if (len_trim(str_val) > 0) then
222 select case (trim(adjustl(str_val)))
223 case ('true', 'True', 'TRUE', 'yes', 'Yes', 'YES', '1')
224 val = .true.
225 case ('false', 'False', 'FALSE', 'no', 'No', 'NO', '0')
226 val = .false.
227 case default
228 val = default
229 end select
230 end if
231
232 end function toml_get_logical
233
234 end module toml_parser_mod
235