diff options
| -rw-r--r-- | captain/queryutils.f90 | 176 |
1 files changed, 176 insertions, 0 deletions
diff --git a/captain/queryutils.f90 b/captain/queryutils.f90 new file mode 100644 index 0000000..c6b5d83 --- /dev/null +++ b/captain/queryutils.f90 @@ -0,0 +1,176 @@ +module query_utilities +implicit none + + type :: query_component + character(len=:), pointer::key + character(len=:), pointer::value + + contains + + procedure :: parse => query_component_parse + procedure :: destroy => query_component_destroy + procedure :: has_key => query_component_has_key + + end type query_component + + type :: query + + character(len=:), pointer::full + + type(query_component), dimension(:), pointer::components + + contains + + procedure :: init => query_init + procedure :: destroy => query_destroy + procedure :: component_count => query_component_count + + end type query + +contains + + subroutine query_component_parse(self, comptext) + implicit none + + class(query_component), intent(out)::self + character(*), intent(in)::comptext + + character(len=:), allocatable::decoded + integer::i_in, i_out, i_equals, chnum + + allocate(character(len=len_trim(comptext)) :: decoded) + + i_equals = 0 + i_out = 1 + i_in = 1 + do while(i_in <= len_trim(comptext)) + if(comptext(i_in:i_in) /= '%') then + decoded(i_out:i_out) = comptext(i_in:i_in) + if(comptext(i_in:i_in) == '=') then + i_equals = i_out + end if + i_in = i_in + 1 + else + i_in = i_in + 1 + read(comptext(i_in:i_in+1), '(Z2)') chnum + decoded(i_out:i_out) = achar(chnum) + i_in = i_in + 2 + end if + i_out = i_out + 1 + end do + + if(i_equals == 0) then + allocate(character(len=len_trim(decoded)) :: self%value) + self%value = decoded + else + allocate(character(len=i_equals-1) :: self%key) + self%key = decoded(1:i_equals-1) + + allocate(character(len=len_trim(decoded)-i_equals) :: self%value) + self%value = decoded(i_equals+1:len_trim(decoded)) + end if + + deallocate(decoded) + + end subroutine query_component_parse + + elemental subroutine query_component_destroy(self) + implicit none + + class(query_component), intent(inout)::self + + if(associated(self%key)) then + deallocate(self%key) + end if + + if(associated(self%value)) then + deallocate(self%value) + end if + + end subroutine query_component_destroy + + pure function query_component_has_key(self) result(res) + implicit none + + class(query_component), intent(in)::self + logical::res + + res = associated(self%key) + + end function query_component_has_key + + subroutine query_init(self, str) + implicit none + + class(query), intent(out)::self + character(len=*), intent(in)::str + + integer::ampersands, i, i_end, i_comp + + allocate(character(len=len_trim(str)) :: self%full) + self%full = str + + ampersands = 0 + do i = 1, len(self%full) + if(self%full(i:i) == '&') then + ampersands = ampersands + 1 + end if + end do + + allocate(self%components(ampersands + 1)) + + ! Split and parse each component + if(ampersands == 0) then + call self%components(1)%parse(self%full) + else + i_comp = 1 + i = 1 + i_end = index(self%full, '&') + do while(i_comp < ampersands + 1) + call self%components(i_comp)%parse(self%full(i:i_end-1)) + i = i_end + 1 + do i_end = i, len_trim(self%full) + if(self%full(i_end:i_end) == '&') then + exit + end if + end do + i_comp = i_comp + 1 + end do + call self%components(i_comp)%parse(self%full(i:i_end-1)) + end if + + end subroutine query_init + + pure function query_component_count(self) + implicit none + + class(query), intent(in)::self + integer::query_component_count + + if(associated(self%components)) then + query_component_count = size(self%components) + else + query_component_count = 0 + end if + + end function query_component_count + + subroutine query_destroy(self) + implicit none + + class(query), intent(inout)::self + + if(associated(self%full)) then + deallocate(self%full) + self%full => null() + end if + + if(associated(self%components)) then + call self%components%destroy() + deallocate(self%components) + self%components => null() + end if + + end subroutine query_destroy + +end module query_utilities |