response_type Derived Type

type, public :: response_type

Representing an HTTP response.


Contents

Source Code


Components

Type Visibility Attributes Name Initial
character(len=:), public, allocatable :: url

The URL of the request

character(len=:), public, allocatable :: content

The content of the response.

character(len=:), public, allocatable :: method

The HTTP method of the request.

character(len=:), public, allocatable :: err_msg

The Error message if the response was not successful.

integer, public :: status_code = 0

The HTTP status code of the response

integer(kind=int64), public :: content_length = 0

length of the response content.

logical, public :: ok = .true.

true if the response was successful else false.

type(pair_type), public, allocatable :: header(:)

An Array of response headers.


Type-Bound Procedures

procedure, public, :: header_value

  • private pure function header_value(this, name) result(val)

    This function is used to retrieve the value of a response header. It takes the response header name as input and returns the corresponding header value.

    Arguments

    Type IntentOptional Attributes Name
    class(response_type), intent(in) :: this

    An object representing the HTTP response.

    character(len=*), intent(in) :: name

    This refers to the name of the header for which we want to retrieve the value.

    Return Value character(len=:), allocatable

    This denotes the value of the specified header name.

Source Code

    type :: response_type
        !!> Representing an **HTTP `response`**.
        character(len=:), allocatable :: url
            !! The URL of the request
        character(len=:), allocatable :: content
            !! The content of the response.
        character(len=:), allocatable :: method
            !! The HTTP method of the request.
        character(len=:), allocatable :: err_msg
            !! The Error message if the response was not successful.
        integer :: status_code = 0
            !! The HTTP status code of the response
        integer(kind=int64) :: content_length = 0
            !! length of the response content.
        logical :: ok = .true.
            !! true if the response was successful else false.
        type(pair_type), allocatable :: header(:)
            !! An Array of response headers.
    contains
        procedure :: header_value
    end type response_type