Skip to content

Commit 0a422d2

Browse files
jacobwilliamsjacobwilliams
committed
enabled creating by path using the bracket notation.
some commenting updates. added unit tests.
1 parent 55d689e commit 0a422d2

File tree

2 files changed

+200
-44
lines changed

2 files changed

+200
-44
lines changed

‎src/json_value_module.F90‎

Lines changed: 179 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -704,6 +704,7 @@ module json_value_module
704704
procedure :: push_char
705705
procedure :: get_current_line_from_file_stream
706706
procedure :: get_current_line_from_file_sequential
707+
procedure :: convert
707708

708709
end type json_core
709710
!*********************************************************
@@ -5567,8 +5568,8 @@ end subroutine json_get_by_path
55675568
! By default, the leaf node and any empty array elements
55685569
! are created as `json_null` values.
55695570
!
5570-
! It only works for the default path mode. An error will be
5571-
! thrown if RFC 6901 mode is enabled.
5571+
! It only works for `path_mode=1` or `path_mode=3`.
5572+
! An error will be thrown for `path_mode=2` (RFC 6901).
55725573
!
55735574
!### See also
55745575
! * [[json_get_by_path]]
@@ -5601,25 +5602,24 @@ subroutine json_create_by_path(json,me,path,p,found,was_created)
56015602
create_it=.true.,&
56025603
was_created=was_created)
56035604
if (present(p)) p => tmp
5604-
case(2_IK)
5605-
! the problem here is there isn't really a way to disambiguate
5606-
! the array elements, so '/a/0' could be 'a(1)' or 'a.0'.
5607-
call json%throw_exception('Error in json_create_by_path: '//&
5608-
'Create by path not supported in RFC 6901 path mode.')
5609-
if (present(found)) then
5610-
call json%clear_exceptions()
5611-
found = .false.
5612-
end if
5613-
if (present(was_created)) was_created = .false.
5614-
!case(3_IK)
5615-
! call json%json_get_by_path_jsonpath_bracket(me,path,tmp,found,&
5616-
! create_it=.true.,&
5617-
! was_created=was_created)
5618-
! if (present(p)) p => tmp
5605+
case(3_IK)
5606+
call json%json_get_by_path_jsonpath_bracket(me,path,tmp,found,&
5607+
create_it=.true.,&
5608+
was_created=was_created)
5609+
if (present(p)) p => tmp
5610+
56195611
case default
5620-
call integer_to_string(json%path_mode,int_fmt,path_mode_str)
5621-
call json%throw_exception('Error in json_create_by_path: Unsupported path_mode: '//&
5622-
trim(path_mode_str))
5612+
5613+
if (json%path_mode==2_IK) then
5614+
! the problem here is there isn't really a way to disambiguate
5615+
! the array elements, so '/a/0' could be 'a(1)' or 'a.0'.
5616+
call json%throw_exception('Error in json_create_by_path: '//&
5617+
'Create by path not supported in RFC 6901 path mode.')
5618+
else
5619+
call integer_to_string(json%path_mode,int_fmt,path_mode_str)
5620+
call json%throw_exception('Error in json_create_by_path: Unsupported path_mode: '//&
5621+
trim(path_mode_str))
5622+
end if
56235623
if (present(found)) then
56245624
call json%clear_exceptions()
56255625
found = .false.
@@ -5669,6 +5669,7 @@ end subroutine wrap_json_create_by_path
56695669
! type(json_value),pointer :: dat,p
56705670
! logical :: found
56715671
! !...
5672+
! call json%initialize(path_mode=1) ! this is the default so not strictly necessary.
56725673
! call json%get(dat,'data(2).version',p,found)
56735674
!````
56745675
!
@@ -5688,14 +5689,22 @@ end subroutine wrap_json_create_by_path
56885689
! Or, the alternate [[json_get_by_path_rfc6901]] could be used.
56895690
!
56905691
!### See also
5691-
! * [[json_get_by_path_rfc6901]] - alternate version with different path convention.
5692+
! * [[json_get_by_path_rfc6901]]
5693+
! * [[json_get_by_path_jsonpath_bracket]]
5694+
!
5695+
!@note The syntax is inherited from FSON, and is basically a subset
5696+
! of JSONPath "dot-notation", with the addition allowance of () for
5697+
! array elements.
56925698
!
56935699
!@note JSON `null` values are used here for unknown variables when `create_it` is True.
56945700
! So, it is possible that an existing null variable can be converted to another
56955701
! type (object or array) if a child is specified in the path. Doing it this way
56965702
! to avoid having to use another type (say `json_unknown`) that would have to be
56975703
! converted to null once all the variables have been created (user would have
56985704
! had to do this).
5705+
!
5706+
!@warning See (**) in code. I think we need to protect for memory leaks when
5707+
! changing the type of a variable that already exists.
56995708

