put_if_header_absent function

src/http/http_client.f90

@@ -11,7 +11,7 @@ module http_client
     use stdlib_optval, only: optval
     use http_request, only: request_type
     use http_response, only: response_type
-    use http_header, only : header_type
+    use http_header, only: append_header, header_has_key, header_type
 
     implicit none
 
@@ -43,27 +43,32 @@ function new_request(url, method, header, json) result(response)
         type(request_type) :: request
         type(response_type) :: response
         type(client_type) :: client
+        integer :: i
 
         ! setting request url
         request%url = url
 
         ! Set default HTTP method.
         request%method = optval(method, 1)
 
-        ! Set default request headers.
-        request%header = [header_type('user-agent', 'fortran-http/1.0.0')]
-        if(present(header)) then 
-            request%header = [header, request%header]
+        ! Set request header
+        if (present(header)) then
+            request%header = header
+            ! Set default request headers.
+            if (.not. header_has_key(header, 'user-agent')) then
+              call append_header(request%header, 'user-agent', 'fortran-http/0.1.0')
+            end if
+        else
+            request%header = [header_type('user-agent', 'fortran-http/0.1.0')]
         end if
-        
+
         if(present(json)) then
             request%json = json
             request%header = [request%header, header_type('Content-Type', 'application/json')]
         end if
 
-        client = client_type(request=request)
-
         ! Populates the response 
+        client = client_type(request=request)
         response = client%client_get_response()
     end function new_request
 
@@ -254,7 +259,7 @@ function client_header_callback(ptr, size, nmemb, client_data) bind(c)
             h_value = buf(i+2 : )
             h_value = h_value( : len(h_value)-2)
             if(len(h_value) > 0 .and. len(h_key) > 0) then
-                call response%append_header(h_key, h_value)
+                call append_header(response%header, h_key, h_value)
                 ! response%header = [response%header, header_type(h_key, h_value)]
             end if
         end if

src/http/http_header.f90

@@ -1,9 +1,90 @@
 module http_header
-    use iso_c_binding
+
+    !! This module provides a simple key value type to use for HTTP headers.
+    !! It also provides procedures to inquire about the presence of a key and
+    !! its value in a header array, as well as a procedure to append new
+    !! headers to an existing array of headers.
+
+    use stdlib_ascii, only: to_lower
+
     implicit none
     private
+
     public :: header_type
+    public :: append_header
+    public :: get_header_value
+    public :: header_has_key
+
     type :: header_type
         character(:), allocatable :: key, value
     end type header_type
+
+contains
+
+    subroutine append_header(header, key, value)
+        !! Append a new header_type instance with key and value members to the
+        !! header array.
+        type(header_type), allocatable, intent(inout) :: header(:)
+            !! Header array to append to
+        character(*), intent(in) :: key
+            !! Key member of header_type to append
+        character(*), intent(in) :: value
+            !! Value member of header_type to append
+        type(header_type), allocatable :: temp(:)
+        integer :: n
+
+        if (allocated(header)) then
+            n = size(header)
+            allocate(temp(n+1))
+            temp(1:n) = header
+            temp(n+1) = header_type(key, value)
+            call move_alloc(temp, header)
+        else
+            allocate(header(1))
+            header(1) = header_type(key, value)
+        end if
+    end subroutine append_header
+
+    pure function get_header_value(header, key) result(val)
+        !! Return the value of a requested key in a header array. If the key is
+        !! not found, the function returns an empty string (unallocated). If
+        !! there are duplicates of the key in the header array, return the value
+        !! of the first occurence of the key.
+        type(header_type), intent(in) :: header(:)
+            !! Header to search for key
+        character(*), intent(in) :: key
+            !! Key to search in header
+        character(:), allocatable :: val
+            !! Value of the key to return
+        integer :: n
+
+        do n = 1, size(header)
+            if (to_lower(key) == to_lower(header(n)%key)) then
+                val = header(n)%value
+                return
+            end if
+        end do
+
+    end function get_header_value
+
+    pure logical function header_has_key(header, key)
+        !! Return .true. if key is present in header, .false. otherwise.
+        !! HTTP headers are case insensitive, so values are converted to
+        !! lowercase before comparison.
+        type(header_type), intent(in) :: header(:)
+            !! Header to search for key
+        character(*), intent(in) :: key
+            !! Key to search in header
+        integer :: n
+
+        header_has_key = .false.
+        do n = 1, size(header)
+            if (to_lower(key) == to_lower(header(n)%key)) then
+                header_has_key = .true.
+                return
+            end if
+        end do
+
+    end function header_has_key
+
 end module http_header

src/http/http_request.f90

