Add the escape characters to a string for adding to JSON.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(kind=CK,len=*), | intent(in) | :: | str_in | |||
| character(kind=CK,len=:), | intent(out), | allocatable | :: | str_out |
subroutine escape_string(str_in, str_out)
implicit none
character(kind=CK,len=*),intent(in) :: str_in
character(kind=CK,len=:),allocatable,intent(out) :: str_out
integer(IK) :: i !! counter
integer(IK) :: ipos !! accumulated string size
!! (so we can allocate it in chunks for
!! greater runtime efficiency)
character(kind=CK,len=1) :: c !! for reading `str_in` one character at a time.
#if defined __GFORTRAN__
character(kind=CK,len=:),allocatable :: tmp !! workaround for bug in gfortran 6.1
#endif
character(kind=CK,len=*),parameter :: specials = quotation_mark//&
backslash//&
slash//&
bspace//&
formfeed//&
newline//&
carriage_return//&
horizontal_tab
!Do a quick scan for the special characters,
! if any are present, then process the string,
! otherwise, return the string as is.
if (scan(str_in,specials)>0) then
str_out = repeat(space,chunk_size)
ipos = 1
!go through the string and look for special characters:
do i=1,len(str_in)
c = str_in(i:i) !get next character in the input string
!if the string is not big enough, then add another chunk:
if (ipos+3>len(str_out)) str_out = str_out // repeat(space, chunk_size)
select case(c)
case(backslash)
!test for unicode sequence: '\uXXXX'
![don't add an extra '\' for those]
if (i+5<=len(str_in)) then
if (str_in(i+1:i+1)==CK_'u' .and. &
valid_json_hex(str_in(i+2:i+5))) then
str_out(ipos:ipos) = c
ipos = ipos + 1
cycle
end if
end if
str_out(ipos:ipos+1) = backslash//c
ipos = ipos + 2
case(quotation_mark,slash)
str_out(ipos:ipos+1) = backslash//c
ipos = ipos + 2
case(bspace)
str_out(ipos:ipos+1) = '\b'
ipos = ipos + 2
case(formfeed)
str_out(ipos:ipos+1) = '\f'
ipos = ipos + 2
case(newline)
str_out(ipos:ipos+1) = '\n'
ipos = ipos + 2
case(carriage_return)
str_out(ipos:ipos+1) = '\r'
ipos = ipos + 2
case(horizontal_tab)
str_out(ipos:ipos+1) = '\t'
ipos = ipos + 2
case default
str_out(ipos:ipos) = c
ipos = ipos + 1
end select
end do
!trim the string if necessary:
if (ipos<len(str_out)+1) then
if (ipos==1) then
str_out = CK_''
else
#if defined __GFORTRAN__
tmp = str_out(1:ipos-1) !workaround for bug in gfortran 6.1
str_out = tmp
#else
str_out = str_out(1:ipos-1) !original
#endif
end if
end if
else
str_out = str_in
end if
end subroutine escape_string