Skip to content

Commit 1bf1923

Browse files
jacobwilliamsjacobwilliams
committed
added get path routine.
Fixes #223
1 parent 044baf7 commit 1bf1923

File tree

2 files changed

+204
-0
lines changed

2 files changed

+204
-0
lines changed

‎src/json_parameters.F90

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -108,6 +108,10 @@ module json_parameters
108108
!! 6 = sign + leading 0 + decimal + 'E' + exponent sign + 1 extra
109109
character(kind=CDK,len=*),parameter :: int_fmt = '(ss,I0)' !! minimum width format for integers
110110

111+
integer(IK),parameter :: max_integer_str_len = 256 !! maximum string length of an integer.
112+
!! This is totally arbitrary (any way
113+
!! to get the compiler to tell us this?)
114+
111115
integer(IK),parameter :: chunk_size = 100_IK !! for allocatable strings: allocate chunks of this size
112116
integer(IK),parameter :: unit2str = -1_IK !! unit number to cause stuff to be
113117
!! output to strings rather than files.

‎src/json_value_module.F90

Lines changed: 200 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -510,6 +510,11 @@ module json_value_module
510510
procedure :: json_value_insert_after
511511
procedure :: json_value_insert_after_child_by_index
512512

513+
!>
514+
! get the path to a JSON variable in a structure:
515+
generic,public :: get_path => MAYBEWRAP(json_get_path)
516+
procedure :: MAYBEWRAP(json_get_path)
517+
513518
procedure,public :: remove => json_value_remove !! Remove a [[json_value]] from a linked-list structure.
514519
procedure,public :: check_for_errors => json_check_for_errors !! check for error and get error message
515520
procedure,public :: clear_exceptions => json_clear_exceptions !! clear exceptions
@@ -4031,6 +4036,201 @@ subroutine wrap_json_get_by_path(json, me, path, p, found)
40314036
end subroutine wrap_json_get_by_path
40324037
!*****************************************************************************************
40334038

