aboutsummaryrefslogtreecommitdiff
path: root/captain/queryutils.f90
diff options
context:
space:
mode:
authorJeffrey Armstrong <jeff@approximatrix.com>2022-04-11 16:28:43 -0400
committerJeffrey Armstrong <jeff@approximatrix.com>2022-04-11 16:28:43 -0400
commit4392961dd95582b91e173f9ae40ac510b9afe7d4 (patch)
tree253e6d2b7ea70b21074575af94d194ed4ec48571 /captain/queryutils.f90
parent26a936137f67843cb773bc9b9e8c360d5abff65f (diff)
downloadlevitating-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.f9072
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