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 | ||
logical(kind=LK), | intent(in) | :: | escape_solidus |
if the solidus (forward slash) is also to be escaped |
subroutine escape_string(str_in, str_out, escape_solidus) implicit none character(kind=CK,len=*),intent(in) :: str_in character(kind=CK,len=:),allocatable,intent(out) :: str_out logical(LK),intent(in) :: escape_solidus !! if the solidus (forward slash) !! is also to be escaped 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 logical :: to_be_escaped !! if there are characters to be escaped character(kind=CK,len=*),parameter :: specials_no_slash = quotation_mark//& backslash//& bspace//& formfeed//& newline//& carriage_return//& horizontal_tab character(kind=CK,len=*),parameter :: specials = specials_no_slash//slash !Do a quick scan for the special characters, ! if any are present, then process the string, ! otherwise, return the string as is. if (escape_solidus) then to_be_escaped = scan(str_in,specials)>0 else to_be_escaped = scan(str_in,specials_no_slash)>0 end if if (to_be_escaped) 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 // blank_chunk 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) str_out(ipos:ipos+1) = backslash//c ipos = ipos + 2 case(slash) if (escape_solidus) then str_out(ipos:ipos+1) = backslash//c ipos = ipos + 2 else str_out(ipos:ipos) = c ipos = ipos + 1 end if 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