json-parser.bas

File libs/json-parser.bas from the latest check-in


#INCLUDE "json.bi"

FUNCTION JSON_IsWhiteSpace(Char AS ULONG) AS LONG
  SELECT CASE Char
    CASE JSON_TOKEN_TAB, JSON_TOKEN_LF, JSON_TOKEN_CR, JSON_TOKEN_SPACE
      JSON_IsWhiteSpace = -1
  END SELECT
END FUNCTION

FUNCTION JSON_IsControl(value AS STRING) AS LONG
  IF LEFT(value, 1) = CHR(JSON_TOKEN_ESCAPE) THEN
    SELECT CASE LCASE(MID(value, 2, 1))
      CASE CHR(JSON_TOKEN_DOUBLE_QUOTE), _
           CHR(JSON_TOKEN_SLASH), _
           CHR(JSON_TOKEN_ESCAPE), _
           "b", "f", "n", "r", "t", "u"
        JSON_IsControl = -1
    END SELECT
  END IF
END FUNCTION

SUB JSON_GetValue(BYREF i AS ULONG, Char AS ULONG, RawContent AS STRING, ValueContent AS STRING = "")
  DIM AS ULONG LastOpen, NextClose, NextComma
  SELECT CASE Char
    CASE JSON_TOKEN_DOUBLE_QUOTE
      LastOpen = i
      DO
        NextClose = INSTR(i + 1, RawContent, CHR(JSON_TOKEN_DOUBLE_QUOTE))
        IF JSON_IsControl(MID(RawContent, NextClose - 1, 2)) AND NOT JSON_IsControl(MID(RawContent, NextClose - 2, 2)) THEN
          'Escaped double-quote
          i = NextClose + 1
        ELSE
          EXIT DO
        END IF
      LOOP
      ValueContent = MID(RawContent, LastOpen, (NextClose - LastOpen) + 1)
      i = NextClose + 1
    CASE JSON_TOKEN_OBJECT_OPEN
      LastOpen = i
      DO
        NextClose = INSTR(i + 1, RawContent, CHR(JSON_TOKEN_OBJECT_CLOSE))
        IF INSTR(MID(RawContent, i + 1, NextClose - i), CHR(JSON_TOKEN_OBJECT_OPEN)) > 0 THEN
          i = NextClose
        ELSE
          EXIT DO
        END IF
      LOOP
      ValueContent = MID(RawContent, LastOpen, (NextClose - LastOpen) + 1)
      i = NextClose + 1
    CASE JSON_TOKEN_ARRAY_OPEN
      IF i = 1 THEN
        i += 1
      ELSE
        LastOpen = i
        DO
          NextClose = INSTR(i + 1, RawContent, CHR(JSON_TOKEN_ARRAY_CLOSE))
          IF INSTR(MID(RawContent, i + 1, NextClose - i), CHR(JSON_TOKEN_ARRAY_OPEN)) > 0 THEN
            i = NextClose
          ELSE
            EXIT DO
          END IF
        LOOP
        ValueContent = MID(RawContent, LastOpen, (NextClose - LastOpen) + 1)
        i = NextClose + 1
      END IF
    CASE ELSE
      IF NOT JSON_IsWhiteSpace(Char) THEN
        LastOpen = i
        DIM NextChar AS ULONG
        'On non-enclosed values, look for a comma or a global enclosing token
        DO UNTIL JSON_IsWhiteSpace(NextChar) OR NextChar = JSON_TOKEN_COMMA _
          OR NextChar = JSON_TOKEN_ARRAY_CLOSE OR NextChar = JSON_TOKEN_OBJECT_CLOSE
          i += 1
          NextChar = ASC(MID(RawContent, i, 1))
          IF NextChar = 0 OR NextChar = JSON_TOKEN_COMMA THEN
            i -= 1
            EXIT DO
          END IF
        LOOP
        ValueContent = MID(RawContent, LastOpen, i - LastOpen)
        i += 1
      END IF
  END SELECT
END SUB

