Print the JSON structure to a string or a file.
str
argument is non-optional is because of a
bug in v4.9 of the gfortran compiler.Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
class(json_core), | intent(inout) | :: | json | |||
type(json_value), | intent(in), | pointer | :: | p | ||
integer(kind=IK), | intent(in) | :: | iunit |
file unit to write to (the file is assumed to be open) |
||
character(kind=CK, len=:), | intent(inout), | allocatable | :: | str |
if |
|
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 |
|
logical(kind=LK), | intent(in), | optional | :: | is_compressed_vector |
if True, this is an element from an array being printed on one line [default is False] |
|
integer(kind=IK), | intent(inout) | :: | iloc |
current index in |
recursive subroutine json_value_print(json,p,iunit,str,indent,& need_comma,colon,is_array_element,& is_compressed_vector,iloc) implicit none class(json_core),intent(inout) :: json type(json_value),pointer,intent(in) :: p integer(IK),intent(in) :: iunit !! file unit to write to (the !! file is assumed to be open) 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]]. integer(IK),intent(inout) :: iloc !! current index in `str`. should be set to 0 initially. !! [only used when `str` is used.] logical(LK),intent(in),optional :: is_compressed_vector !! if True, this is an element !! from an array being printed !! on one line [default is False] character(kind=CK,len=max_numeric_str_len) :: tmp !! for value to string conversions character(kind=CK,len=:),allocatable :: s_indent !! the string of spaces for !! indenting (see `tab` and `spaces`) character(kind=CK,len=:),allocatable :: s !! the string appended to `str` character(kind=CK,len=:),allocatable :: buf !! temporary buffer for extending `str` type(json_value),pointer :: element !! for getting children integer(IK) :: tab !! number of `tabs` for indenting integer(IK) :: spaces !! number of spaces for indenting integer(IK) :: i,j !! counter integer(IK) :: count !! number of children logical(LK) :: print_comma !! if the comma will be printed after the value logical(LK) :: write_file !! if we are writing to a file logical(LK) :: write_string !! if we are writing to a string logical(LK) :: is_array !! if this is an element in an array logical(LK) :: is_vector !! if all elements of a vector !! are scalars of the same type character(kind=CK,len=:),allocatable :: str_escaped !! escaped version of !! `name` or `str_value` if (.not. json%exception_thrown) then if (.not. associated(p)) then ! note: a null() pointer will trigger this error. ! However, if the pointer is undefined, then this will ! crash (if this wasn't here it would crash below when ! we try to access the contents) call json%throw_exception('Error in json_value_print: '//& 'the pointer is not associated') return end if if (present(is_compressed_vector)) then is_vector = is_compressed_vector else is_vector = .false. end if !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) .and. .not. json%no_whitespace) then tab = indent else tab = 0 end if !convert to number of spaces: spaces = tab*json%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_indent = CK_'' else s_indent = repeat(space, spaces) end if select case (p%var_type) case (json_object) count = json%count(p) if (count==0) then !special case for empty object s = s_indent//start_object//end_object call write_it( comma=print_comma ) else s = s_indent//start_object call write_it() !if an object is in an array, there is an extra tab: if (is_array) then if ( .not. json%no_whitespace) tab = tab+1 spaces = tab*json%spaces_per_tab end if nullify(element) element => p%children do i = 1, count if (.not. associated(element)) then call json%throw_exception('Error in json_value_print: '//& 'Malformed JSON linked list') return end if ! print the name if (allocated(element%name)) then call escape_string(element%name,str_escaped,json%escape_solidus) if (json%no_whitespace) then !compact printing - no extra space s = repeat(space, spaces)//quotation_mark//& str_escaped//quotation_mark//colon_char call write_it(advance=.false.) else s = repeat(space, spaces)//quotation_mark//& str_escaped//quotation_mark//colon_char//space call write_it(advance=.false.) end if else call json%throw_exception('Error in json_value_print:'//& ' element%name not allocated') nullify(element) return end if ! recursive print of the element call json%json_value_print(element, iunit=iunit, indent=tab + 1_IK, & need_comma=i<count, colon=.true., str=str, iloc=iloc) if (json%exception_thrown) return ! 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) then s = repeat(space, max(0_IK,spaces-json%spaces_per_tab))//end_object else s = s_indent//end_object end if call write_it( comma=print_comma ) nullify(element) end if case (json_array) count = json%count(p) if (count==0) then ! special case for empty array s = s_indent//start_array//end_array call write_it( comma=print_comma ) else ! if every child is the same type & a scalar: is_vector = json%is_vector(p) if (json%failed()) return s = s_indent//start_array call write_it( advance=(.not. is_vector) ) !if an array is in an array, there is an extra tab: if (is_array) then if ( .not. json%no_whitespace) tab = tab+1 spaces = tab*json%spaces_per_tab end if nullify(element) element => p%children do i = 1, count if (.not. associated(element)) then call json%throw_exception('Error in json_value_print: '//& 'Malformed JSON linked list') return end if ! recursive print of the element if (is_vector) then call json%json_value_print(element, iunit=iunit, indent=0_IK,& need_comma=i<count, is_array_element=.false., & str=str, iloc=iloc,& is_compressed_vector = .true.) else call json%json_value_print(element, iunit=iunit, indent=tab,& need_comma=i<count, is_array_element=.true., & str=str, iloc=iloc) end if if (json%exception_thrown) return ! get the next child the list: element => element%next end do !indent the closing array character: if (is_vector) then s = end_array call write_it( comma=print_comma ) else s = repeat(space, max(0_IK,spaces-json%spaces_per_tab))//end_array call write_it( comma=print_comma ) end if nullify(element) end if case (json_null) s = s_indent//null_str call write_it( comma=print_comma, & advance=(.not. is_vector),& space_after_comma=is_vector ) case (json_string) if (allocated(p%str_value)) then ! have to escape the string for printing: call escape_string(p%str_value,str_escaped,json%escape_solidus) s = s_indent//quotation_mark//str_escaped//quotation_mark call write_it( comma=print_comma, & advance=(.not. is_vector),& space_after_comma=is_vector ) else call json%throw_exception('Error in json_value_print:'//& ' p%value_string not allocated') return end if case (json_logical) if (p%log_value) then s = s_indent//true_str call write_it( comma=print_comma, & advance=(.not. is_vector),& space_after_comma=is_vector ) else s = s_indent//false_str call write_it( comma=print_comma, & advance=(.not. is_vector),& space_after_comma=is_vector ) end if case (json_integer) call integer_to_string(p%int_value,int_fmt,tmp) s = s_indent//trim(tmp) call write_it( comma=print_comma, & advance=(.not. is_vector),& space_after_comma=is_vector ) case (json_real) if (allocated(json%real_fmt)) then call real_to_string(p%dbl_value,json%real_fmt,json%compact_real,json%non_normals_to_null,tmp) else !use the default format (user has not called initialize() or specified one): call real_to_string(p%dbl_value,default_real_fmt,json%compact_real,json%non_normals_to_null,tmp) end if s = s_indent//trim(tmp) call write_it( comma=print_comma, & advance=(.not. is_vector),& space_after_comma=is_vector ) case default call integer_to_string(p%var_type,int_fmt,tmp) call json%throw_exception('Error in json_value_print: '//& 'unknown data type: '//trim(tmp)) end select end if contains subroutine write_it(advance,comma,space_after_comma) !! write the string `s` to the file (or the output string) implicit none 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),intent(in),optional :: space_after_comma !! print a space after the comma logical(LK) :: add_comma !! if a delimiter is to be added after string logical(LK) :: add_line_break !! if a line break is to be added after string logical(LK) :: add_space !! if a space is to be added after the comma integer(IK) :: n !! length of actual string `s` appended to `str` integer(IK) :: room_left !! number of characters left in `str` integer(IK) :: n_chunks_to_add !! number of chunks to add to `str` for appending `s` if (present(comma)) then add_comma = comma else add_comma = .false. !default is not to add comma end if if (json%no_whitespace) then add_space = .false. else if (present(space_after_comma)) then add_space = space_after_comma else add_space = .false. !default is not to add space end if end if if (present(advance)) then if (json%no_whitespace) then ! overrides input value: add_line_break = .false. else add_line_break = advance end if else add_line_break = .not. json%no_whitespace ! default is to advance if ! we are printing whitespace end if ! string to print: if (add_comma) then if (add_space) then s = s // delimiter // space else s = s // delimiter end if end if if (write_file) then if (add_line_break) then write(iunit,fmt='(A)') s else write(iunit,fmt='(A)',advance='NO') s end if else !write string if (add_line_break) s = s // newline n = len(s) room_left = len(str)-iloc if (room_left < n) then ! need to add another chunk to fit this string: n_chunks_to_add = max(1_IK, ceiling( real(len(s)-room_left,RK) / real(chunk_size,RK), IK ) ) allocate(character(kind=CK, len=len(str)+print_str_chunk_size*n_chunks_to_add)::buf) buf(1:len(str)) = str do j = len(str)+1, len(buf) buf(j:j) = space enddo call move_alloc(buf, str) end if ! append s to str: str(iloc+1:iloc+n) = s iloc = iloc + n end if end subroutine write_it end subroutine json_value_print