json_value_print Subroutine

Subroutines

Source Code


All Procedures

add_variables_to_input annotate_invalid_json compact_real_string default_comp_ucs4 default_join_ucs4 destroy_json_data escape_string get_current_line_from_file_sequential get_current_line_from_file_stream initialize_json_file integer_to_string json_add json_check_for_errors json_clear_exceptions json_count json_create_array json_create_double json_create_integer json_create_logical json_create_null json_create_object json_create_string json_destroy json_failed json_file json_file_destroy json_file_get_double json_file_get_double_vec json_file_get_integer json_file_get_integer_vec json_file_get_logical json_file_get_logical_vec json_file_get_object json_file_get_root json_file_get_string json_file_get_string_vec json_file_load json_file_load_from_string json_file_move_pointer json_file_print_1 json_file_print_2 json_file_print_to_console json_file_print_to_string json_file_update_integer json_file_update_logical json_file_update_real json_file_update_string json_file_update_string_name_ascii json_file_update_string_val_ascii json_file_variable_info json_get json_get_array json_get_array_with_path json_get_by_path json_get_child json_get_double json_get_double_vec json_get_double_vec_with_path json_get_double_with_path json_get_integer json_get_integer_vec json_get_integer_vec_with_path json_get_integer_with_path json_get_logical json_get_logical_vec json_get_logical_vec_with_path json_get_logical_with_path json_get_string json_get_string_vec json_get_string_vec_with_path json_get_string_with_path json_info json_initialize json_parse json_parse_file json_parse_string json_print json_print_1 json_print_2 json_print_error_message json_print_to_string json_remove json_remove_if_present json_throw_exception json_traverse json_update json_update_double json_update_integer json_update_logical json_update_string json_update_string_name_ascii json_update_string_val_ascii json_value_add_double json_value_add_double_vec json_value_add_integer json_value_add_integer_vec json_value_add_logical json_value_add_logical_vec json_value_add_member json_value_add_string json_value_add_string_name_ascii json_value_add_string_val_ascii json_value_add_string_vec json_value_add_string_vec_name_ascii json_value_add_string_vec_val_ascii json_value_create json_value_create_array json_value_create_double json_value_create_integer json_value_create_logical json_value_create_null json_value_create_object json_value_create_string json_value_destroy json_value_get_by_index json_value_get_by_name_chars json_value_print json_value_remove json_value_remove_if_present json_value_to_string parse_array parse_for_chars parse_number parse_object parse_string parse_value pop_char push_char read_file real_to_string rename string_to_double string_to_integer test_1 test_10 test_11 test_12 test_13 test_14 test_2 test_3 test_4 test_5 test_6 test_7 test_8 test_9 throw_exception to_array to_double to_integer to_logical to_null to_object to_string to_uni to_uni_vec to_unicode ucs4_comp_default ucs4_join_default valid_json_hex wrap_json_file_get_double wrap_json_file_get_double_vec wrap_json_file_get_integer wrap_json_file_get_integer_vec wrap_json_file_get_logical wrap_json_file_get_logical_vec wrap_json_file_get_object wrap_json_file_get_string wrap_json_file_get_string_vec wrap_json_file_load_from_string wrap_json_file_update_integer wrap_json_file_update_logical wrap_json_file_update_real wrap_json_file_update_string wrap_json_file_variable_info wrap_json_get_array_with_path wrap_json_get_by_path wrap_json_get_double_vec_with_path wrap_json_get_double_with_path wrap_json_get_integer_vec_with_path wrap_json_get_integer_with_path wrap_json_get_logical_vec_with_path wrap_json_get_logical_with_path wrap_json_get_string_vec_with_path wrap_json_get_string_with_path wrap_json_parse_string wrap_json_throw_exception wrap_json_update_double wrap_json_update_integer wrap_json_update_logical wrap_json_update_string wrap_json_value_add_double wrap_json_value_add_double_vec wrap_json_value_add_integer wrap_json_value_add_integer_vec wrap_json_value_add_logical wrap_json_value_add_logical_vec wrap_json_value_add_string wrap_json_value_add_string_vec wrap_json_value_create_array wrap_json_value_create_double wrap_json_value_create_integer wrap_json_value_create_logical wrap_json_value_create_null wrap_json_value_create_object wrap_json_value_create_string wrap_json_value_get_by_name_chars wrap_json_value_remove_if_present

