1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
|
module page_template
implicit none
integer, parameter::VTYPE_NONE = 0, &
VTYPE_STRING = 1, &
VTYPE_INTEGER = 2
type :: variable
character(len=:), pointer::vname
integer::vtype
character(len=:), pointer::vstr
integer::vint
contains
procedure :: destroy => variable_destroy
procedure :: shallow_copy => variable_shallow_copy
procedure :: set_name => variable_set_name
procedure :: set_string_value => variable_set_string_value
procedure :: assign_integer => variable_assign_integer
procedure :: assign_string => variable_assign_string
generic :: assign => assign_integer, assign_string
end type
type :: template
character(len=:), pointer::base_filename
type(variable), dimension(:), pointer::variables
contains
procedure :: init => template_init
procedure :: destroy => template_destroy
procedure :: assign_integer => template_assign_integer
procedure :: assign_string => template_assign_string
procedure :: render_unit => template_render_unit
procedure :: render_filename => template_render_filename
procedure :: evaluate => template_evaluate
generic :: render => render_unit, render_filename
generic :: assign => assign_integer, assign_string
end type
contains
elemental subroutine variable_destroy(self)
implicit none
class(variable), intent(inout)::self
if(associated(self%vname)) then
deallocate(self%vname)
end if
if(associated(self%vstr)) then
deallocate(self%vstr)
end if
end subroutine variable_destroy
subroutine variable_shallow_copy(self, v)
implicit none
class(variable), intent(inout)::self
class(variable), intent(in)::v
if(associated(v%vname)) then
self%vname => v%vname
end if
if(associated(v%vstr)) then
self%vstr => v%vstr
end if
self%vtype = v%vtype
self%vint = v%vint
end subroutine variable_shallow_copy
subroutine variable_set_name(self, name)
implicit none
class(variable)::self
character(*), intent(in)::name
if(associated(self%vname)) then
deallocate(self%vname)
end if
allocate(character(len=max(len_trim(name), 1)) :: self%vname)
if(len_trim(name) == 0) then
self%vname = " "
else
self%vname = trim(name)
end if
end subroutine variable_set_name
subroutine variable_set_string_value(self, v)
implicit none
class(variable)::self
character(*), intent(in)::v
if(associated(self%vstr)) then
deallocate(self%vstr)
end if
allocate(character(len=max(len_trim(v), 1)) :: self%vstr)
if(len_trim(v) == 0) then
self%vstr = " "
else
self%vstr = trim(v)
end if
end subroutine variable_set_string_value
subroutine variable_assign_integer(self, name, i)
implicit none
class(variable)::self
character(*), intent(in)::name
integer, intent(in)::i
character(16)::int_string
call self%set_name(name)
self%vint = i
self%vtype = VTYPE_INTEGER
write(int_string, *) i
call self%set_string_value(trim(adjustl(int_string)))
end subroutine variable_assign_integer
subroutine variable_assign_string(self, name, str)
implicit none
class(variable)::self
character(*), intent(in)::name, str
call self%set_name(name)
self%vtype = VTYPE_STRING
call self%set_string_value(str)
end subroutine variable_assign_string
subroutine template_init(self, filename)
implicit none
class(template)::self
character(*), intent(in)::filename
allocate(character(len=len_trim(filename)) :: self%base_filename)
self%base_filename = filename
allocate(self%variables(32))
self%variables%vtype = VTYPE_NONE
end subroutine template_init
subroutine template_destroy(self)
implicit none
class(template)::self
deallocate(self%base_filename)
call self%variables%destroy()
deallocate(self%variables)
end subroutine template_destroy
function template_available_variable_index(self) result(i)
implicit none
class(template)::self
type(variable), dimension(:), pointer::tmp
integer::i, j
do i = 1, size(self%variables)
if(self%variables(i)%vtype == VTYPE_NONE) then
exit
end if
end do
! Need to expand
if(i > size(self%variables)) then
allocate(tmp(size(self%variables)+32))
do j=1, i-1
call tmp(j)%shallow_copy(self%variables(j))
end do
! We performed a shallow copy above, so don't destroy
! the old variables
deallocate(self%variables)
self%variables => tmp
tmp => null()
end if
end function template_available_variable_index
subroutine template_assign_integer(self, name, value)
implicit none
class(template)::self
character(*), intent(in)::name
integer, intent(in)::value
integer::i
i = template_available_variable_index(self)
call self%variables(i)%assign(name, value)
end subroutine template_assign_integer
subroutine template_assign_string(self, name, value)
implicit none
class(template)::self
character(*), intent(in)::name, value
integer::i
i = template_available_variable_index(self)
call self%variables(i)%assign(name, value)
end subroutine template_assign_string
subroutine template_render_filename(self, filename)
implicit none
class(template)::self
character(*), intent(in)::filename
integer::unit_number
open(file=filename, newunit=unit_number, status="unknown", form="formatted", action="write")
call self%render_unit(unit_number)
close(unit_number)
end subroutine template_render_filename
subroutine template_render_unit(self, unum)
implicit none
class(template)::self
integer, intent(in)::unum
character::this_char, last_char
character(256)::brace_internals
character(len=:), pointer::replacement
integer::input, istat, i
open(newunit=input, file=self%base_filename, status="old", form="formatted", action="read")
last_char = ' '
read(input, '(A1)', iostat=istat) this_char
do while(istat == 0)
if(this_char /= '{') then
if(last_char == '{') then
write(unum, '(A1)', advance='no') last_char
end if
write(unum, '(A1)', advance='no') this_char
! Two curly braces
else if(last_char == '{') then
brace_internals = ' '
read(input, '(A1)', iostat=istat) this_char
i = 1
do while(istat == 0 .and. .not. (this_char == '}' .and. last_char == '}'))
brace_internals(i:i) = this_char
i = i + 1
last_char = this_char
read(input, '(A1)', iostat=istat) this_char
end do
brace_internals(i:i) = ' ' ! Remove trailing bracket
brace_internals = adjustl(brace_internals)
replacement => self%evaluate(brace_internals)
if(associated(replacement)) then
do i=1, len_trim(replacement)
write(unum, '(A1)', advance='no') replacement(i:i)
end do
replacement => null() ! do not free - internal strings
end if
end if
last_char = this_char
read(input, '(A1)', iostat=istat) this_char
end do
close(input)
end subroutine template_render_unit
function template_evaluate(self, txt) result(res)
implicit none
class(template)::self
character(*), intent(in)::txt
character(:), pointer::res
integer::i
res => null()
! Right now, we only support straight-up variables
do i = 1, size(self%variables)
if(self%variables(i)%vtype == VTYPE_NONE) then
exit
end if
if(self%variables(i)%vname == trim(txt) .and. associated(self%variables(i)%vstr)) then
res => self%variables(i)%vstr
exit
end if
end do
end function template_evaluate
end module page_template
|