SUB JSON_ParseArray(ArrayJSON AS JSON_Array, ArrayValues() AS JSON_Value)
  DIM AS ULONG ValueCount, LastPos, NextComma
  DIM ValueContent AS STRING
  FOR i AS ULONG = 1 TO LEN(ArrayJSON.RawContent)
    LastPos = i
    JSON_GetValue(i, ASC(MID(ArrayJSON.RawContent, i, 1)), ArrayJSON.RawContent, ValueContent)
    IF i > LastPos + 1 AND ValueContent <> "" THEN
      ValueCount += 1
      WITH ArrayValues(ValueCount - 1)
        .ValueType = JSON_GetType(ValueContent)
        .RawContent = ValueContent
      END WITH
      WHILE JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, i, 1)))
        i += 1
      WEND
      NextComma = INSTR(i, ArrayJSON.RawContent, CHR(JSON_TOKEN_COMMA))
      IF NextComma > 0 THEN
        'To be considered as member separator it must be surrounded by whitespaces
        IF JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, NextComma - 1, 1))) _
          AND JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, NextComma + 1, 1))) THEN
          i = NextComma + 1
        END IF
      END IF
    END IF
  NEXT
END SUB

SUB JSON_CountValues(ArrayJSON AS JSON_Array)
  DIM AS ULONG LastPos, NextComma
  'Reset value count
  ArrayJSON.ValueCount = 0
  FOR i AS ULONG = 1 TO LEN(ArrayJSON.RawContent)
    LastPos = i
    JSON_GetValue(i, ASC(MID(ArrayJSON.RawContent, i, 1)), ArrayJSON.RawContent)
    IF i > LastPos + 1 THEN
      ArrayJSON.ValueCount += 1
      WHILE JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, i, 1)))
        i += 1
      WEND
      NextComma = INSTR(i, ArrayJSON.RawContent, CHR(JSON_TOKEN_COMMA))
      IF NextComma > 0 THEN
        'To be considered as member separator it must be surrounded by whitespaces
        IF JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, NextComma - 1, 1))) _
          AND JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, NextComma + 1, 1))) THEN
          i = NextComma + 1
        END IF
      END IF
    END IF
  NEXT
END SUB

FUNCTION JSON_GetValueIndex(ArrayValues() AS JSON_Value, TargetValue AS JSON_Value) AS LONG
  DIM Count AS LONG = UBOUND(ArrayValues)
  IF Count >= 0 THEN
    FOR i AS ULONG = 0 TO Count
      IF ArrayValues(i).RawContent = TargetValue.RawContent _
        AND ArrayValues(i).ValueType = TargetValue.ValueType THEN
        JSON_GetValueIndex = i
        EXIT FOR
      END IF
      IF i = Count THEN
        JSON_GetValueIndex = -1
      END IF
    NEXT
  ELSE
    JSON_GetValueIndex = Count
  END IF
END FUNCTION

SUB JSON_ParseObject(oJSON AS JSON_Object, ArrayMembers() AS JSON_Member)
  DIM AS ULONG Char, Count, LastOpen, NextClose, NextColon, NextComma
  DIM ValueContent AS STRING
  FOR i AS ULONG = 1 TO LEN(oJSON.RawContent)
    Char = ASC(MID(oJSON.RawContent, i, 1))
    IF Char = JSON_TOKEN_DOUBLE_QUOTE THEN
      LastOpen = i
      NextClose = INSTR(i + 1, oJSON.RawContent, CHR(JSON_TOKEN_DOUBLE_QUOTE))
      IF NextClose THEN
        i = NextClose + 1
      END IF
      NextColon = INSTR(i, oJSON.RawContent, CHR(JSON_TOKEN_COLON))
      IF NextColon > 0 THEN
        ArrayMembers(Count).Name = MID(oJSON.RawContent, LastOpen + 1, (NextClose - LastOpen) - 1)
        i = NextColon + 1
        WHILE JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, i, 1)))
          i += 1
        WEND
        JSON_GetValue (i, ASC(MID(oJSON.RawContent, i, 1)), oJSON.RawContent, ValueContent)
        WITH ArrayMembers(Count).Value
          .ValueType = JSON_GetType(ValueContent)
          .RawContent = ValueContent
        END WITH
        WHILE JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, i, 1)))
          i += 1
        WEND
        NextComma = INSTR(i, oJSON.RawContent, CHR(JSON_TOKEN_COMMA))
        IF NextComma > 0 THEN
          'To be considered as member separator it must be surrounded by whitespaces
          IF JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, NextComma - 1, 1))) _
            AND JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, NextComma + 1, 1))) THEN
            i = NextComma + 1
          END IF
        END IF
        Count += 1
      END IF
    END IF
  NEXT
