! Copyright (c) 2012 Joseph A. Levin
!
! Permission is hereby granted, free of charge, to any person obtaining a copy of this
! software and associated documentation files (the "Software"), to deal in the Software
! without restriction, including without limitation the rights to use, copy, modify, merge,
! publish, distribute, sublicense, and/or sell copies of the Software, and to permit
! persons to whom the Software is furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in all copies or
! substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
! INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
! PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
! LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT
! OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
! DEALINGS IN THE SOFTWARE.
! FSON MODULE
!
! File: nc_diag_fson.f95
! Author: Joseph A. Levin
!
! Created on March 6, 2012, 7:48 PM
!
module nc_diag_fson
use ncdf_value_m, ncdf_print => ncdf_value_print, ncdf_destroy => ncdf_value_destroy
use ncdf_string_m
use ncdf_path_m, ncdf_get => ncdf_path_get
implicit none
private
public :: ncdf_parse, ncdf_value, ncdf_get, ncdf_print, ncdf_destroy
! FILE IOSTAT CODES
integer, parameter :: end_of_file = -1
integer, parameter :: end_of_record = -2
! PARSING STATES
integer, parameter :: STATE_LOOKING_FOR_VALUE = 1
integer, parameter :: STATE_IN_OBJECT = 2
integer, parameter :: STATE_IN_PAIR_NAME = 3
integer, parameter :: STATE_IN_PAIR_VALUE = 4
! POP/PUSH CHARACTER
integer :: pushed_index = 0
character (len = 10) :: pushed_char
contains
!
! FSON PARSE
!
function ncdf_parse(file, unit, str) result(p)
type(ncdf_value), pointer :: p
integer, optional, intent(inout) :: unit
character(len = *), optional, intent(in) :: file
character(len = *), optional, intent(in) :: str
character(len=:),allocatable :: strBuffer
logical :: unit_available
integer :: u
! init the pointer to null
nullify(p)
! select the file unit to use
if (present(unit) .and. present(file)) then
u = unit
elseif (present(file)) then
! find the first available unit
unit_available = .false.
u = 20
do while (.not.unit_available)
inquire(unit = u, exist = unit_available)
u = u + 1
end do
elseif (present(str)) then
strBuffer = str
u = 0
else
print *, "ERROR: Need a file or a string"
call exit (1)
end if
! open the file
if (present(file)) then
open (unit = u, file = file, status = "old", action = "read", form = "formatted", position = "rewind")
end if
! create the value and associate the pointer
p => ncdf_value_create()
! parse as a value
call ncdf_parse_value(unit = u, value = p, str = strBuffer)
! close the file
if( .not. present(unit)) then
close (u)
end if
if(allocated(strBuffer)) deallocate(strBuffer)
end function ncdf_parse
!
! PARSE_VALUE
!
recursive subroutine ncdf_parse_value(unit, str, value)
integer, intent(inout) :: unit
character(*), intent(inout) :: str
type(ncdf_value), pointer :: value
logical :: eof
character :: c
! pop the next non whitespace character off the file
c = ncdf_pop_char(unit, str, eof = eof, skip_ws = .true.)
if (eof) then
return
else
select case (c)
case ("{")
! start object
value % value_type = TYPE_OBJECT
call ncdf_parse_object(unit, str, value)
case ("[")
! start array
value % value_type = TYPE_ARRAY
call ncdf_parse_array(unit, str, value)
case ("]")
! end an empty array
call ncdf_push_char(c)
nullify(value)
case ('"')
! string
value % value_type = TYPE_STRING
value % value_string => ncdf_parse_string(unit, str)
case ("t")
!true
value % value_type = TYPE_LOGICAL
call ncdf_parse_for_chars(unit, str, "rue")
value % value_logical = .true.
case ("f")
!false
value % value_type = TYPE_LOGICAL
value % value_logical = .false.
call ncdf_parse_for_chars(unit, str, "alse")
case ("n")
value % value_type = TYPE_NULL
call ncdf_parse_for_chars(unit, str, "ull")
case("-", "0": "9")
call ncdf_push_char(c)
call ncdf_parse_number(unit, str, value)
case default
print *, "ERROR: Unexpected character while parsing value. '", c, "' ASCII=", iachar(c)
call exit (1)
end select
end if
end subroutine ncdf_parse_value
!
! PARSE OBJECT
!
recursive subroutine ncdf_parse_object(unit, str, parent)
integer, intent(inout) :: unit
character(*), intent(inout) :: str
type(ncdf_value), pointer :: parent, pair
logical :: eof
character :: c
! pair name
c = ncdf_pop_char(unit, str, eof = eof, skip_ws = .true.)
if (eof) then
print *, "ERROR: Unexpected end of file while parsing start of object."
call exit (1)
else if ("}" == c) then
! end of an empty object
return
else if ('"' == c) then
pair => ncdf_value_create()
pair % name => ncdf_parse_string(unit, str)
else
print *, "ERROR: Expecting string: '", c, "'"
call exit (1)
end if
! pair value
c = ncdf_pop_char(unit, str, eof = eof, skip_ws = .true.)
if (eof) then
print *, "ERROR: Unexpected end of file while parsing object member. 1"
call exit (1)
else if (":" == c) then
! parse the value
call ncdf_parse_value(unit, str, pair)
call ncdf_value_add(parent, pair)
else
print *, "ERROR: Expecting : and then a value. ", c
call exit (1)
end if
! another possible pair
c = ncdf_pop_char(unit, str, eof = eof, skip_ws = .true.)
if (eof) then
return
else if ("," == c) then
! read the next member
call ncdf_parse_object(unit = unit, str=str, parent = parent)
else if ("}" == c) then
return
else
print *, "ERROR: Expecting end of object.", c
call exit (1)
end if
end subroutine ncdf_parse_object
!
! PARSE ARRAY
!
recursive subroutine ncdf_parse_array(unit, str, array)
implicit none
integer, intent(inout) :: unit
character(*), intent(inout) :: str
type(ncdf_value), pointer :: array, element
logical :: eof, finished
character :: c
finished = .false.
do while (.not. finished)
! try to parse an element value
element => ncdf_value_create()
call ncdf_parse_value(unit, str, element)
! parse value will disassociate an empty array value
if (associated(element)) then
call ncdf_value_add(array, element)
end if
! pop the next character
c = ncdf_pop_char(unit, str, eof = eof, skip_ws = .true.)
if (eof) then
finished = .true.
else if ("]" == c) then
! end of array
finished = .true.
end if
end do
end subroutine ncdf_parse_array
!
! PARSE STRING
!
function ncdf_parse_string(unit, str) result(string)
integer, intent(inout) :: unit
character(*), intent(inout) :: str
type(ncdf_string), pointer :: string
logical :: eof, escape
character :: c
string => ncdf_string_create()
escape = .false.
do
c = ncdf_pop_char(unit, str, eof = eof, skip_ws = .false.)
if (eof) then
print *, "Expecting end of string"
call exit(1)
else if (escape) then
call ncdf_string_append(string,c)
escape = .false.
else
if (c == '\\') then
escape = .true.
else if (c == '\"') then
exit
else
call ncdf_string_append(string,c)
end if
end if
end do
end function ncdf_parse_string
!
! PARSE FOR CHARACTERS
!
subroutine ncdf_parse_for_chars(unit, str, chars)
integer, intent(in) :: unit
character(*), intent(inout) :: str
character(len = *), intent(in) :: chars
integer :: i, length
logical :: eof
character :: c
length = len_trim(chars)
do i = 1, length
c = ncdf_pop_char(unit, str, eof = eof, skip_ws = .true.)
if (eof) then
print *, "ERROR: Unexpected end of file while parsing array."
call exit (1)
else if (c .ne. chars(i:i)) then
print *, "ERROR: Unexpected character.'", c,"'", chars(i:i)
call exit (1)
end if
end do
end subroutine ncdf_parse_for_chars
!
! PARSE NUMBER
!
subroutine ncdf_parse_number(unit, str, value)
integer, intent(inout) :: unit
character(*), intent(inout) :: str
type(ncdf_value), pointer :: value
logical :: eof, negative, decimal, scientific
character :: c
integer :: integral, exp, digit_count
double precision :: frac
! first character is either - or a digit
c = ncdf_pop_char(unit, str, eof = eof, skip_ws = .true.)
if (eof) then
print *, "ERROR: Unexpected end of file while parsing number."
call exit (1)
else if ("-" == c) then
negative = .true.
else
negative = .false.
call ncdf_push_char(c)
end if
! parse the integral
integral = ncdf_parse_integer(unit, str)
decimal = .false.
scientific = .false.
do
! first character is either - or a digit
c = ncdf_pop_char(unit, str, eof = eof, skip_ws = .true.)
if (eof) then
print *, "ERROR: Unexpected end of file while parsing number."
call exit (1)
else
select case (c)
case (".")
! this is already fractional number
if (decimal) then
! already found a decimal place
print *, "ERROR: Unexpected second decimal place while parsing number."
call exit(1)
end if
decimal = .true.
frac = ncdf_parse_integer(unit, str, digit_count)
frac = frac / (10.0d0 ** digit_count)
case ("e", "E")
! this is already an exponent number
if (scientific) then
! already found a e place
print *, "ERROR: Unexpected second exponent while parsing number."
call exit(1)
end if
scientific = .true.
! this number has an exponent
exp = ncdf_parse_integer(unit, str)
if (exp < 0) then
decimal = .true.
end if
case default
! this is a integer
if (decimal) then
! add the integral
frac = frac + integral
if (scientific) then
! apply exponent
frac = frac * (10.0d0 ** exp)
end if
! apply negative
if (negative) then
frac = frac * (-1)
end if
value % value_type = TYPE_REAL
value % value_real = frac
value % value_double = frac
else
if (scientific) then
! apply exponent
integral = integral * (10.0d0 ** exp)
end if
! apply negative
if (negative) then
integral = integral * (-1)
end if
value % value_type = TYPE_INTEGER
value % value_integer = integral
end if
call ncdf_push_char(c)
exit
end select
end if
end do
end subroutine
!
! PARSE INTEGER
!
integer(kind=8) function ncdf_parse_integer(unit, str, digit_count) result(integral)
integer, intent(in) :: unit
character(*), intent(inout) :: str
integer, optional, intent(inout) :: digit_count
logical :: eof, found_sign, found_digit
character :: c
integer :: tmp, icount, isign
integer, parameter :: max_integer_length = 18
icount = 0
integral = 0
isign = 1
found_sign = .false.
found_digit = .false.
do
c = ncdf_pop_char(unit, str, eof = eof, skip_ws = .true.)
if (eof) then
print *, "ERROR: Unexpected end of file while parsing digit."
call exit (1)
else
select case(c)
case ("+")
if (found_sign.or.found_digit) then
print *, "ERROR: Miss formatted number."
call exit(1)
end if
found_sign = .true.
case ("-")
if (found_sign.or.found_digit) then
print *, "ERROR: Miss formatted number."
call exit(1)
end if
found_sign = .true.
isign = -1
case ("0":"9")
found_sign = .true.
if (icount > max_integer_length) then
print *, "ERROR: Too many digits for an integer."
call exit(1)
end if
! digit
read (c, '(i1)') tmp
! shift
if (icount > 0) then
integral = integral * 10
end if
! add
integral = integral + tmp
! increase the icount
icount = icount + 1
case default
if (present(digit_count)) then
digit_count = icount
end if
call ncdf_push_char(c)
integral = isign * integral
return
end select
end if
end do
end function ncdf_parse_integer
!
! POP CHAR
!
recursive character function ncdf_pop_char(unit, str, eof, skip_ws) result(popped)
integer, intent(in) :: unit
character(*), intent(inout) :: str
logical, intent(out) :: eof
logical, intent(in), optional :: skip_ws
integer :: ios
character :: c
logical :: ignore
eof = .false.
if (.not.present(skip_ws)) then
ignore = .false.
else
ignore = skip_ws
end if
do
if (pushed_index > 0) then
! there is a character pushed back on, most likely from the number parsing
c = pushed_char(pushed_index:pushed_index)
pushed_index = pushed_index - 1
ios = 0
else
if (unit .gt. 0) then
read (unit = unit, fmt = "(a)", advance = "no", iostat = ios) c
else
read (unit = str, fmt = "(a)", iostat = ios) c
str = str(2:)
endif
end if
if (ios == end_of_record) then
cycle
else if (ios == end_of_file) then
eof = .true.
exit
else if (iachar(c) <= 31) then
! non printing ascii characters
cycle
else if (ignore .and. c == " ") then
cycle
else
popped = c
exit
end if
end do
end function ncdf_pop_char
!
! PUSH CHAR
!
subroutine ncdf_push_char(c)
character, intent(inout) :: c
pushed_index = pushed_index + 1
pushed_char(pushed_index:pushed_index) = c
end subroutine ncdf_push_char
end module nc_diag_fson