private recursive subroutine json_value_print(me, iunit, str, indent, need_comma, colon, is_array_element)

Arguments

Type IntentOptional AttributesName
type(json_value), intent(in), pointer:: me
integer(kind=IK), intent(in) :: iunit

file unit to write to (6=console)

character(kind=CK,len=:), intent(inout), allocatable:: str

if iunit==unit2str (-1) then the structure is printed to this string rather than a file. This mode is used by json_value_to_string.

integer(kind=IK), intent(in), optional :: indent

indention level

logical(kind=LK), intent(in), optional :: need_comma

if it needs a comma after it

logical(kind=LK), intent(in), optional :: colon

if the colon was just written

logical(kind=LK), intent(in), optional :: is_array_element

if this is an array element

Description

Print the JSON structure to a string or a file.

Notes

  • This is an internal routine called by the wrapper routines json_print and json_value_to_string.
  • The reason the str argument is non-optional is because of a bug in v4.9 of the gfortran compiler.

Variables

TypeVisibility AttributesNameInitial
character(kind=CK,len=max_numeric_str_len), public :: tmp
character(kind=CK,len=:), public, allocatable:: s
type(json_value), public, pointer:: element
integer(kind=IK), public :: tab
integer(kind=IK), public :: i
integer(kind=IK), public :: count
integer(kind=IK), public :: spaces
logical(kind=LK), public :: print_comma
logical(kind=LK), public :: write_file
logical(kind=LK), public :: write_string
logical(kind=LK), public :: is_array

Subroutines

subroutine write_it(s, advance, comma)

Arguments

Type IntentOptional AttributesName
character(kind=CK,len=*), intent(in) :: s
logical(kind=LK), intent(in), optional :: advance
logical(kind=LK), intent(in), optional :: comma

