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.
http://goessner.net/articles/JsonPath/ (path_mode=3)
does not specify whether or not the keys should be escaped (this routine
assumes not, as does http://jsonpath.com).
Also, we are using Fortran-style 1-based array indices,
not 0-based, to agree with the assumption in path_mode=1
| 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]
(only used if |
|
| 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]
!! (only used if `path_mode=1`)
character(kind=CK,len=1),intent(in),optional :: path_sep !! character to use for path separator
!! (otherwise use `json%path_separator`)
!! (only used if `path_mode=1`)
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)
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
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
character(kind=CK,len=1) :: array_start !! for `path_mode=1`, the character to start arrays
character(kind=CK,len=1) :: array_end !! for `path_mode=1`, the character to end arrays
logical :: consecutive_arrays !! check for array of array case
integer(IK) :: parents_parent_var_type !! `var_type` for parent's parent
!optional input:
if (present(use_alt_array_tokens)) then
use_brackets = .not. use_alt_array_tokens
else
use_brackets = .true.
end if
if (json%path_mode==1_IK) then
if (use_brackets) then
array_start = start_array
array_end = end_array
else
array_start = start_array_alt
array_end = end_array_alt
end if
end if
! initialize:
consecutive_arrays = .false.
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_IK) 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_IK) then
parent_name = encode_rfc6901(parent_name)
end if
if (associated(tmp%parent%parent)) then
call json%info(tmp%parent%parent,var_type=parents_parent_var_type)
consecutive_arrays = parents_parent_var_type == json_array .and. &
var_type == json_array
else
consecutive_arrays = .false.
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. ',found)
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. ',found)
exit
end if
end do
select case(json%path_mode)
case(3_IK)
! JSONPath "bracket-notation"
! example: `$['key'][1]`
! [note: this uses 1-based indices]
call integer_to_string(i,int_fmt,istr)
if (consecutive_arrays) then
call add_to_path(start_array//trim(adjustl(istr))//end_array,CK_'')
else
call add_to_path(start_array//single_quote//parent_name//&
single_quote//end_array//&
start_array//trim(adjustl(istr))//end_array,CK_'')
end if
case(2_IK)
! rfc6901
! Example: '/key/0'
call integer_to_string(i-1_IK,int_fmt,istr) ! 0-based index
if (consecutive_arrays) then
call add_to_path(trim(adjustl(istr)))
else
call add_to_path(parent_name//slash//trim(adjustl(istr)))
end if
case(1_IK)
! default
! Example: `key[1]`
call integer_to_string(i,int_fmt,istr)
if (consecutive_arrays) then
call add_to_path(array_start//trim(adjustl(istr))//array_end,path_sep)
else
call add_to_path(parent_name//array_start//&
trim(adjustl(istr))//array_end,path_sep)
end if
end select
if (.not. consecutive_arrays) tmp => tmp%parent ! already added parent name
case (json_object)
if (.not. consecutive_arrays) then
! idea is not to print the array name if
! it was already printed with the array
!process parent on the next pass
select case(json%path_mode)
case(3_IK)
call add_to_path(start_array//single_quote//name//&
single_quote//end_array,CK_'')
case default
call add_to_path(name,path_sep)
end select
end if
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.',found)
exit
end select
else
!the last one:
select case(json%path_mode)
case(3_IK)
call add_to_path(start_array//single_quote//name//&
single_quote//end_array,CK_'')
case default
call add_to_path(name,path_sep)
end select
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',found)
end if
!for errors, return blank string:
if (json%exception_thrown .or. .not. allocated(path)) then
path = CK_''
else
select case (json%path_mode)
case(3_IK)
! add the outer level object identifier:
path = root//path
case(2_IK)
! add the root slash:
path = slash//path
end select
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(3_IK)
! in this case, the options are ignored
if (.not. allocated(path)) then
path = str
else
path = str//path
end if
case(2_IK)
! in this case, the options are ignored
if (.not. allocated(path)) then
path = str
else
path = str//slash//path
end if
case(1_IK)
! default path format
if (.not. allocated(path)) then
path = str
else
! shouldn't add the path_sep for cases like x[1][2]
! [if current is an array element, and the previous was
! also an array element] so check for that here:
if (.not. ( str(len(str):len(str))==array_end .and. &
path(1:1)==array_start )) then
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
else
path = str//path
end if
end if
end select
end subroutine add_to_path
end subroutine json_get_path