Skip to content

Commit 49bc5a5

Browse files
jacobwilliamsjacobwilliams
committed
added routine to create different var types using path.
other minor changes, still a WIP.
1 parent a2a2699 commit 49bc5a5

File tree

2 files changed

+172
-67
lines changed

2 files changed

+172
-67
lines changed

‎src/json_value_module.F90‎

Lines changed: 159 additions & 56 deletions
Original file line numberDiff line numberDiff line change
@@ -296,10 +296,13 @@ module json_value_module
296296
procedure,private :: json_update_string_val_ascii
297297
#endif
298298

299+
procedure,public :: add_with_path => json_add_scalar_with_path
300+
299301
!>
300302
! Create a [[json_value]] linked list using the
301-
! path to the variables
302-
generic,public :: create => MAYBEWRAP(json_create_by_path) ! this will create a null ...
303+
! path to the variables.
304+
! (This will create a `null` variable)
305+
generic,public :: create => MAYBEWRAP(json_create_by_path)
303306
procedure :: MAYBEWRAP(json_create_by_path)
304307

305308
!>
@@ -2726,25 +2729,83 @@ subroutine json_value_insert_after_child_by_index(json,p,idx,element)
27262729
end subroutine json_value_insert_after_child_by_index
27272730
!*****************************************************************************************
27282731

