diff options
author | Jeffrey Armstrong <jeff@approximatrix.com> | 2022-04-11 16:28:43 -0400 |
---|---|---|
committer | Jeffrey Armstrong <jeff@approximatrix.com> | 2022-04-11 16:28:43 -0400 |
commit | 4392961dd95582b91e173f9ae40ac510b9afe7d4 (patch) | |
tree | 253e6d2b7ea70b21074575af94d194ed4ec48571 /captain/queryutils.f90 | |
parent | 26a936137f67843cb773bc9b9e8c360d5abff65f (diff) | |
download | levitating-4392961dd95582b91e173f9ae40ac510b9afe7d4.tar.gz levitating-4392961dd95582b91e173f9ae40ac510b9afe7d4.zip |
Added token validation to all api calls, esp. checkins. Changed status reports to use better query structure. Added query derived types to the request derived types directly. Requires testing of actual builds.
Diffstat (limited to 'captain/queryutils.f90')
-rw-r--r-- | captain/queryutils.f90 | 72 |
1 files changed, 42 insertions, 30 deletions
diff --git a/captain/queryutils.f90 b/captain/queryutils.f90 index 00a914b..c6b612b 100644 --- a/captain/queryutils.f90 +++ b/captain/queryutils.f90 @@ -36,7 +36,7 @@ implicit none end type query_component type :: query - + character(len=:), pointer::full type(query_component), dimension(:), pointer::components @@ -133,42 +133,54 @@ contains implicit none class(query), intent(out)::self - character(len=*), intent(in)::str + character(len=*), intent(in), optional::str character(64)::msg integer::ampersands, i, i_end, i_comp, n - n = len_trim(str) - allocate(character(len=n) :: 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)) + self%components => null() + self%full => null() - ! Split and parse each component - if(ampersands == 0) then - call self%components(1)%parse(self%full) + if(present(str)) then + n = len_trim(str) 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 + n = 0 + end if + + if(n > 0) then + + allocate(character(len=n) :: 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 - call self%components(i_comp)%parse(self%full(i:i_end-1)) + + 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 if end subroutine query_init |