END SUB

SUB JSON_CountMembers(oJSON AS JSON_Object)
  DIM AS ULONG Char, LastOpen, NextClose, NextColon, NextComma
  'Reset Member Count
  oJSON.MemberCount = 0
  FOR i AS ULONG = 1 TO LEN(oJSON.RawContent)
    Char = ASC(MID(oJSON.RawContent, i, 1))
    IF Char = JSON_TOKEN_DOUBLE_QUOTE THEN
      LastOpen = i
      NextClose = INSTR(i + 1, oJSON.RawContent, CHR(JSON_TOKEN_DOUBLE_QUOTE))
      IF NextClose THEN
        i = NextClose + 1
      END IF
      NextColon = INSTR(i, oJSON.RawContent, CHR(JSON_TOKEN_COLON))
      IF NextColon > 0 THEN
        oJSON.MemberCount += 1
        i = NextColon + 1
        WHILE JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, i, 1)))
          i += 1
        WEND
        JSON_GetValue (i, ASC(MID(oJSON.RawContent, i, 1)), oJSON.RawContent)
        WHILE JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, i, 1)))
          i += 1
        WEND
        NextComma = INSTR(i, oJSON.RawContent, CHR(JSON_TOKEN_COMMA))
        IF NextComma > 0 THEN
          'To be considered as member separator it must be surrounded by whitespaces
          IF JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, NextComma - 1, 1))) _
            AND JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, NextComma + 1, 1))) THEN
            i = NextComma + 1
          END IF
        END IF
      END IF
    END IF
  NEXT
END SUB

FUNCTION JSON_GetMemberValue(ArrayMembers() AS JSON_Member, MemberName AS STRING) AS STRING
  DIM Count AS LONG = UBOUND(ArrayMembers)
  IF Count >= 0 THEN
    FOR i AS ULONG = 0 TO Count
      WITH ArrayMembers(i)
        IF .Name = MemberName THEN
          IF .Value.ValueType = JSON_TYPE_STRING THEN
            JSON_GetMemberValue = JSON_ParseString(.Value.RawContent)
          ELSE
            JSON_GetMemberValue = .Value.RawContent
          END IF
          EXIT FOR
        END IF
      END WITH
      IF i = Count THEN
        JSON_GetMemberValue = MemberName
      END IF
    NEXT
  ELSE
    JSON_GetMemberValue = MemberName
  END IF
END FUNCTION

FUNCTION JSON_GetMemberIndex(ArrayMembers() AS JSON_Member, MemberName AS STRING) AS LONG
  DIM Count AS LONG = UBOUND(ArrayMembers)
  IF Count >= 0 THEN
    FOR i AS ULONG = 0 TO Count
      IF ArrayMembers(i).Name = MemberName THEN
        JSON_GetMemberIndex = i
        EXIT FOR
      END IF
      IF i = Count THEN
        JSON_GetMemberIndex = -1
      END IF
    NEXT
  ELSE
    JSON_GetMemberIndex = Count
  END IF
END FUNCTION