57005709
subroutine json_get_by_path_default(json,me,path,p,found,create_it,was_created)
57015710

@@ -5791,7 +5800,7 @@ subroutine json_get_by_path_default(json,me,path,p,found,create_it,was_created)
57915800
! What about the case: aaa.bbb(1)(3) ?
57925801
! Is that already handled?
57935802

5794-
if (p%var_type==json_null) then
5803+
if (p%var_type==json_null) then ! (**)
57955804
! if p was also created, then we need to
57965805
! convert it into an object here:
57975806
p%var_type = json_object
@@ -5840,7 +5849,7 @@ subroutine json_get_by_path_default(json,me,path,p,found,create_it,was_created)
58405849
call json%get_child(p, child_i, tmp, child_found)
58415850
if (.not. child_found) then
58425851

5843-
if (p%var_type==json_null) then
5852+
if (p%var_type==json_null) then ! (**)
58445853
! if p was also created, then we need to
58455854
! convert it into an array here:
58465855
p%var_type = json_array
@@ -5883,11 +5892,12 @@ subroutine json_get_by_path_default(json,me,path,p,found,create_it,was_created)
58835892
if (child_i < i) then
58845893
nullify(tmp)
58855894
if (create) then
5886-
if (p%var_type==json_null) then
5895+
if (p%var_type==json_null) then ! (**)
58875896
! if p was also created, then we need to
58885897
! convert it into an object here:
58895898
p%var_type = json_object
58905899
end if
5900+
58915901
! don't want to throw exceptions in this case
58925902
call json%get_child(p, path(child_i:i-1), tmp, child_found)
58935903
if (.not. child_found) then
@@ -5938,11 +5948,12 @@ subroutine json_get_by_path_default(json,me,path,p,found,create_it,was_created)
59385948
if (child_i <= length) then
59395949
nullify(tmp)
59405950
if (create) then
5941-
if (p%var_type==json_null) then
5951+
if (p%var_type==json_null) then ! (**)
59425952
! if p was also created, then we need to
59435953
! convert it into an object here:
59445954
p%var_type = json_object
59455955
end if
5956+
59465957
call json%get_child(p, path(child_i:i-1), tmp, child_found)
59475958
if (.not. child_found) then
59485959
! have to create this child
@@ -6010,14 +6021,17 @@ end subroutine json_get_by_path_default
60106021
!### Example
60116022
!
60126023
!````fortran
6024+
! type(json_core) :: json
60136025
! type(json_value),pointer :: dat,p
60146026
! logical :: found
60156027
! !...
6028+
! call json%initialize(path_mode=2)
60166029
! call json%get(dat,'/data/2/version',p,found)
60176030
!````
60186031
!
60196032
!### See also
6020-
! * [[json_get_by_path_default]] - alternate version with different path convention.
6033+
! * [[json_get_by_path_default]]
6034+
! * [[json_get_by_path_jsonpath_bracket]]
60216035
!
60226036
!### Reference
60236037
! * [JavaScript Object Notation (JSON) Pointer](https://tools.ietf.org/html/rfc6901)
@@ -6206,6 +6220,12 @@ end subroutine json_get_by_path_rfc6901
62066220
! using the "JSON Pointer" path specification defined by the
62076221
! JSONPath "bracket-notation".
62086222
!
6223+
! The first character `$` is optional, and signifies the root
6224+
! of the structure. If it is not present, then the first key
6225+
! is taken to be in the `me` object.
6226+
!
6227+
! Single or double quotes may be used
6228+
!
62096229
!### Example
62106230
!
62116231
!````fortran
@@ -6214,32 +6234,32 @@ end subroutine json_get_by_path_rfc6901
62146234
! logical :: found
62156235
! !...
62166236
! call json%initialize(path_mode=3)
6217-
62186237
! call json%get(dat,"$['store']['book'][1]['title']",p,found)
62196238
!````
62206239
!
6221-
! The first character `$` is optional, and signifies the root
6222-
! of the structure. If it is not present, then the first key
6223-
! is taken to be in the `me` object.
6224-
!
6225-
! Single or double quotes may be used
6226-
!
62276240
!### See also
6228-
! * [[json_get_by_path_default]] - subset of JSONPath "dot-notation"
6229-
! * [[json_get_by_path_rfc6901]] - RFC6901 "JSON pointer"
6241+
! * [[json_get_by_path_default]]
6242+
! * [[json_get_by_path_rfc6901]]
62306243
!
62316244
!### Reference
62326245
! * [JSONPath](http://goessner.net/articles/JsonPath/)
62336246
!
62346247
!@note Uses 1-based array indices (same as [[json_get_by_path_default]],
62356248
! but unlike [[json_get_by_path_rfc6901]] which uses 0-based indices).
62366249
!
6250+
!@note When `create_it=True`, if the variable already exists and is a type
6251+
! that is not compatible with the usage in the `path`, then it is
6252+
! destroyed and replaced with what is specified in the `path`. Note that
6253+
! this applies the all variables in the path as it is created. Currently,
6254+
! this behavior is different from [[json_get_by_path_default]].
6255+
!
6256+
!@note JSON `null` values are used here for unknown variables
6257+
! when `create_it` is True.
6258+
!
62376259
!@warning Note that if using single quotes, this routine cannot parse
62386260
! a key containing `']`. If using double quotes, this routine
62396261
! cannot parse a key containing `"]`. If the key contains both
62406262
! `']` and `"]`, there is no way to parse it using this routine.
6241-
!
6242-
!@warning The `create` logic hasn't been added yet !
62436263

62446264
subroutine json_get_by_path_jsonpath_bracket(json,me,path,p,found,create_it,was_created)
62456265

@@ -6278,7 +6298,6 @@ subroutine json_get_by_path_jsonpath_bracket(json,me,path,p,found,create_it,was_
62786298
integer(IK) :: ilen !! length of `path` string
62796299
logical(LK) :: double_quotes !! if the keys are enclosed in `"`,
62806300
!! rather than `'` tokens.
6281-
62826301
logical(LK) :: create !! if the object is to be created
62836302
logical(LK) :: created !! if `create` is true, then this will be
62846303
!! true if the leaf object had to be created
@@ -6319,6 +6338,7 @@ subroutine json_get_by_path_jsonpath_bracket(json,me,path,p,found,create_it,was_
63196338
do while (associated (p%parent))
63206339
p => p%parent
63216340
end do
6341+
if (create) created = .false. ! should always exist
63226342
end if
63236343

63246344
!keep trailing space or not:
@@ -6372,9 +6392,9 @@ subroutine json_get_by_path_jsonpath_bracket(json,me,path,p,found,create_it,was_
63726392
end if
63736393
if (iend>istart) then
63746394

6375-
! istart iend
6376-
! | |
6377-
! ['abcdefg']
6395+
!   istart iend
6396+
!   | |
6397+
! ['p']['abcdefg']
63786398

63796399
if (iend>istart+1) then
63806400
token = path(istart+1:iend-1)
@@ -6385,8 +6405,35 @@ subroutine json_get_by_path_jsonpath_bracket(json,me,path,p,found,create_it,was_
63856405
! the token here if necessary:
63866406
if (.not. json%trailing_spaces_significant) &
63876407
token = trim(token)
6388-
! have a token, see if it is valid:
6389-
call json%get_child(p,token,tmp,status_ok)
6408+
6409+
if (create) then
6410+
! have a token, create it if necessary
6411+
6412+
! we need to convert it into an object here
6413+
! (e.g., if p was also just created)
6414+
! and destroy its data to prevent a memory leak
6415+
call json%convert(p,json_object)
6416+
6417+
! don't want to throw exceptions in this case
6418+
call json%get_child(p,token,tmp,status_ok)
6419+
if (.not. status_ok) then
6420+
! have to create this child
6421+
! [make it a null since we don't
6422+
! know what it is yet]
6423+
call json_value_create(tmp)
6424+
call to_null(tmp,token)
6425+
call json%add(p,tmp)
6426+
status_ok = .true.
6427+
created = .true.
6428+
else
6429+
! it was already there.
6430+
created = .false.
6431+
end if
6432+
else
6433+
! have a token, see if it is valid:
6434+
call json%get_child(p,token,tmp,status_ok)
6435+
end if
6436+
63906437
if (status_ok) then
63916438
! it was found
63926439
p => tmp
@@ -6429,10 +6476,45 @@ subroutine json_get_by_path_jsonpath_bracket(json,me,path,p,found,create_it,was_
64296476
call string_to_integer(token,ival,status_ok)
64306477
if (status_ok) status_ok = ival>0 ! assuming 1-based array indices
64316478
end if
6479+
64326480
if (status_ok) then
6433-
! have a valid integer to use as an index, so
6481+
6482+
! have a valid integer to use as an index
64346483
! see if this element is really there:
64356484
call json%get_child(p,ival,tmp,status_ok)
6485+
6486+
if (create .and. .not. status_ok) then
6487+
6488+
! have to create it:
6489+
6490+
if (.not.(p%var_type==json_object .or. p%var_type==json_array)) then
6491+
! we need to convert it into an array here
6492+
! (e.g., if p was also just created)
6493+
! and destroy its data to prevent a memory leak
6494+
call json%convert(p,json_array)
6495+
end if
6496+
6497+
! have to create this element
6498+
! [make it a null]
6499+
! (and any missing ones before it)
6500+
do j = 1, ival
6501+
nullify(tmp)
6502+
call json%get_child(p, j, tmp, status_ok)
6503+
if (.not. status_ok) then
6504+
call json_value_create(tmp)
6505+
call to_null(tmp) ! array element doesn't need a name
6506+
call json%add(p,tmp)
6507+
if (j==ival) created = .true.
6508+
else
6509+
if (j==ival) created = .false.
6510+
end if
6511+
end do
6512+
status_ok = .true.
6513+
6514+
else
6515+
created = .false.
6516+
end if
6517+
64366518
if (status_ok) then
64376519
! found it
64386520
p => tmp
@@ -6494,13 +6576,66 @@ subroutine json_get_by_path_jsonpath_bracket(json,me,path,p,found,create_it,was_
64946576
if (present(found)) found = .true.
64956577
end if
64966578

6579+
! if it had to be created:
6580+
if (present(was_created)) was_created = created
6581+
64976582
else
64986583
if (present(found)) found = .false.
6584+
if (present(was_created)) was_created = .false.
64996585
end if
65006586

65016587
end subroutine json_get_by_path_jsonpath_bracket
65026588
!*****************************************************************************************
65036589

6590+
!*****************************************************************************************
6591+
!>
6592+
! Convert an existing JSON variable `p` to a different variable type.
6593+
! The existing variable (and its children) is destroyed. It is replaced
6594+
! in the structure by a new variable of type `var_type`
6595+
! (which can be a `json_null`, `json_object` or `json_array`).
6596+
!
6597+
!@note This is an internal routine used when creating variables by path.
6598+
6599+
subroutine convert(json,p,var_type)
6600+
6601+
implicit none
6602+
6603+
class(json_core),intent(inout) :: json
6604+
type(json_value),pointer :: p !! the variable to convert
6605+
integer(IK),intent(in) :: var_type !! the variable type to convert `p` to
6606+
6607+
type(json_value),pointer :: tmp !! temporary variable
6608+
character(kind=CK,len=:),allocatable :: name !! the name of a JSON variable
6609+
6610+
logical :: convert_it !! if `p` needs to be converted
6611+
6612+
convert_it = p%var_type /= var_type
6613+
6614+
if (convert_it) then
6615+
6616+
call json%info(p,name=name) ! get existing name
6617+
6618+
select case (var_type)
6619+
case(json_object)
6620+
call json%create_object(tmp,name)
6621+
case(json_array)
6622+
call json%create_array(tmp,name)
6623+
case(json_null)
6624+
call json%create_null(tmp,name)
6625+
case default
6626+
call json%throw_exception('Error in convert: invalid var_type value.')
6627+
return
6628+
end select
6629+
6630+
call json%replace(p,tmp,destroy=.true.)
6631+
p => tmp
6632+
nullify(tmp)
6633+
6634+
end if
6635+
6636+
end subroutine convert
6637+
!*****************************************************************************************
6638+
65046639
!*****************************************************************************************
65056640
!>
65066641
! Alternate version of [[json_get_by_path]] where "path" is kind=CDK.

0 commit comments

Comments
 (0)