@@ -1,5 +1,7 @@
 module http_request
-    use http_header, only : header_type
+    use http_header, only: header_type
+    use stdlib_string_type, only: string_type, to_lower, operator(==), char
+
     implicit none
 
     private
@@ -20,5 +22,4 @@ module http_request
         integer :: method
         type(header_type), allocatable :: header(:)
     end type request_type
-
 end module http_request

src/http/http_response.f90

@@ -1,6 +1,6 @@
 module http_response
     use, intrinsic :: iso_fortran_env, only: int64
-    use http_header, only : header_type
+    use http_header, only: header_type, get_header_value
     use stdlib_string_type, only: string_type, to_lower, operator(==), char
 
     implicit none
@@ -16,49 +16,18 @@ module http_response
         logical :: ok = .true.
         type(header_type), allocatable :: header(:)
     contains
-        procedure :: append_header
         procedure :: header_value
     end type response_type
 
 contains
-    subroutine append_header(this, key, value)
-        class(response_type), intent(inout) :: this
-        character(*), intent(in) :: key, value
-        type(header_type), allocatable :: temp(:)
-        integer :: n
-
-        if (allocated(this%header)) then
-            n = size(this%header)
-            allocate(temp(n+1))
-            temp(1:n) = this%header
-            temp(n+1) = header_type(key, value)
-            call move_alloc(temp, this%header)
-        else
-            allocate(this%header(1))
-            this%header(1) = header_type(key, value)
-        end if
-
-    end subroutine append_header
-
     ! The header_value function takes a key string as input and returns the corresponding 
-    ! value as a string from a response_type object's header array, which contains key-value 
-    ! pairs representing HTTP headers. If the key is not found, the function returns an empty
-    !  string. If there are duplicates of the key in the header array, the function returns 
-    ! the value associated with the first occurrence of the key.
+    ! value as a string from a response_type object's header array.
     pure function header_value(this, key) result(val)
         class(response_type), intent(in) :: this
         character(*), intent(in) :: key
         character(:), allocatable :: val
-        type(string_type) :: string_to_match
-        integer :: i
 
-        string_to_match = to_lower(string_type(key))
-
-        do i=1, size(this%header)
-            if(to_lower(string_type(this%header(i)%key)) == string_to_match) then
-                val = this%header(i)%value
-                return
-            end if
-        end do
+        val = get_header_value(this%header, key)
     end function header_value
+
 end module http_response

test/test_header.f90

@@ -0,0 +1,69 @@
+program test_header
+
+    use iso_fortran_env, only: stderr => error_unit
+    use http_header, only: get_header_value, header_has_key, header_type
+
+    implicit none
+    type(header_type), allocatable :: header(:)
+    logical :: ok = .true.
+    integer :: n
+
+    header = [ &
+        header_type('One', '1'), &
+        header_type('Two', '2') &
+    ]
+
+    if (.not. size(header) == 2) then
+        ok = .false.
+        write(stderr, '(a)') 'Failed: Header size is incorrect.'
+    end if
+
+    if (.not. header(1)%value == '1') then
+        ok = .false.
+        write(stderr, '(a)') 'Failed: First header value is incorrect.'
+    end if
+
+    if (.not. header(2)%value == '2') then
+        ok = .false.
+        write(stderr, '(a)') 'Failed: Second header value is incorrect.'
+    end if
+
+    header = [header, header_type('Three', '3')]
+
+    if (.not. size(header) == 3) then
+        ok = .false.
+        write(stderr, '(a)') 'Failed: Appending to header failed.'
+    end if
+
+    if (.not. header(3)%value == '3') then
+        ok = .false.
+        write(stderr, '(a)') 'Failed: Appended header value is incorrect.'
+    end if
+
+    do n = 1, size(header)
+        if (.not. get_header_value(header, header(n)%key) == header(n)%value) then
+            ok = .false.
+            write(stderr, '(a)') 'Failed: Appended header value is incorrect.'
+        end if
+    end do
+
+    do n = 1, size(header)
+        if (.not. header_has_key(header, header(n)%key)) then
+            ok = .false.
+            write(stderr, '(a)') 'Failed: Incorrect output from header_has_key.'
+        end if
+    end do
+
+    if (header_has_key(header, "Non-Existent")) then
+        ok = .false.
+        write(stderr, '(a)') 'Failed: Incorrect output from header_has_key for non-existent key.'
+    end if
+
+    if (.not. ok) then 
+        write(stderr, '(a)'), 'test_header: One or more tests failed.'
+        error stop 1
+    else
+        print '(a)', 'test_header: All tests passed.'
+    end if
+
+end program test_header