Returns the path to a JSON object that is part of a linked list structure.
The path returned would be suitable for input to json_get_by_path and related routines.
If an error occurs (which in this case means a malformed
JSON structure) then an exception will be thrown, unless
found is present, which will be set to false. path
will be a blank string.
If json%path_mode/=1, then the use_alt_array_tokens
and path_sep inputs are ignored if present.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| class(json_core), | intent(inout) | :: | json | |||
| type(json_value), | intent(in), | pointer | :: | p | a JSON linked list object |
|
| character(kind=CK,len=:), | intent(out), | allocatable | :: | path | path to the variable |
|
| logical(kind=LK), | intent(out), | optional | :: | found | true if there were no problems |
|
| logical(kind=LK), | intent(in), | optional | :: | use_alt_array_tokens | if true, then '()' are used for array elements otherwise, '[]' are used [default] |
|
| character(kind=CK,len=1), | intent(in), | optional | :: | path_sep | character to use for path separator
(otherwise use |
subroutine json_get_path(json, p, path, found, use_alt_array_tokens, path_sep)
implicit none
class(json_core),intent(inout) :: json
type(json_value),pointer,intent(in) :: p !! a JSON linked list object
character(kind=CK,len=:),allocatable,intent(out) :: path !! path to the variable
logical(LK),intent(out),optional :: found !! true if there were no problems
logical(LK),intent(in),optional :: use_alt_array_tokens !! if true, then '()' are used for array elements
!! otherwise, '[]' are used [default]
character(kind=CK,len=1),intent(in),optional :: path_sep !! character to use for path separator
!! (otherwise use `json%path_separator`)
type(json_value),pointer :: tmp !! for traversing the structure
type(json_value),pointer :: element !! for traversing the structure
integer(IK) :: var_type !! JSON variable type flag
character(kind=CK,len=:),allocatable :: name !! variable name
character(kind=CK,len=:),allocatable :: parent_name !! variable's parent name
character(kind=CK,len=max_integer_str_len) :: istr !! for integer to string conversion (array indices)
integer(IK) :: i !! counter
integer(IK) :: n_children !! number of children for parent
logical(LK) :: use_brackets !! to use '[]' characters for arrays
logical(LK) :: parent_is_root !! if the parent is the root
!optional input:
if (present(use_alt_array_tokens)) then
use_brackets = .not. use_alt_array_tokens
else
use_brackets = .true.
end if
if (associated(p)) then
!traverse the structure via parents up to the root
tmp => p
do
if (.not. associated(tmp)) exit !finished
!get info about the current variable:
call json%info(tmp,name=name)
if (json%path_mode==2) then
name = encode_rfc6901(name)
end if
! if tmp a child of an object, or an element of an array
if (associated(tmp%parent)) then
!get info about the parent:
call json%info(tmp%parent,var_type=var_type,&
n_children=n_children,name=parent_name)
if (json%path_mode==2) then
parent_name = encode_rfc6901(parent_name)
end if
select case (var_type)
case (json_array)
!get array index of this element:
element => tmp%parent%children
do i = 1, n_children
if (.not. associated(element)) then
call json%throw_exception('Error in json_get_path: '//&
'malformed JSON structure. ')
exit
end if
if (associated(element,tmp)) then
exit
else
element => element%next
end if
if (i==n_children) then ! it wasn't found (should never happen)
call json%throw_exception('Error in json_get_path: '//&
'malformed JSON structure. ')
exit
end if
end do
select case(json%path_mode)
case(2)
call integer_to_string(i-1,int_fmt,istr) ! 0-based index
call add_to_path(parent_name//slash//trim(adjustl(istr)))
case(1)
call integer_to_string(i,int_fmt,istr)
if (use_brackets) then
call add_to_path(parent_name//start_array//&
trim(adjustl(istr))//end_array,path_sep)
else
call add_to_path(parent_name//start_array_alt//&
trim(adjustl(istr))//end_array_alt,path_sep)
end if
end select
tmp => tmp%parent ! already added parent name
case (json_object)
!process parent on the next pass
call add_to_path(name,path_sep)
case default
call json%throw_exception('Error in json_get_path: '//&
'malformed JSON structure. '//&
'A variable that is not an object '//&
'or array should not have a child.')
exit
end select
else
!the last one:
call add_to_path(name,path_sep)
end if
if (associated(tmp%parent)) then
!check if the parent is the root:
parent_is_root = (.not. associated(tmp%parent%parent))
if (parent_is_root) exit
end if
!go to parent:
tmp => tmp%parent
end do
else
call json%throw_exception('Error in json_get_path: '//&
'input pointer is not associated')
end if
!for errors, return blank string:
if (json%exception_thrown .or. .not. allocated(path)) then
path = CK_''
else
if (json%path_mode==2) then
! add the root slash:
path = slash//path
end if
end if
!optional output:
if (present(found)) then
if (json%exception_thrown) then
found = .false.
call json%clear_exceptions()
else
found = .true.
end if
end if
contains
subroutine add_to_path(str,path_sep)
!! prepend the string to the path
implicit none
character(kind=CK,len=*),intent(in) :: str !! string to prepend to `path`
character(kind=CK,len=1),intent(in),optional :: path_sep
!! path separator (default is '.').
!! (ignored if `json%path_mode/=1`)
select case (json%path_mode)
case(2)
! in this case, the options are ignored
if (.not. allocated(path)) then
path = str
else
path = str//slash//path
end if
case(1)
! default path format
if (.not. allocated(path)) then
path = str
else
if (present(path_sep)) then
! use user specified:
path = str//path_sep//path
else
! use the default:
path = str//json%path_separator//path
end if
end if
end select
end subroutine add_to_path
end subroutine json_get_path