Skip to content

Commit 691ad82

Browse files
rajkumardongremilancurcic
rajkumardongre
and
milancurcic
authored
put_if_header_absent function (#29)
* put_if_header_absent function * migrate all header related procedure to http_header.f90 * Simplify http_header.f90 * Tests for header_type * Simplify put_if_header_exists; clean up imports * Add FORD-style dosctrings; order procedure definitions alphabetically --------- Co-authored-by: milancurcic <caomaco@gmail.com>
1 parent 478aa06 commit 691ad82

File tree

5 files changed

+172
-47
lines changed

5 files changed

+172
-47
lines changed

‎src/http/http_client.f90‎

Lines changed: 14 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ module http_client
1111
use stdlib_optval, only: optval
1212
use http_request, only: request_type
1313
use http_response, only: response_type
14-
use http_header, only : header_type
14+
use http_header, only: append_header, header_has_key, header_type
1515

1616
implicit none
1717

@@ -43,27 +43,32 @@ function new_request(url, method, header, json) result(response)
4343
type(request_type) :: request
4444
type(response_type) :: response
4545
type(client_type) :: client
46+
integer :: i
4647

4748
! setting request url
4849
request%url = url
4950

5051
! Set default HTTP method.
5152
request%method = optval(method, 1)
5253

53-
! Set default request headers.
54-
request%header = [header_type('user-agent', 'fortran-http/1.0.0')]
55-
if(present(header)) then
56-
request%header = [header, request%header]
54+
! Set request header
55+
if (present(header)) then
56+
request%header = header
57+
! Set default request headers.
58+
if (.not. header_has_key(header, 'user-agent')) then
59+
call append_header(request%header, 'user-agent', 'fortran-http/0.1.0')
60+
end if
61+
else
62+
request%header = [header_type('user-agent', 'fortran-http/0.1.0')]
5763
end if
58-
64+
5965
if(present(json)) then
6066
request%json = json
6167
request%header = [request%header, header_type('Content-Type', 'application/json')]
6268
end if
6369

64-
client = client_type(request=request)
65-
6670
! Populates the response
71+
client = client_type(request=request)
6772
response = client%client_get_response()
6873
end function new_request
6974

@@ -254,7 +259,7 @@ function client_header_callback(ptr, size, nmemb, client_data) bind(c)
254259
h_value = buf(i+2 : )
255260
h_value = h_value( : len(h_value)-2)
256261
if(len(h_value) > 0 .and. len(h_key) > 0) then
257-
call response%append_header(h_key, h_value)
262+
call append_header(response%header, h_key, h_value)
258263
! response%header = [response%header, header_type(h_key, h_value)]
259264
end if
260265
end if

‎src/http/http_header.f90‎

Lines changed: 82 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,90 @@
11
module http_header
2-
use iso_c_binding
2+
3+
!! This module provides a simple key value type to use for HTTP headers.
4+
!! It also provides procedures to inquire about the presence of a key and
5+
!! its value in a header array, as well as a procedure to append new
6+
!! headers to an existing array of headers.
7+
8+
use stdlib_ascii, only: to_lower
9+
310
implicit none
411
private
12+
513
public :: header_type
14+
public :: append_header
15+
public :: get_header_value
16+
public :: header_has_key
17+
618
type :: header_type
719
character(:), allocatable :: key, value
820
end type header_type
21+
22+
contains
23+
24+
subroutine append_header(header, key, value)
25+
!! Append a new header_type instance with key and value members to the
26+
!! header array.
27+
type(header_type), allocatable, intent(inout) :: header(:)
28+
!! Header array to append to
29+
character(*), intent(in) :: key
30+
!! Key member of header_type to append
31+
character(*), intent(in) :: value
32+
!! Value member of header_type to append
33+
type(header_type), allocatable :: temp(:)
34+
integer :: n
35+
36+
if (allocated(header)) then
37+
n = size(header)
38+
allocate(temp(n+1))
39+
temp(1:n) = header
40+
temp(n+1) = header_type(key, value)
41+
call move_alloc(temp, header)
42+
else
43+
allocate(header(1))
44+
header(1) = header_type(key, value)
45+
end if
46+
end subroutine append_header
47+
48+
pure function get_header_value(header, key) result(val)
49+
!! Return the value of a requested key in a header array. If the key is
50+
!! not found, the function returns an empty string (unallocated). If
51+
!! there are duplicates of the key in the header array, return the value
52+
!! of the first occurence of the key.
53+
type(header_type), intent(in) :: header(:)
54+
!! Header to search for key
55+
character(*), intent(in) :: key
56+
!! Key to search in header
57+
character(:), allocatable :: val
58+
!! Value of the key to return
59+
integer :: n
60+
61+
do n = 1, size(header)
62+
if (to_lower(key) == to_lower(header(n)%key)) then
63+
val = header(n)%value
64+
return
65+
end if
66+
end do
67+
68+
end function get_header_value
69+
70+
pure logical function header_has_key(header, key)
71+
!! Return .true. if key is present in header, .false. otherwise.
72+
!! HTTP headers are case insensitive, so values are converted to
73+
!! lowercase before comparison.
74+
type(header_type), intent(in) :: header(:)
75+
!! Header to search for key
76+
character(*), intent(in) :: key
77+
!! Key to search in header
78+
integer :: n
79+
80+
header_has_key = .false.
81+
do n = 1, size(header)
82+
if (to_lower(key) == to_lower(header(n)%key)) then
83+
header_has_key = .true.
84+
return
85+
end if
86+
end do
87+
88+
end function header_has_key
89+
990
end module http_header

‎src/http/http_request.f90‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
module http_request
2-
use http_header, only : header_type
2+
use http_header, only: header_type
3+
use stdlib_string_type, only: string_type, to_lower, operator(==), char
4+
35
implicit none
46

57
private
@@ -20,5 +22,4 @@ module http_request
2022
integer :: method
2123
type(header_type), allocatable :: header(:)
2224
end type request_type
23-
2425
end module http_request

‎src/http/http_response.f90‎

Lines changed: 4 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
module http_response
22
use, intrinsic :: iso_fortran_env, only: int64
3-
use http_header, only : header_type
3+
use http_header, only: header_type, get_header_value
44
use stdlib_string_type, only: string_type, to_lower, operator(==), char
55

66
implicit none
@@ -16,49 +16,18 @@ module http_response
1616
logical :: ok = .true.
1717
type(header_type), allocatable :: header(:)
1818
contains
19-
procedure :: append_header
2019
procedure :: header_value
2120
end type response_type
2221

2322
contains
24-
subroutine append_header(this, key, value)
25-
class(response_type), intent(inout) :: this
26-
character(*), intent(in) :: key, value
27-
type(header_type), allocatable :: temp(:)
28-
integer :: n
29-
30-
if (allocated(this%header)) then
31-
n = size(this%header)
32-
allocate(temp(n+1))
33-
temp(1:n) = this%header
34-
temp(n+1) = header_type(key, value)
35-
call move_alloc(temp, this%header)
36-
else
37-
allocate(this%header(1))
38-
this%header(1) = header_type(key, value)
39-
end if
40-
41-
end subroutine append_header
42-
4323
! The header_value function takes a key string as input and returns the corresponding
44-
! value as a string from a response_type object's header array, which contains key-value
45-
! pairs representing HTTP headers. If the key is not found, the function returns an empty
46-
! string. If there are duplicates of the key in the header array, the function returns
47-
! the value associated with the first occurrence of the key.
24+
! value as a string from a response_type object's header array.
4825
pure function header_value(this, key) result(val)
4926
class(response_type), intent(in) :: this
5027
character(*), intent(in) :: key
5128
character(:), allocatable :: val
52-
type(string_type) :: string_to_match
53-
integer :: i
5429

55-
string_to_match = to_lower(string_type(key))
56-
57-
do i=1, size(this%header)
58-
if(to_lower(string_type(this%header(i)%key)) == string_to_match) then
59-
val = this%header(i)%value
60-
return
61-
end if
62-
end do
30+
val = get_header_value(this%header, key)
6331
end function header_value
32+
6433
end module http_response

‎test/test_header.f90‎

Lines changed: 69 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,69 @@
1+
program test_header
2+
3+
use iso_fortran_env, only: stderr => error_unit
4+
use http_header, only: get_header_value, header_has_key, header_type
5+
6+
implicit none
7+
type(header_type), allocatable :: header(:)
8+
logical :: ok = .true.
9+
integer :: n
10+
11+
header = [ &
12+
header_type('One', '1'), &
13+
header_type('Two', '2') &
14+
]
15+
16+
if (.not. size(header) == 2) then
17+
ok = .false.
18+
write(stderr, '(a)') 'Failed: Header size is incorrect.'
19+
end if
20+
21+
if (.not. header(1)%value == '1') then
22+
ok = .false.
23+
write(stderr, '(a)') 'Failed: First header value is incorrect.'
24+
end if
25+
26+
if (.not. header(2)%value == '2') then
27+
ok = .false.
28+
write(stderr, '(a)') 'Failed: Second header value is incorrect.'
29+
end if
30+
31+
header = [header, header_type('Three', '3')]
32+
33+
if (.not. size(header) == 3) then
34+
ok = .false.
35+
write(stderr, '(a)') 'Failed: Appending to header failed.'
36+
end if
37+
38+
if (.not. header(3)%value == '3') then
39+
ok = .false.
40+
write(stderr, '(a)') 'Failed: Appended header value is incorrect.'
41+
end if
42+
43+
do n = 1, size(header)
44+
if (.not. get_header_value(header, header(n)%key) == header(n)%value) then
45+
ok = .false.
46+
write(stderr, '(a)') 'Failed: Appended header value is incorrect.'
47+
end if
48+
end do
49+
50+
do n = 1, size(header)
51+
if (.not. header_has_key(header, header(n)%key)) then
52+
ok = .false.
53+
write(stderr, '(a)') 'Failed: Incorrect output from header_has_key.'
54+
end if
55+
end do
56+
57+
if (header_has_key(header, "Non-Existent")) then
58+
ok = .false.
59+
write(stderr, '(a)') 'Failed: Incorrect output from header_has_key for non-existent key.'
60+
end if
61+
62+
if (.not. ok) then
63+
write(stderr, '(a)'), 'test_header: One or more tests failed.'
64+
error stop 1
65+
else
66+
print '(a)', 'test_header: All tests passed.'
67+
end if
68+
69+
end program test_header

0 commit comments

Comments
 (0)