FUNCTION JSON_ParseString(RawString AS STRING) AS STRING
  DIM Char AS ULONG, EscapedChar AS ULONG, Result AS STRING
  FOR i AS ULONG = 1 TO LEN(RawString)
    Char = ASC(MID(RawString, i, 1))
    IF Char = JSON_TOKEN_DOUBLE_QUOTE THEN
      IF i = 1 OR i = LEN(RawString) THEN
        'Do nothing
      END IF
    ELSEIF Char = JSON_TOKEN_ESCAPE THEN
      EscapedChar = ASC(MID(RawString, i + 1, 1))
      SELECT CASE EscapedChar
        CASE JSON_TOKEN_DOUBLE_QUOTE, JSON_TOKEN_SLASH, JSON_TOKEN_ESCAPE
          Result += CHR(EscapedChar)
        CASE ASC("b")
          Result += CHR(08)
        CASE ASC("f")
          Result += CHR(12)
        CASE ASC("n")
          Result += CHR(JSON_TOKEN_LF)
        CASE ASC("r")
          Result += CHR(JSON_TOKEN_CR)
        CASE ASC("t")
          Result += CHR(JSON_TOKEN_TAB)
        CASE ASC("u")
          Result += CHR(VALINT("&H" + MID(RawString, i + 2, 4)))
          i += 4
      END SELECT
      i += 1
    ELSE
      Result += CHR(Char)
    END IF
  NEXT
  JSON_ParseString = Result
  Result = ""
END FUNCTION

FUNCTION JSON_GetType(value AS STRING) AS ULONG
  'Guess the type of the value
  SELECT CASE LCASE(value)
    CASE "null"
      JSON_GetType = JSON_TYPE_NULL
    CASE "true", "false"
      JSON_GetType = JSON_TYPE_BOOLEAN
    CASE ELSE
      DIM AS ULONG OpenChar, CloseChar
      OpenChar = ASC(LEFT(value, 1))
      CloseChar = ASC(RIGHT(value, 1))
      IF OpenChar = JSON_TOKEN_DOUBLE_QUOTE AND CloseChar = JSON_TOKEN_DOUBLE_QUOTE THEN
        JSON_GetType = JSON_TYPE_STRING
      ELSEIF OpenChar = JSON_TOKEN_ARRAY_OPEN AND CloseChar = JSON_TOKEN_ARRAY_CLOSE THEN
        JSON_GetType = JSON_TYPE_ARRAY
      ELSEIF OpenChar = JSON_TOKEN_OBJECT_OPEN AND CloseChar = JSON_TOKEN_OBJECT_CLOSE THEN
        JSON_GetType = JSON_TYPE_OBJECT
      ELSE
        'Fallback to numeric type
        DIM AS LONG IsDigit, IsNegative, IsFraction, HasExponent, ExponentHasSign
        DIM AS ULONG Char, EPos
        FOR i AS ULONG = 1 TO LEN(value)
          Char = ASC(MID(value, i, 1))
          SELECT CASE Char
            CASE 48 TO 57 'Zero - Onenine
              IsDigit = -1
            CASE 46 '.
              IF IsFraction THEN
                IsDigit = 0
              ELSE
                IsFraction = -1
              END IF
            CASE 69, 101 'E, e
              IF HasExponent THEN
                IsDigit = 0
              ELSE
                HasExponent = -1
                EPos = i
              END IF
            CASE 43, 45 '+, -
              IF ExponentHasSign THEN
                IsDigit = 0
              ELSE
                IF HasExponent AND i = EPos + 1 THEN
                  ExponentHasSign = -1
                ELSE
                  IsDigit = 0
                END IF
              END IF
              IF IsNegative THEN
                IsDigit = 0
              ELSE
                IF i = 1 AND Char = 45 THEN
                  IsNegative = -1
                ELSE
                  IsDigit = 0
                END IF
              END IF
            CASE ELSE
              IsDigit = 0
          END SELECT
        NEXT
        IF IsDigit THEN
          JSON_GetType = JSON_TYPE_NUMERIC
        ELSE
          'All possible types failed, return error
          JSON_GetType = JSON_TYPE_ERROR
        END IF
      END IF
  END SELECT
END FUNCTION