! Copyright (c) 2021 Approximatrix, LLC ! ! Permission is hereby granted, free of charge, to any person obtaining a copy ! of this software and associated documentation files (the "Software"), to deal ! in the Software without restriction, including without limitation the rights ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ! copies of the Software, and to permit persons to whom the Software is ! furnished to do so, subject to the following conditions: ! ! The above copyright notice and this permission notice shall be included in ! all copies or substantial portions of the Software. ! ! The Software shall be used for Good, not Evil. ! ! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ! SOFTWARE. module page_template implicit none integer, parameter::VTYPE_NONE = 0, & VTYPE_STRING = 1, & VTYPE_INTEGER = 2, & VTYPE_LOGICAL = 3 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 procedure :: assign_logical => variable_assign_logical generic :: assign => assign_integer, assign_string, assign_logical end type type :: template character(len=:), pointer::base_filename type(variable), dimension(:), pointer::variables character(len=:), pointer::output_filename contains procedure :: init => template_init procedure :: destroy => template_destroy procedure :: assign_integer => template_assign_integer procedure :: assign_string => template_assign_string procedure :: assign_logical => template_assign_logical procedure :: render => template_render procedure :: evaluate => template_evaluate procedure :: generate_output_filename => template_generate_output_filename generic :: assign => assign_integer, assign_string, assign_logical 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) use logging implicit none class(variable)::self character(*), intent(in)::name 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 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 variable_assign_logical(self, name, lg) implicit none class(variable)::self character(*), intent(in)::name logical, intent(in)::lg call self%set_name(name) self%vtype = VTYPE_LOGICAL if(lg) then self%vint = 1 call self%set_string_value("True") else self%vint = 0 call self%set_string_value("False") end if end subroutine variable_assign_logical 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 self%output_filename => null() 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 subroutine template_generate_output_filename(self) use utilities, only: generate_temporary_filename use logging implicit none class(template)::self self%output_filename => generate_temporary_filename() end subroutine template_generate_output_filename 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)) tmp%vtype = VTYPE_NONE 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) use logging 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) !call write_log(name//"=|||"//trim(value)//"|||", LOG_INFO) end subroutine template_assign_string subroutine template_assign_logical(self, name, value) implicit none class(template)::self character(*), intent(in)::name logical, intent(in)::value integer::i i = template_available_variable_index(self) call self%variables(i)%assign(name, value) end subroutine template_assign_logical function handle_template_extends(in_unit, extends_command) result(outfile) use utilities, only: generate_temporary_filename use config, only: template_filepath implicit none integer, intent(in)::in_unit character(*), intent(in)::extends_command character(len=:), pointer::outfile integer::base_unit, out_unit character(1024)::base_filename character(256)::variable, varbuffer character::this_char, last_char integer::i, istat i = index(extends_command, "as") if(i > 0) then call template_filepath(trim(adjustl(extends_command(9:i-1))), base_filename) variable = adjustl(extends_command(i+3:len_trim(extends_command))) open(newunit=base_unit, file=trim(base_filename), status="old", & form="unformatted", access="stream") outfile => generate_temporary_filename() open(newunit=out_unit, file=outfile, status="new", & form="formatted", access="stream", action="write") last_char = ' ' read(base_unit, iostat=istat) this_char do while(istat == 0) if(this_char == '{' .and. last_char == '{') then varbuffer = '{{' i = 2 do while(varbuffer(i-1:i) /= '}}' .and. istat == 0) i = i + 1 read(base_unit, iostat=istat) varbuffer(i:i) end do ! Found our variable! if( trim(variable) == trim(adjustl(varbuffer(4:i-3))) ) then ! Write out the original input unit read(in_unit, iostat=istat) this_char do while(istat == 0) write(out_unit, '(A1)', advance='no') this_char read(in_unit, iostat=istat) this_char end do ! Not our variable else do i = 1, len_trim(varbuffer) write(out_unit, '(A1)', advance='no') varbuffer(i:i) end do end if last_char = ' ' this_char = ' ' else if(last_char == '{') then write(out_unit, '(A1, A1)', advance='no') last_char, this_char else if(this_char /= '{') then write(out_unit, '(A1)', advance='no') this_char end if last_char = this_char read(base_unit, iostat=istat) this_char end do close(base_unit) close(out_unit) end if end function handle_template_extends recursive subroutine template_render(self, filename, input_tempfile) use logging use utilities, only: delete_file implicit none class(template)::self character(*), intent(in), optional::filename, input_tempfile character::this_char, last_char character(len=2)::running_pair, closing_pair character(256)::brace_internals character(len=:), pointer::replacement logical::writing_now integer::input, istat, i, unum if(present(filename)) then allocate(character(len=len_trim(filename)) :: self%output_filename) self%output_filename = trim(filename) else if(.not. associated(self%output_filename)) then call self%generate_output_filename() end if open(newunit=unum, file=trim(self%output_filename), status="unknown", form="formatted", access="stream", action="write") ! We may be working with a temporary file after a 'extends' tag if(present(input_tempfile)) then open(newunit=input, file=trim(input_tempfile), status="old", form="unformatted", access="stream") else open(newunit=input, file=trim(self%base_filename), status="old", form="unformatted", access="stream") end if writing_now = .true. last_char = ' ' read(input, iostat=istat) this_char do while(istat == 0) running_pair = last_char//this_char if(running_pair == '{{') then ! Future expansion if(running_pair == '{{') then closing_pair = '}}' end if brace_internals = ' ' read(input, iostat=istat) this_char i = 1 do while(istat == 0 .and. (running_pair /= closing_pair)) brace_internals(i:i) = this_char i = i + 1 last_char = this_char read(input, iostat=istat) this_char running_pair = last_char//this_char end do brace_internals(i-1:i-1) = ' ' ! Remove trailing bracket brace_internals = adjustl(brace_internals) ! Simple variable if(closing_pair == '}}') then 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 ! Expression else end if else if(running_pair == '{%') then closing_pair = '%}' brace_internals = ' ' read(input, iostat=istat) this_char i = 1 do while(istat == 0 .and. (running_pair /= closing_pair)) brace_internals(i:i) = this_char i = i + 1 last_char = this_char read(input, iostat=istat) this_char running_pair = last_char//this_char end do brace_internals(i-1:i-1) = ' ' ! Remove trailing bracket brace_internals = adjustl(brace_internals) ! Parse the command if(brace_internals(1:8) == 'extends ') then ! Replacement will be a new file to parse through this engine replacement => handle_template_extends(input ,trim(brace_internals)) ! Close the current set of files before retrying the rendering close(unum) close(input) ! Re-render using the constructed tempfile if(associated(replacement)) then call write_log("replacement template: "//trim(replacement), LOG_DEBUG) call template_render(self, input_tempfile=replacement) call write_log("template output: "//trim(self%output_filename), LOG_DEBUG) ! It was temporary call delete_file(replacement) deallocate(replacement) end if ! Stop rendering - it was handled above return end if else if(last_char == '{') then write(unum, '(A1)', advance='no') last_char write(unum, '(A1)', advance='no') this_char else if(this_char /= '{') then write(unum, '(A1)', advance='no') this_char end if last_char = this_char read(input, iostat=istat) this_char end do close(unum) close(input) end subroutine template_render 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