Read a sample JSON file and retrieve some data from it
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(out) | :: | error_cnt |
subroutine test_1(error_cnt)
!! Read a sample JSON file and retrieve some data from it
implicit none
type(json_file) :: json !! the JSON structure read from the file
type(json_value),pointer :: p !! a pointer for low-level manipulations
type(json_core) :: core !! factory for manipulating `json_value` pointers
integer,intent(out) :: error_cnt
integer :: ival
character(kind=json_CK,len=:),allocatable :: cval
real(wp) :: rval
logical :: found
error_cnt = 0
call json%initialize()
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
write(error_unit,'(A)') ''
write(error_unit,'(A)') '================================='
write(error_unit,'(A)') ' TEST 1'
write(error_unit,'(A)') '================================='
write(error_unit,'(A)') ''
! parse the json file:
write(error_unit,'(A)') ''
write(error_unit,'(A)') 'parsing file '//dir//filename1
call json%load_file(filename = dir//filename1)
if (json%failed()) then !if there was an error reading the file
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
! print the parsed data to the console
write(error_unit,'(A)') ''
write(error_unit,'(A)') 'printing the file...'
call json%print_file()
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
! -------------------------
! print each variable:
call core%initialize()
call json%get(p) ! get root
namelist_style = .true.
write(error_unit,'(A)') ''
write(error_unit,'(A)') 'printing each variable [namelist style]'
write(error_unit,'(A)') ''
call core%initialize(unescape_strings=.false.)
call core%traverse(p,print_json_variable)
namelist_style = .false.
write(error_unit,'(A)') ''
write(error_unit,'(A)') 'printing each variable [JSON style]'
write(error_unit,'(A)') ''
call core%initialize(unescape_strings=.true.)
call core%traverse(p,print_json_variable)
! -------------------------
! extract data from the parsed value
write(error_unit,'(A)') ''
write(error_unit,'(A)') 'get some data from the file...'
write(error_unit,'(A)') ''
call json%get('version.svn', ival)
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
write(error_unit,'(A,I5)') 'version.svn = ',ival
end if
write(error_unit,'(A)') ''
call json%get('data(1).array(2)', cval)
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
write(error_unit,'(A)') 'data(1).array(2) = '//trim(cval)
end if
write(error_unit,'(A)') ''
call json%get('files(1)', cval)
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
write(error_unit,'(A)') 'files(1) = '//trim(cval)
end if
write(error_unit,'(A)') ''
call json%get('files(2)', cval)
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
write(error_unit,'(A)') 'files(2) = '//trim(cval)
end if
write(error_unit,'(A)') ''
call json%get('files(3)', cval)
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
write(error_unit,'(A)') 'files(3) = '//trim(cval)
end if
write(error_unit,'(A)') ''
call json%get('data(2).real', rval)
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
write(error_unit,'(A,E30.16)') 'data(2).real = ',rval
end if
write(error_unit,'(A)') ''
call json%get('files[4]', cval) !has hex characters
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
write(error_unit,'(A)') 'files[4] = '//trim(cval)
end if
write(error_unit,'(A)') ''
call json%get('files[5]', cval) !string with spaces and no escape characters
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
write(error_unit,'(A)') 'files[5] = '//trim(cval)
end if
!
! Test of values that aren't there:
! Note: when using the "found" output, the exceptions are cleared automatically.
!
write(error_unit,'(A)') ''
call json%get('files[10]', cval, found) !value that isn't there
if (.not. found) then
write(error_unit,'(A)') 'files[10] not in file.'
else
write(error_unit,'(1x,A)') 'files[10] = '//trim(cval)
error_cnt = error_cnt + 1
end if
write(error_unit,'(A)') ''
call json%get('version.blah', ival, found) !value that isn't there
if (.not. found) then
write(error_unit,'(A)') 'version.blah not in file.'
else
write(error_unit,'(A)') 'version.blah = ',ival
error_cnt = error_cnt + 1
end if
write(error_unit,'(A)') ''
write(error_unit,'(A)') ' Test removing data from the json structure:'
call json%get('files', p) !in the middle of a list
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
call core%initialize()
call core%remove(p)
if (core%failed()) then
call core%print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
end if
call json%get('data(1).array', p) !at the end of a list
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
call core%initialize()
call core%remove(p)
if (core%failed()) then
call core%print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
end if
call json%get('data(2).number', p) !at the beginning of a list
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
call core%initialize()
call core%remove(p)
if (core%failed()) then
call core%print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
end if
write(error_unit,'(A)') ''
write(error_unit,'(A)') 'printing the modified structure...'
call json%print_file()
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
write(error_unit,'(A)') ''
write(error_unit,'(A)') ' Test replacing data from the json structure:'
call json%get('data(1)', p)
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
else
call core%initialize()
call core%update(p,'name','Cuthbert',found)
if (core%failed()) then
call core%print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
end if
!call json%get('data(2)', p)
!call json%update(p,'real',[1.0_wp, 2.0_wp, 3.0_wp],found) !don't have one like this yet...
!use the json_file procedure to update a variable:
call json%update('version.svn',999,found)
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
write(error_unit,'(A)') ''
write(error_unit,'(A)') 'printing the modified structure...'
call json%print_file()
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
write(error_unit,'(A)') ''
write(error_unit,'(A)') 'printing the modified structure (compact mode)...'
call json%initialize(no_whitespace=.true.)
call json%print_file()
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
end if
! clean up
write(error_unit,'(A)') ''
write(error_unit,'(A)') 'destroy...'
call json%destroy()
if (json%failed()) then
call json%print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
end subroutine test_1