4039+
!*****************************************************************************************
4040+
!>
4041+
! Returns the path to a JSON object that is part
4042+
! of a linked list structure.
4043+
!
4044+
! The path returned would be suitable for input to
4045+
! [[json_get_by_path]] and related routines.
4046+
!
4047+
!@note If an error occurs (which in this case means a malformed
4048+
! JSON structure) then an exception will be thrown, unless
4049+
! `found` is present, which will be set to `false`. `path`
4050+
! will be a blank string.
4051+
4052+
subroutine json_get_path(json, p, path, found, use_alt_array_tokens, path_sep)
4053+
4054+
implicit none
4055+
4056+
class(json_core),intent(inout) :: json
4057+
type(json_value),pointer,intent(in) :: p !! a JSON linked list object
4058+
character(kind=CK,len=:),allocatable,intent(out) :: path !! path to the variable
4059+
logical(LK),intent(out),optional :: found !! true if there were no problems
4060+
logical(LK),intent(in),optional :: use_alt_array_tokens !! if true, then '()' are used for array elements
4061+
!! otherwise, '[]' are used [default]
4062+
character(kind=CK,len=1),intent(in),optional :: path_sep !! character to use for path separator
4063+
!! (default is '.')
4064+
4065+
type(json_value),pointer :: tmp !! for traversing the structure
4066+
type(json_value),pointer :: element !! for traversing the structure
4067+
integer(IK) :: var_type !! JSON variable type flag
4068+
character(kind=CK,len=:),allocatable :: name !! variable name
4069+
character(kind=CK,len=:),allocatable :: parent_name !! variable's parent name
4070+
character(kind=CK,len=max_integer_str_len) :: istr !! for integer to string conversion (array indices)
4071+
integer(IK) :: i !! counter
4072+
integer(IK) :: n_children !! number of children for parent
4073+
logical(LK) :: use_brackets !! to use '[]' characters for arrays
4074+
logical(LK) :: parent_is_root !! if the parent is the root
4075+
4076+
!initialize:
4077+
path = ''
4078+
4079+
!optional input:
4080+
if (present(use_alt_array_tokens)) then
4081+
use_brackets = .not. use_alt_array_tokens
4082+
else
4083+
use_brackets = .true.
4084+
end if
4085+
4086+
if (associated(p)) then
4087+
4088+
!traverse the structure via parents up to the root
4089+
tmp => p
4090+
do
4091+
4092+
if (.not. associated(tmp)) exit !finished
4093+
4094+
!get info about the current variable:
4095+
call json%info(tmp,name=name)
4096+
4097+
! if tmp a child of an object, or an element of an array
4098+
if (associated(tmp%parent)) then
4099+
4100+
!get info about the parent:
4101+
call json%info(tmp%parent,var_type=var_type,&
4102+
n_children=n_children,name=parent_name)
4103+
4104+
select case (var_type)
4105+
case (json_array)
4106+
4107+
!get array index of this element:
4108+
element => tmp%parent%children
4109+
do i = 1, n_children
4110+
if (.not. associated(element)) then
4111+
call json%throw_exception('Error in json_get_path: '//&
4112+
'malformed JSON structure. ')
4113+
exit
4114+
end if
4115+
if (associated(element,tmp)) then
4116+
exit
4117+
else
4118+
element => element%next
4119+
end if
4120+
if (i==n_children) then ! it wasn't found (should never happen)
4121+
call json%throw_exception('Error in json_get_path: '//&
4122+
'malformed JSON structure. ')
4123+
exit
4124+
end if
4125+
end do
4126+
call integer_to_string(i,int_fmt,istr)
4127+
if (use_brackets) then
4128+
call add_to_path(parent_name//start_array//&
4129+
trim(adjustl(istr))//end_array,path_sep)
4130+
else
4131+
call add_to_path(parent_name//start_array_alt//&
4132+
trim(adjustl(istr))//end_array_alt,path_sep)
4133+
end if
4134+
tmp => tmp%parent ! already added parent name
4135+
4136+
case (json_object)
4137+
4138+
!process parent on the next pass
4139+
call add_to_path(name,path_sep)
4140+
4141+
case default
4142+
4143+
call json%throw_exception('Error in json_get_path: '//&
4144+
'malformed JSON structure. '//&
4145+
'A variable that is not an object '//&
4146+
'or array should not have a child.')
4147+
exit
4148+
4149+
end select
4150+
4151+
else
4152+
!the last one:
4153+
call add_to_path(name,path_sep)
4154+
end if
4155+
4156+
if (associated(tmp%parent)) then
4157+
!check if the parent is the root:
4158+
parent_is_root = (.not. associated(tmp%parent%parent))
4159+
if (parent_is_root) exit
4160+
end if
4161+
4162+
!go to parent:
4163+
tmp => tmp%parent
4164+
4165+
end do
4166+
4167+
else
4168+
call json%throw_exception('Error in json_get_path: '//&
4169+
'input pointer is not associated')
4170+
end if
4171+
4172+
!for errors, return blank string:
4173+
if (json%exception_thrown) path = ''
4174+
4175+
!optional output:
4176+
if (present(found)) then
4177+
if (json%exception_thrown) then
4178+
found = .false.
4179+
call json%clear_exceptions()
4180+
else
4181+
found = .true.
4182+
end if
4183+
end if
4184+
4185+
contains
4186+
4187+
subroutine add_to_path(str,dot)
4188+
!! prepend the string to the path
4189+
implicit none
4190+
character(kind=CK,len=*),intent(in) :: str !! string to prepend to `path`
4191+
character(kind=CK,len=1),intent(in),optional :: dot !! path separator (default is '.')
4192+
if (path=='') then
4193+
path = str
4194+
else
4195+
if (present(dot)) then
4196+
path = str//dot//path
4197+
else
4198+
path = str//child//path
4199+
end if
4200+
end if
4201+
end subroutine add_to_path
4202+
4203+
end subroutine json_get_path
4204+
!*****************************************************************************************
4205+
4206+
!*****************************************************************************************
4207+
!>
4208+
! Wrapper for [[json_get_path]] where "path" and "path_sep" are kind=CDK.
4209+
4210+
subroutine wrap_json_get_path(json, p, path, found, use_alt_array_tokens, path_sep)
4211+
4212+
implicit none
4213+
4214+
class(json_core),intent(inout) :: json
4215+
type(json_value),pointer,intent(in) :: p !! a JSON linked list object
4216+
character(kind=CDK,len=:),allocatable,intent(out) :: path !! path to the variable
4217+
logical(LK),intent(out),optional :: found !! true if there were no problems
4218+
logical(LK),intent(in),optional :: use_alt_array_tokens !! if true, then '()' are used for array elements
4219+
!! otherwise, '[]' are used [default]
4220+
character(kind=CDK,len=1),intent(in),optional :: path_sep !! character to use for path separator
4221+
!! (default is '.')
4222+
4223+
character(kind=CK,len=:),allocatable :: ck_path !! path to the variable
4224+
4225+
! call the main routine:
4226+
call json_get_path(json,p,ck_path,found,use_alt_array_tokens,path_sep)
4227+
4228+
! from unicode:
4229+
path = ck_path
4230+
4231+
end subroutine wrap_json_get_path
4232+
!*****************************************************************************************
4233+
40344234
!*****************************************************************************************
40354235
!>
40364236
! Convert a string into an integer.

0 commit comments

Comments
 (0)