2729-
! ... to do .... add the full set of these ...
2732+
2733+
! !*****************************************************************************************
2734+
! !>
2735+
! ! Add a double value to a [[json_value]], given the path.
2736+
! !
2737+
! !@warning Using this routine to change the type of an existing object or array to
2738+
! ! a scalar may result in a memory leak. It should only be used
2739+
! ! to add a new variable (or set an existing one).
2740+
!
2741+
! subroutine json_add_double_with_path(json,me,path,value,found)
2742+
!
2743+
! implicit none
2744+
!
2745+
! class(json_core),intent(inout) :: json
2746+
! type(json_value),pointer :: me
2747+
! character(kind=CK,len=*),intent(in) :: path
2748+
! real(RK),intent(in) :: value
2749+
! logical(LK),intent(out),optional :: found
2750+
!
2751+
! type(json_value),pointer :: p
2752+
!
2753+
! if ( .not. json%exception_thrown ) then
2754+
!
2755+
! nullify(p)
2756+
!
2757+
! ! return a pointer to the path (possibly creating it)
2758+
! call json%create(me,path,p,found)
2759+
!
2760+
! if (.not. associated(p)) then
2761+
!
2762+
! call json%throw_exception('Error in json_add_double_with_path:'//&
2763+
! ' Unable to resolve path: '//trim(path))
2764+
! if (present(found)) then
2765+
! found = .false.
2766+
! call json%clear_exceptions()
2767+
! end if
2768+
!
2769+
! else
2770+
! ! set the value (may need to change type,
2771+
! ! since if it had to be created, it is
2772+
! ! a null variable)
2773+
! if (p%var_type==json_double) then
2774+
! p%dbl_value = value
2775+
! else
2776+
! call to_double(p,value)
2777+
! end if
2778+
!
2779+
! end if
2780+
!
2781+
! else
2782+
! if ( present(found) ) found = .false.
2783+
! end if
2784+
!
2785+
! end subroutine json_add_double_with_path
2786+
! !*****************************************************************************************
27302787

27312788
!*****************************************************************************************
27322789
!>
2733-
! Add a double value to a [[json_value]], given the path.
2790+
! Add a scalar value to a [[json_value]], given the path.
27342791
!
27352792
!@warning Using this routine to change the type of an existing object or array to
27362793
! a scalar may result in a memory leak. It should only be used
27372794
! to add a new variable (or set an existing one).
2795+
!
2796+
!@note This is different from the other routines, since we are using
2797+
! an unlimited polymorphic input instead of having separate routines.
27382798

2739-
subroutine json_add_double_with_path(json,me,path,value,found)
2799+
subroutine json_add_scalar_with_path(json,me,path,value,found,was_created)
27402800

27412801
implicit none
27422802

27432803
class(json_core),intent(inout) :: json
27442804
type(json_value),pointer :: me
27452805
character(kind=CK,len=*),intent(in) :: path
2746-
real(RK),intent(in) :: value
2806+
class(*),intent(in) :: value
27472807
logical(LK),intent(out),optional :: found
2808+
logical(LK),intent(out),optional :: was_created !! if the variable had to be created
27482809

27492810
type(json_value),pointer :: p
27502811

@@ -2753,39 +2814,77 @@ subroutine json_add_double_with_path(json,me,path,value,found)
27532814
nullify(p)
27542815

27552816
! return a pointer to the path (possibly creating it)
2756-
call json%create(me,path,p,found)
2817+
call json%create(me,path,p,found,was_created)
27572818

27582819
if (.not. associated(p)) then
27592820

2760-
call json%throw_exception('Error in json_add_double_with_path:'//&
2821+
call json%throw_exception('Error in json_add_scalar_with_path:'//&
27612822
' Unable to resolve path: '//trim(path))
27622823
if (present(found)) then
27632824
found = .false.
27642825
call json%clear_exceptions()
27652826
end if
27662827

27672828
else
2829+
27682830
! set the value (may need to change type,
27692831
! since if it had to be created, it is
27702832
! a null variable)
2771-
if (p%var_type==json_double) then
2772-
p%dbl_value = value
2773-
else
2774-
call to_double(p,value)
2775-
end if
2833+
select type (value)
2834+
type is (real(RK))
2835+
if (p%var_type==json_double) then
2836+
p%dbl_value = value
2837+
else
2838+
call to_double(p,value)
2839+
end if
2840+
type is (integer(IK))
2841+
if (p%var_type==json_integer) then
2842+
p%int_value = value
2843+
else
2844+
call to_integer(p,value)
2845+
end if
2846+
type is (character(kind=CK,len=*))
2847+
if (p%var_type==json_string) then
2848+
p%str_value = value
2849+
else
2850+
call to_string(p,value)
2851+
end if
2852+
#if defined __GFORTRAN__ && defined USE_UCS4
2853+
type is (character(kind=CDK,len=*))
2854+
! only if using unicode
2855+
if (p%var_type==json_string) then
2856+
p%str_value = to_unicode(value)
2857+
else
2858+
call to_string(p,to_unicode(value))
2859+
end if
2860+
#endif
2861+
type is (logical(kind=LK))
2862+
if (p%var_type==json_logical) then
2863+
p%log_value = value
2864+
else
2865+
call to_logical(p,value)
2866+
end if
2867+
class default
2868+
call json%throw_exception('Error in json_add_scalar_with_path:'//&
2869+
' Invalid input type')
2870+
if (present(found)) then
2871+
found = .false.
2872+
call json%clear_exceptions()
2873+
end if
2874+
end select
27762875

27772876
end if
27782877

27792878
else
2780-
if ( present(found) ) found = .false.
2879+
if ( present(found) ) found = .false.
2880+
if ( present(was_created) ) was_created = .false.
27812881
end if
27822882

2783-
end subroutine json_add_double_with_path
2883+
end subroutine json_add_scalar_with_path
27842884
!*****************************************************************************************
27852885

27862886

27872887

2788-
27892888
!*****************************************************************************************
27902889
!> author: Jacob Williams
27912890
! date: 1/19/2014
@@ -4064,27 +4163,37 @@ end subroutine json_get_by_path
40644163
!### See also
40654164
! * [[json_get_by_path]]
40664165

4067-
subroutine json_create_by_path(json, me, path, p, found)
4166+
subroutine json_create_by_path(json,me,path,p,found,was_created)
40684167

40694168
implicit none
40704169

40714170
class(json_core),intent(inout) :: json
4072-
type(json_value),pointer,intent(in) :: me !! a JSON linked list
4073-
character(kind=CK,len=*),intent(in) :: path !! path to the variable
4074-
type(json_value),pointer,intent(out) :: p !! pointer to the variable
4075-
!! specify by `path`
4076-
logical(LK),intent(out),optional :: found !! true if it was found
4077-
!! ...TODO found should indicate if the variable was already there.
4078-
!! another logical output should indicate success.
4171+
type(json_value),pointer,intent(in) :: me !! a JSON linked list
4172+
character(kind=CK,len=*),intent(in) :: path !! path to the variable
4173+
type(json_value),pointer,intent(out),optional :: p !! pointer to the variable
4174+
!! specify by `path`
4175+
logical(LK),intent(out),optional :: found !! true if there were no errors
4176+
!! (variable found or created)
4177+
logical(LK),intent(out),optional :: was_created !! true if it was actually created
4178+
!! (as opposed to already being there)
40794179

4080-
! note: it can only be 1 or 2 (which was checked in initialize)
4180+
type(json_value),pointer :: tmp
4181+
4182+
if (present(p)) nullify(p)
4183+
4184+
! note: path_mode can only be 1 or 2 (which was checked in initialize)
40814185
select case (json%path_mode)
40824186
case(1_IK)
4083-
call json%json_get_by_path_default(me, path, p, found, create_it=.true.)
4187+
call json%json_get_by_path_default(me,path,tmp,found,&
4188+
create_it=.true.,&
4189+
was_created=was_created)
4190+
if (present(p)) p => tmp
40844191
case(2_IK)
40854192
! the problem here is there isn't really a way to disambiguate
40864193
! the array elements, so '/a/0' could be 'a(1)' or 'a.0'.
4087-
call json%throw_exception('Create by path not suppored in RFC 6901 path mode.')
4194+
call json%throw_exception('Create by path not supported in RFC 6901 path mode.')
4195+
if (present(found)) found = .false.
4196+
if (present(was_created)) was_created = .false.
40884197
end select
40894198

40904199
end subroutine json_create_by_path
@@ -4094,7 +4203,7 @@ end subroutine json_create_by_path
40944203
!>
40954204
! Alternate version of [[json_create_by_path]] where "path" is kind=CDK.
40964205

4097-
subroutine wrap_json_create_by_path(json, me, path, p, found)
4206+
subroutine wrap_json_create_by_path(json,me,path,p,found,was_created)
40984207

40994208
implicit none
41004209

@@ -4103,8 +4212,9 @@ subroutine wrap_json_create_by_path(json, me, path, p, found)
41034212
character(kind=CDK,len=*),intent(in) :: path
41044213
type(json_value),pointer,intent(out) :: p
41054214
logical(LK),intent(out),optional :: found
4215+
logical(LK),intent(out),optional :: was_created
41064216

4107-
call json%get(me, to_unicode(path), p, found)
4217+
call json%create(me,to_unicode(path),p,found,was_created)
41084218

41094219
end subroutine wrap_json_create_by_path
41104220
!*****************************************************************************************
@@ -4145,21 +4255,25 @@ end subroutine wrap_json_create_by_path
41454255
! converted to null once all the variables have been created (user would have
41464256
! had to do this).
41474257

4148-
subroutine json_get_by_path_default(json, me, path, p, found, create_it)
4258+
subroutine json_get_by_path_default(json,me,path,p,found,create_it,was_created)
41494259

41504260
implicit none
41514261

41524262
class(json_core),intent(inout) :: json
4153-
type(json_value),pointer,intent(in) :: me !! a JSON linked list
4154-
character(kind=CK,len=*),intent(in) :: path !! path to the variable
4155-
type(json_value),pointer,intent(out) :: p !! pointer to the variable
4156-
!! specify by `path`
4157-
logical(LK),intent(out),optional :: found !! true if it was found
4158-
logical(LK),intent(in),optional :: create_it !! if a variable is not present
4159-
!! in the path, then it is created.
4160-
!! the leaf node is returned as
4161-
!! a `null` json type and can be
4162-
!! changed by the caller.
4263+
type(json_value),pointer,intent(in) :: me !! a JSON linked list
4264+
character(kind=CK,len=*),intent(in) :: path !! path to the variable
4265+
type(json_value),pointer,intent(out) :: p !! pointer to the variable
4266+
!! specify by `path`
4267+
logical(LK),intent(out),optional :: found !! true if it was found
4268+
logical(LK),intent(in),optional :: create_it !! if a variable is not present
4269+
!! in the path, then it is created.
4270+
!! the leaf node is returned as
4271+
!! a `null` json type and can be
4272+
!! changed by the caller.
4273+
logical(LK),intent(out),optional :: was_created !! if `create_it` is true, this
4274+
!! will be true if the variable
4275+
!! was actually created. Otherwise
4276+
!! it will be false.
41634277

41644278
integer(IK) :: i !! counter of characters in `path`
41654279
integer(IK) :: length !! significant length of `path`
@@ -4228,14 +4342,13 @@ subroutine json_get_by_path_default(json, me, path, p, found, create_it)
42284342
nullify(tmp)
42294343
if (create) then
42304344

4231-
!
42324345
! Example:
42334346
! 'aaa.bbb(1)'
42344347
! -> and aaa is a null, need to make it an object
42354348
!
42364349
! What about the case: aaa.bbb(1)(3) ?
42374350
! Is that already handled?
4238-
!
4351+
42394352
if (p%var_type==json_null) then
42404353
! if p was also created, then we need to
42414354
! convert it into an object here:
@@ -4251,7 +4364,6 @@ subroutine json_get_by_path_default(json, me, path, p, found, create_it)
42514364
call to_array(tmp,path(child_i:i-1))
42524365
call json%add(p,tmp)
42534366
created = .true.
4254-
!write(*,*) 'creating: '//path(child_i:i-1)
42554367
else
42564368
created = .false.
42574369
end if
@@ -4336,22 +4448,14 @@ subroutine json_get_by_path_default(json, me, path, p, found, create_it)
43364448
p%var_type = json_object
43374449
end if
43384450
! don't want to throw exceptions in this case
4339-
!write(*,*) 'calling get_child...'
43404451
call json%get_child(p, path(child_i:i-1), tmp, child_found)
4341-
!if (child_found) then
4342-
! write(*,*) path(child_i:i-1)//' found'
4343-
!else
4344-
! write(*,*) path(child_i:i-1)//' not found'
4345-
!end if
4346-
43474452
if (.not. child_found) then
43484453
! have to create this child
43494454
! [make it an object]
43504455
call json_value_create(tmp)
43514456
call to_object(tmp,path(child_i:i-1))
43524457
call json%add(p,tmp)
43534458
created = .true.
4354-
!write(*,*) 'creating: '//path(child_i:i-1)
43554459
else
43564460
created = .false.
43574461
end if
@@ -4398,26 +4502,21 @@ subroutine json_get_by_path_default(json, me, path, p, found, create_it)
43984502
! convert it into an object here:
43994503
p%var_type = json_object
44004504
end if
4401-
!write(*,*) 'grab the last child: '//path(child_i:i-1)
44024505
call json%get_child(p, path(child_i:i-1), tmp, child_found)
44034506
if (.not. child_found) then
4404-
!write(*,*) 'not found.'
4405-
!write(*,*) 'creating: '//path(child_i:i-1)
44064507
! have to create this child
44074508
! (make it a null since it is the leaf)
44084509
call json_value_create(tmp)
44094510
call to_null(tmp,path(child_i:i-1))
44104511
call json%add(p,tmp)
44114512
created = .true.
44124513
else
4413-
!write(*,*) 'found.'
44144514
created = .false.
44154515
end if
44164516
else
44174517
! call the normal way
44184518
call json%get_child(p, path(child_i:i-1), tmp)
44194519
end if
4420-
!if (.not. associated(tmp)) write(*,*) '!!! tmp not associated !!!'
44214520
p => tmp
44224521
else
44234522
! we already have p
@@ -4442,8 +4541,12 @@ subroutine json_get_by_path_default(json, me, path, p, found, create_it)
44424541

44434542
end if
44444543

4544+
! if it had to be created:
4545+
if (present(was_created)) was_created = created
4546+
44454547
else
44464548
if (present(found)) found = .false.
4549+
if (present(was_created)) was_created = .false.
44474550
end if
44484551

44494552
end subroutine json_get_by_path_default

0 commit comments

Comments
 (0)