1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253
|
#NewLine = Chr(13) + Chr(10)
Structure JsonObject
Name$
Value.i
EndStructure
Global NewList Objects.JsonObject()
Global GeneratedStructures
Declare.s GenerateStructure(JsonValue)
Runtime Enumeration
#JsonGadget
#CodeGadget
#PrefixGadget
#NumberTypeGadget
#StringTypeGadget
#BooleanTypeGadget
#NullTypeGadget
#UseListsGadget
EndEnumeration
; Compare two JSON values recursively to see if they have the same structure
;
Procedure CompareJson(Value1, Value2)
If JSONType(Value1) <> JSONType(Value2)
ProcedureReturn #False
EndIf
If JSONType(Value1) = #PB_JSON_Array
If JSONArraySize(Value1) = 0 And JSONArraySize(Value2) = 0
ProcedureReturn #True
ElseIf JSONArraySize(Value1) > 0 And JSONArraySize(Value2) > 0
ProcedureReturn CompareJson(GetJSONElement(Value1, 0), GetJSONElement(Value2, 0))
Else
ProcedureReturn #False
EndIf
ElseIf JSONType(Value1) = #PB_JSON_Object
If JSONObjectSize(Value1) <> JSONObjectSize(Value2)
ProcedureReturn #False
EndIf
If ExamineJSONMembers(Value1)
While NextJSONMember(Value1)
OtherValue = GetJSONMember(Value2, JSONMemberKey(Value1))
If OtherValue = 0 Or CompareJson(JSONMemberValue(Value1), OtherValue) = #False
ProcedureReturn #False
EndIf
Wend
EndIf
EndIf
ProcedureReturn #True
EndProcedure
; Returns true if a JSON value of type Object contains names that can be converted to structure members
;
Procedure ValidStructure(JsonValue)
Protected NewList Seen.s()
If ExamineJSONMembers(JsonValue)
While NextJSONMember(JsonValue)
Name$ = LCase(JSONMemberKey(JsonValue))
; check for empty name
If Name$ = ""
ProcedureReturn #False
EndIf
; check for ambiguous names within the structure (only different by case)
ForEach Seen()
If Seen() = Name$
ProcedureReturn #False
EndIf
Next Seen()
AddElement(Seen())
Seen() = Name$
; check for invalid start char
If FindString("abcdefghijklmnopqrstuvwxyz_", Left(Name$, 1)) = 0
ProcedureReturn #False
EndIf
; check for other invalid chars
For i = 1 To Len(Name$)
If FindString("abcdefghijklmnopqrstuvwxyz_1234567890", Left(Name$, 1)) = 0
ProcedureReturn #False
EndIf
Next i
Wend
EndIf
ProcedureReturn #True
EndProcedure
; Get the PB type suffix for a JSON value
;
Procedure.s GetTypeSuffix(JsonValue)
Select JSONType(JsonValue)
Case #PB_JSON_Null
ProcedureReturn GetGadgetText(#NullTypeGadget)
Case #PB_JSON_String
ProcedureReturn GetGadgetText(#StringTypeGadget)
Case #PB_JSON_Number
ProcedureReturn GetGadgetText(#NumberTypeGadget)
Case #PB_JSON_Boolean
ProcedureReturn GetGadgetText(#BooleanTypeGadget)
Case #PB_JSON_Array
If JSONArraySize(JsonValue) = 0
ProcedureReturn GetGadgetText(#NullTypeGadget) ; Type unknown because the array is empty
Else
ProcedureReturn GetTypeSuffix(GetJSONElement(JsonValue, 0))
EndIf
Case #PB_JSON_Object
; See if the structure already exists
ForEach Objects()
If CompareJson(JsonValue, Objects()\Value)
ProcedureReturn "." + Objects()\Name$
EndIf
Next Objects()
; Generate a new structure
ProcedureReturn "." + GenerateStructure(JsonValue)
EndSelect
EndProcedure
Procedure.s GenerateStructure(JsonValue)
Protected NewList Members.s()
; Get structure name
If GeneratedStructures = 0
StructureName$ = GetGadgetText(#PrefixGadget)
Else
StructureName$ = GetGadgetText(#PrefixGadget) + "_" + Str(GeneratedStructures)
EndIf
GeneratedStructures + 1
; Get the members, generate any sub-structures
If ExamineJSONMembers(JsonValue)
While NextJSONMember(JsonValue)
ItemName$ = JSONMemberKey(JsonValue)
ItemValue = JSONMemberValue(JsonValue)
AddElement(Members())
If JSONType(ItemValue) = #PB_JSON_Object
If ValidStructure(ItemValue) = #False And ExamineJSONMembers(ItemValue) And NextJSONMember(ItemValue)
Members() = "Map " + ItemName$ + GetTypeSuffix(JSONMemberValue(ItemValue)) + "()"
Else
Members() = ItemName$ + GetTypeSuffix(ItemValue)
EndIf
ElseIf JSONType(ItemValue) = #PB_JSON_Array
If GetGadgetState(#UseListsGadget)
Members() = "List " + ItemName$ + GetTypeSuffix(ItemValue) + "()"
Else
Members() = "Array " + ItemName$ + GetTypeSuffix(ItemValue) + "(0)"
EndIf
Else
Members() = ItemName$ + GetTypeSuffix(ItemValue)
EndIf
Wend
EndIf
; Now output the structure (any sub-structures were already added to the output)
AddGadgetItem(#CodeGadget, -1, "Structure " + StructureName$)
ForEach Members()
AddGadgetItem(#CodeGadget, -1, " " + Members())
Next Members()
AddGadgetItem(#CodeGadget, -1, "EndStructure")
AddGadgetItem(#CodeGadget, -1, "")
; Register the structure for re-use
AddElement(Objects())
Objects()\Name$ = StructureName$
Objects()\Value = JsonValue
ProcedureReturn StructureName$
EndProcedure
Runtime Procedure Generator()
GeneratedStructures = 0
ClearList(Objects())
ClearGadgetItems(#CodeGadget)
If ParseJSON(0, GetGadgetText(#JsonGadget))
If JSONType(JSONValue(0)) = #PB_JSON_Object
GenerateStructure(JSONValue(0))
Else
Code$ = "; Main JSON Element is not of type #PB_JSON_Object"
SetGadgetText(#CodeGadget, Code$)
EndIf
Else
Code$ = "; " + JSONErrorMessage() + #NewLine +
"; Line " + JSONErrorLine() + " Column " + JSONErrorPosition()
SetGadgetText(#CodeGadget, Code$)
EndIf
EndProcedure
Dialog$ = "<window name='generator' text='JSON Structure Generator' flags='#PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget'>" +
" <vbox>" +
" <splitter>" +
" <frame text='JSON Data:'>" +
" <editor id='#JsonGadget' width='600' height='160'/>" +
" </frame>" +
" <frame text='PB Code:'>" +
" <editor id='#CodeGadget' width='600' height='160' flags='#PB_Editor_ReadOnly'/>" +
" </frame>" +
" </splitter>" +
" <frame text='Generator'>" +
" <hbox expand='item:2'>" +
" <gridbox columns='5' colexpand='no'>" +
" <text text='PB Type for Numbers: '/>" +
" <string id='#NumberTypeGadget' text='.i' width='50'/>" +
" <empty width='30'/>" +
" <text text='Structure Prefix: '/>" +
" <string id='#PrefixGadget' text='Json' width='100'/>" +
" <text text='PB Type for Strings: '/>" +
" <string id='#StringTypeGadget' text='$'/>" +
" <empty/>" +
" <checkbox id='#UseListsGadget' text='Use Lists instead of Arrays' colspan='2'/>" +
" <text text='PB Type for Booleans: '/>" +
" <string id='#BooleanTypeGadget' text='.i'/>" +
" <empty colspan='3'/>" +
" <text text='PB Type for Nulls: '/>" +
" <string id='#NullTypeGadget' text='$'/>" +
" <empty colspan='3'/>" +
" </gridbox>" +
" <singlebox expand='no' margin='0' align='top,right'>" +
" <button onevent='Generator()' text='Generate'/>" +
" </singlebox>" +
" </hbox>" +
" </frame>" +
" </vbox>" +
"</window>"
If ParseXML(0, Dialog$) And XMLStatus(0) = #PB_XML_Success And CreateDialog(0) And OpenXMLDialog(0, 0, "generator")
While WaitWindowEvent() <> #PB_Event_CloseWindow: Wend
End
Else
Debug XMLError(0)
EndIf |
Partager