Source Code

    recursive subroutine json_value_print(me,iunit,str,indent,need_comma,colon,is_array_element)

    implicit none

    type(json_value),pointer,intent(in)  :: me
    integer(IK),intent(in)               :: iunit             !! file unit to write to (6=console)
    integer(IK),intent(in),optional      :: indent            !! indention level
    logical(LK),intent(in),optional      :: is_array_element  !! if this is an array element
    logical(LK),intent(in),optional      :: need_comma        !! if it needs a comma after it
    logical(LK),intent(in),optional      :: colon             !! if the colon was just written
    character(kind=CK,len=:),intent(inout),allocatable :: str
                                                      !! if iunit==unit2str (-1) then the structure is
                                                      !! printed to this string rather than
                                                      !! a file. This mode is used by
                                                      !! [[json_value_to_string]].

    character(kind=CK,len=max_numeric_str_len) :: tmp !for val to string conversions
    character(kind=CK,len=:),allocatable :: s
    type(json_value),pointer :: element
    integer(IK) :: tab, i, count, spaces
    logical(LK) :: print_comma
    logical(LK) :: write_file, write_string
    logical(LK) :: is_array

    if (.not. exception_thrown) then

        !whether to write a string or a file (one or the other):
        write_string = (iunit==unit2str)
        write_file = .not. write_string

        !if the comma will be printed after the value
        ! [comma not printed for the last elements]
        if (present(need_comma)) then
            print_comma = need_comma
        else
            print_comma = .false.
        end if

        !number of "tabs" to indent:
        if (present(indent)) then
            tab = indent
        else
            tab = 0
        end if
        !convert to number of spaces:
        spaces = tab*spaces_per_tab

        !if this is an element in an array:
        if (present(is_array_element)) then
            is_array = is_array_element
        else
            is_array = .false.
        end if

        !if the colon was the last thing written
        if (present(colon)) then
            s = ''
        else
            s = repeat(space, spaces)
        end if

        select case (me%var_type)

        case (json_object)

            count = json_count(me)

            if (count==0) then    !special case for empty object

                call write_it( s//start_object//end_object, comma=print_comma )

            else

                call write_it( s//start_object )

                !if an object is in an array, there is an extra tab:
                if (is_array) then
                     tab = tab+1
                     spaces = tab*spaces_per_tab
                end if

                nullify(element)
                element => me%children
                do i = 1, count

                    ! print the name
                    if (allocated(element%name)) then
                        call write_it(repeat(space, spaces)//quotation_mark//&
                                      element%name//quotation_mark//colon_char//space,&
                                      advance=.false.)
                    else
                        call throw_exception('Error in json_value_print:'//&
                                             ' element%name not allocated')
                        nullify(element)
                        return
                    end if

                    ! recursive print of the element
                    call json_value_print(element, iunit=iunit, indent=tab + 1, &
                                          need_comma=i<count, colon=.true., str=str)

                    ! get the next child the list:
                    element => element%next

                end do

                ! [one fewer tab if it isn't an array element]
                if (.not. is_array) s = repeat(space, max(0,spaces-spaces_per_tab))
                call write_it( s//end_object, comma=print_comma )
                nullify(element)

            end if

        case (json_array)

            count = json_count(me)

            if (count==0) then    !special case for empty array

                call write_it( s//start_array//end_array, comma=print_comma )

            else

                call write_it( start_array )

                nullify(element)
                element => me%children
                do i = 1, count

                    ! recursive print of the element
                    call json_value_print(element, iunit=iunit, indent=tab,&
                                          need_comma=i<count, is_array_element=.true., str=str)

                    ! get the next child the list:
                    element => element%next

                end do

                !indent the closing array character:
                call write_it( repeat(space, max(0,spaces-spaces_per_tab))//end_array,&
                               comma=print_comma )
                nullify(element)

            end if

        case (json_null)

            call write_it( s//null_str, comma=print_comma )

        case (json_string)

            if (allocated(me%str_value)) then
                call write_it( s//quotation_mark// &
                               trim(me%str_value)//quotation_mark, comma=print_comma )
            else
                call throw_exception('Error in json_value_print:'//&
                                     ' me%value_string not allocated')
                return
            end if

        case (json_logical)

            if (me%log_value) then
                call write_it( s//true_str, comma=print_comma )
            else
                call write_it( s//false_str, comma=print_comma )
            end if

        case (json_integer)

            call integer_to_string(me%int_value,tmp)

            call write_it( s//trim(tmp), comma=print_comma )

        case (json_double)

            call real_to_string(me%dbl_value,tmp)

            call write_it( s//trim(tmp), comma=print_comma )

        case default

            call throw_exception('Error in json_value_print: unknown data type')

        end select

        !cleanup:
        if (allocated(s)) deallocate(s)

    end if

    contains

    !
    ! write the string to the file (or the output string)
    !
        subroutine write_it(s,advance,comma)

        implicit none

        character(kind=CK,len=*),intent(in) :: s        !string to print
        logical(LK),intent(in),optional     :: advance  !to add line break or not
        logical(LK),intent(in),optional     :: comma    !print comma after the string

        logical(LK) :: add_line_break, add_comma
        character(kind=CK,len=:),allocatable :: s2

        if (present(comma)) then
            add_comma = comma
        else
            add_comma = .false. !default is not to add comma
        end if

        if (present(advance)) then
            add_line_break = advance
        else
            add_line_break = .true. !default is to advance
        end if

        !string to print:
        s2 = s
        if (add_comma) s2 = s2 // delimiter

        if (write_file) then

            if (add_line_break) then
                write(iunit,fmt='(A)') s2
            else
                write(iunit,fmt='(A)',advance='NO') s2
            end if

        else    !write string

            str = str // s2
            if (add_line_break) str = str // newline

        end if

        !cleanup:
        if (allocated(s2)) deallocate(s2)

        end subroutine write_it

    end subroutine json_value_print

© 2015 JSON-Fortran was written by Jacob Williams.
Documentation generated by FORD.