So I am indebted to a fellow StackOverflow citizen who helped me over a Power Query problem. Powerquery looks like a great technology and has been in Excel since 2013 edition but not VBA scriptable until 2016 edition. I especially like the ability to drill into JSON documents and extract information. But I find Powerquery's syntax challenging and clealy I have yet to master it.
The use case in hand is calling the Google Sheets API (version 3, I know I should move to version 4) to get the 'master' details of a Google sheets workbook and then drill in to find the sheet details. Amongst the sheet details are the sheet name and the url of the sheet data itself. I have tidied an example structure and it is given below. The sheet name is at feed.entry[x].title.$t whilst the url for the sheet data is at feed.entry[x].link[y].href where x increments and y is 0.
{ ""feed"": {""entry"": [
{ ""title"": { ""$t"": ""1 Med"" }, ""link"": [ { ""href"":
""https//removed1...."" } ] },
{ ""title"": { ""$t"": ""2 Dent"" }, ""link"": [ { ""href"":
""https//removed2...."" } ] },
{ ""title"": { ""$t"": ""3 Vet"" }, ""link"": [ { ""href"":
""https//removed3...."" }] }
] } }
Powerquery is orientated towards outputting data onto a grid of cells. I asked for a query to give the sheet name and url for each of the three sheets, yielding a 3 row 2 column matrix. So, my thanks to Mike Honey who gave a correct working answer
let
Source = Json.Document("{ ""feed"": {""entry"": [
{ ""title"": { ""$t"": ""1 Med"" }, ""link"": [ { ""href"": ""https//removed1...."" } ] },
{ ""title"": { ""$t"": ""2 Dent"" }, ""link"": [ { ""href"": ""https//removed2...."" } ] },
{ ""title"": { ""$t"": ""3 Vet"" }, ""link"": [ { ""href"": ""https//removed3...."" }] }
] } }"),
feed = Source[feed],
entry = feed[entry],
#"Converted to Table" = Table.FromList(entry, Splitter.SplitByNothing(), null, null, ExtraValues.Error),
#"Expanded Column2" = Table.ExpandRecordColumn(#"Converted to Table", "Column1", {"title", "link"}, {"title", "link"}),
#"Expanded title1" = Table.ExpandRecordColumn(#"Expanded Column2", "title", {"$t"}, {"$t"}),
#"Expanded link" = Table.ExpandListColumn(#"Expanded title1", "link"),
#"Expanded link1" = Table.ExpandRecordColumn(#"Expanded link", "link", {"href"}, {"href"})
in
#"Expanded link1"
Here is the output
| 1 Med | https//removed1 |
| 2 Dent | https//removed2 |
| 3 Vet | https//removed3 |
I would like to be able to compete with PowerQuery in regards to a declarative technology that avoids stepping through using CallByName on JScriptTypeInfo.
Over the course of the weekend I wrote some VBA to implement a declarative syntax and then I rewrote it in Javascript. The results work but I am not happy with this code and would like to get the jsonpath library to work in the ScriptControl. Nevertheless, depositing the code here to pick up later.
Option Explicit
Option Private Module
Private mvMyAdviceToCaller As Variant
'* module name: modJSONPath
'* module type: standard
'* purpose: parses, traverses JSON document using JScript in Microsoft's Script Control
'* Version: 0.01
'* Date: 19 Jan 2018 20:19
'* Author: Simon Meaden, Sevenoaks, England
'* Other credits: Douglas Crockford: JSON.parse and JSON.stringify routines
'* TODO: speed up JSONPath by not checking for objects , requires shipping an option to optomise
'* consider how much of this VBA can in fact be run in scripting control with standard javascript!
'* Tools->References
'MSScriptControl Microsoft Script Control 1.0 C:\Windows\SysWOW64\msscript.ocx
'Scripting Microsoft Scripting Runtime C:\Windows\SysWOW64\scrrun.dll
'MSXML2 Microsoft XML, v6.0 C:\Windows\SysWOW64\msxml6.dll
Private Function GetJavaScriptLibrary(ByVal sURL As String) As String
Dim xHTTPRequest As MSXML2.XMLHTTP60
Set xHTTPRequest = New MSXML2.XMLHTTP60
xHTTPRequest.Open "GET", sURL, False
xHTTPRequest.send
GetJavaScriptLibrary = xHTTPRequest.responseText
End Function
Public Function JsonPathSC() As ScriptControl
Set JsonPathSC = SC
End Function
Private Function SC() As ScriptControl
'End
Static soSC As ScriptControl
If soSC Is Nothing Then
Set soSC = New ScriptControl
soSC.Language = "JScript"
soSC.AddCode "function deleteValueByKey(obj,keyName) { delete obj[keyName]; } "
soSC.AddCode "function setValueByKey(obj,keyName, newValue) { obj[keyName]=newValue; } "
soSC.AddCode "function enumKeysToMsDict(jsonObj,msDict) { for (var i in jsonObj) { msDict.Add(i,0); } } "
soSC.AddCode GetJavaScriptLibrary("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js")
soSC.AddCode "function JSON_stringify(value, replacer,spacer) { return JSON.stringify(value, replacer,spacer); } "
soSC.AddCode "function JSON_parse(sJson) { return JSON.parse(sJson); } "
soSC.AddCode "function subString(sExpr, lStart, lEnd) { return sExpr.substring(lStart, lEnd) ;}"
soSC.AddCode "function indexOf(sExpr,searchvalue, start) { return sExpr.indexOf(searchvalue, start) ;}"
soSC.AddCode "function CountLeftBrackets(sExpr) { return sExpr.split('[').length-1 ;}"
soSC.AddCode "function CountRightBrackets(sExpr) { return sExpr.split(']').length-1 ;}"
soSC.AddCode "function ValidSquareBrackets(sExpr) {" & _
" var lCountLeftBrackets = CountLeftBrackets(sExpr); var lCountRightBrackets = CountRightBrackets(sExpr);" & _
" if (lCountLeftBrackets!==lCountRightBrackets) { return -1; } else {" & _
" if (lCountLeftBrackets===0 || lCountRightBrackets===1) { return lCountLeftBrackets;} else { return -1;}" & _
" }}"
soSC.AddCode "function ValidSquareBracketsForPath(sPath) {" & _
" var vSplit=sPath.split('.'); var bAllPathSgementsAreValid=true;" & _
" for (i = 0; i < vSplit.length; i++) {" & _
" var vSplitLoop=vSplit[i];" & _
" var lMatchedBracketCount = ValidSquareBrackets(vSplitLoop);" & _
" var bValid = (lMatchedBracketCount === 0 || lMatchedBracketCount === 1);" & _
" bAllPathSgementsAreValid = bAllPathSgementsAreValid && bValid;" & _
" }" & _
" return bAllPathSgementsAreValid;" & _
"}"
soSC.AddCode "function HasSquareBrackets(sExpr) { return (ValidSquareBrackets(sExpr) === 1); }"
soSC.AddCode "function ExtractSquareBrackets(sExpr) {" & _
" if (HasSquareBrackets(sExpr)===true) {" & _
" if (sExpr.substring(0,1)==='[') {" & _
" if (sExpr.substring(sExpr.length-1, sExpr.length)===']') {" & _
" return sExpr.substring(1, sExpr.length-1); " & _
" }" & _
" }" & _
" } else { return sExpr ; } " & _
"}"
soSC.AddCode "function LeftSquareIsMissingAdjacentPeriod(sJSONPath , lLeftSquareBracket) {" & _
" if (lLeftSquareBracket===1) { return true; } else { " & _
" var sOnMyLeft = sJSONPath.substring(lLeftSquareBracket,lLeftSquareBracket+1); " & _
" return (sOnMyLeft!=='.'); " & _
" }" & _
"}"
soSC.AddCode "function CharAndPrevChar(sJSONPath , lCharAt) {" & _
" if (lCharAt===1) {" & _
" return sJSONPath.substring(0,1); } else {" & _
" return (sJSONPath.substring(lCharAt-2,lCharAt));" & _
" }" & _
"}"
soSC.AddCode "function CheckCharAndPrevChar( sCharAndPrevChar ) {" & _
" if (sCharAndPrevChar.length===1) {" & _
" return (sCharAndPrevChar === '[') ; } else {" & _
" return (sCharAndPrevChar === '.[') ;" & _
" }" & _
"}"
soSC.AddCode "function GetNextLeftSquareBracket ( sJSONPath , lStart ) {" & _
" return (sJSONPath.indexOf('[',lStart-1)+1); } "
soSC.AddCode "function JSONPathNeedsPeriodising(sJSONPath) {" & _
" var lLeftSquareBracket=GetNextLeftSquareBracket(sJSONPath,1); " & _
" while (lLeftSquareBracket>1) { " & _
" var sCharPrevChar = CharAndPrevChar(sJSONPath, lLeftSquareBracket); " & _
" if (!CheckCharAndPrevChar ( sCharPrevChar) ) { " & _
" return true; " & _
" } " & _
" lLeftSquareBracket=GetNextLeftSquareBracket(sJSONPath,lLeftSquareBracket + 1); " & _
" }" & _
" return false;" & _
"}"
soSC.AddCode "function IsErrorMessage ( sExpr ) {" & _
" var lLen = sExpr.length;" & _
" return ((sExpr.substring( 0, 1) === '#') && (sExpr.substring( lLen - 1, lLen) === '!'));" & _
"}"
soSC.AddCode "function InsertPeriodBeforeLeftSquareBracket(sJSONPath) { return sJSONPath.replace( /\[/g , '.['); }"
soSC.AddCode "function RemoveDoublePeriods(sJSONPath) {" & _
" while (sJSONPath.indexOf( '..', 1) > -1) {" & _
" sJSONPath=sJSONPath.replace('..','.');" & _
" }" & _
" return sJSONPath;" & _
"}"
soSC.AddCode "function JSONPathPeriodiseSquareBrackets(sJSONPath) {" & _
" if (JSONPathNeedsPeriodising(sJSONPath)===true) {" & _
" if (ValidSquareBracketsForPath(sJSONPath)===true) { " & _
" var sWork = InsertPeriodBeforeLeftSquareBracket(sJSONPath); " & _
" while (sWork.indexOf( '..', 1) > -1) { " & _
" sWork = RemoveDoublePeriods( sWork); " & _
" } " & _
" return sWork; " & _
" } " & _
" else " & _
" { return '#Bad path, please check, mismatched square brackets?!' " & _
" } " & _
" } " & _
" else " & _
" { return sJSONPath; " & _
" } " & _
"} "
soSC.AddCode "function segmentCount(sExpr) { if (sExpr==='') { return 0;} else {return (sExpr.split('.')).length;} }"
soSC.AddCode "function firstSegment(sPath) { var vSplit = sPath.split('.'); if (vSplit.length===1) { return sPath; } else { return vSplit[0]; } }"
soSC.AddCode "function eatFirstSegment(sPath) { var vSplit = sPath.split('.'); if (vSplit.length===1) { return ''; } else { vSplit[0]=''; var rejoined = vSplit.join('.'); return rejoined.substring(1,rejoined.length); } }"
soSC.AddCode "function JSONParsePath(sJSONPath) { " & _
" var objReturn = JSON_parse('{}'); " & _
" var sFirst = firstSegment(sJSONPath);" & _
" objReturn.lCount=segmentCount(sJSONPath);" & _
" objReturn.sNewPath=eatFirstSegment(sJSONPath);" & _
" objReturn.sFirst=ExtractSquareBrackets(sFirst);" & _
" return objReturn;" & _
" }"
soSC.AddCode "function IsNothing(objStart ) { return (!objStart || objStart === 'null' || objStart === 'undefined');}"
soSC.AddCode "function JSONPathCheckParams(objStart , sJSONPath ) { " & _
" if (IsNothing(objStart)) { return '#Null objStart!' ;}" & _
" if (sJSONPath.length===0) { return '#Null sJSONPath!' ;}" & _
" return JSONPathPeriodiseSquareBrackets(sJSONPath);}"
soSC.AddCode "function JSONPath(objStart, sJSONPath, bCheckParams) { " & _
" if (bCheckParams===true) { sJSONPath = JSONPathCheckParams(objStart, sJSONPath) ; }" & _
" if (IsErrorMessage(sJSONPath)===true) { return sJSONPath ; }" & _
" var objPathParsed = JSONParsePath(sJSONPath) ; " & _
" if (objStart.hasOwnProperty(objPathParsed.sFirst)===true) { " & _
" var first = objStart[objPathParsed.sFirst] ;" & _
" if ((objPathParsed.lCount)> 1) { return JSONPath(first, objPathParsed.sNewPath, false) ; } else { return first ;} " & _
" } else if ((objPathParsed.sFirst === '*')) {" & _
" if (objStart.hasOwnProperty('length')===true) { " & _
" var objJSArray=JSON.parse('[]');" & _
" var lLength = objStart.length ; " & _
" for (lArrayLoop=0 ; lArrayLoop< lLength ; lArrayLoop++ ) { " & _
" var first2 = objStart[lArrayLoop] ;" & _
" if ((objPathParsed.lCount)> 1) { " & _
" objJSArray.push(JSONPath(first2, objPathParsed.sNewPath, false)) ; " & _
" } else " & _
" { objJSArray.push(first2) ;}" & _
" }" & _
" return objJSArray;" & _
" } else { return ('#Bad path \'' + sJSONPath + '\' , wildcard expression implies array but array length not found!') } " & _
" }" & _
" else {" & _
" return ('#Bad path \'' + sJSONPath + '\'!')" & _
" }" & _
" }"
soSC.AddCode "function isObject(o) { if(IsNothing(o)===true) { return false; } else { return o instanceof Object && o.constructor === Object; }} "
'soSC.AddCode "function myConstructor(o) { return JSON.stringify(o.constructor) ; } "
soSC.AddCode "function isArray(obj) { return Object.prototype.toString.call(obj) === '[object Array]'; } "
soSC.AddCode "function ArrayOfLiteralsUpgradeToObjects(objArray,sLiteralsProperyName) { " & _
" if (isArray(objArray) ) { " & _
" var objNewArray = JSON.parse('[]');" & _
" for (lLoop=0; lLoop < objArray.length; lLoop++) {" & _
" var ele = objArray[lLoop];" & _
" if (isObject(ele)===false) { throw new Error('#Expecting array of literals but bumped into object \'' + JSON.stringify(ele) + '\' !') ; } " & _
" if (isArray(ele)===false) { throw new Error('#Expecting array of literals but bumped into sub array \'' + JSON.stringify(ele) + '\' !') ; } " & _
" } " & _
" } " & _
"} "
soSC.AddCode "function TypeObjectByStringification(obj) { " & _
" /* return 2 for object, 1 for array, 0 for anything else */ " & _
" var obj2 = JSON.stringify(obj); " & _
" if (obj2.length<2 ) { return 0; } " & _
" var firstCh = obj2.substring(0,1);" & _
" var lastCh = obj2.substring(obj2.length-1,obj2.length);" & _
" if (firstCh=='[' && lastCh==']' ){ return 1; }" & _
" if (firstCh=='{' && lastCh=='}' ){ return 2; }" & _
" return 0;" & _
"}"
soSC.AddCode "function upgradeToObject (v, propName) { " & _
" if (TypeObjectByStringification(v)==2) { throw new Error('#Already an object!'); } " & _
" var propName2 = 'dummy' + propName;" & _
" if (propName2.length>5) { var propNameLen = propName2.length-5; propName2=propName2.substring(propName2.length-propNameLen,propName2.length); } " & _
" var oRet = {};" & _
" oRet[propName2] = v;" & _
" return oRet;" & _
" } "
soSC.AddCode "function upgradeArrayElementsToObject (arr, propName) { " & _
" if (TypeObjectByStringification(arr)!=1) { throw new Error('#Expecting an array!'); } " & _
" var newArr = JSON.parse('[]'); " & _
" " & _
" for (lLoop=0 ; lLoop < arr.length; lLoop++) { " & _
" var ele = arr[lLoop]; " & _
" if (TypeObjectByStringification(ele)!=2) { " & _
" newArr.push (upgradeToObject(ele, propName)) ; " & _
" } else { " & _
" newArr.push (JSON.parse(JSON.stringify(obj))); " & _
" } " & _
" } " & _
" return newArr; " & _
" } "
soSC.AddCode "function mergeObjects(obj1, obj2) { " & _
" if (TypeObjectByStringification(obj1)!=2) { throw new Error('#Expecting obj1 to an object!'); } " & _
" if (TypeObjectByStringification(obj2)!=2) { throw new Error('#Expecting obj2 to an object!'); } " & _
" var objMerged = JSON.parse(JSON.stringify(obj1)); " & _
" for (var i in obj2) { " & _
" objMerged[i] = JSON.parse(JSON.stringify(obj2[i])); " & _
" } " & _
" return objMerged; " & _
" } "
soSC.AddCode "function mergeEachObjectInArrays(arr1, arr2) { " & _
" if (TypeObjectByStringification(arr1)!=1) { throw new Error('#Expecting arr1 to an object!'); } " & _
" if (TypeObjectByStringification(arr2)!=1) { throw new Error('#Expecting arr2 to an object!'); } " & _
" if (arr1.length!=arr2.length) { throw new Error('#Arrays have different lengths!'); } " & _
" var newArray= JSON.parse('[]'); " & _
" for (lLoop=0 ; lLoop 1 Then
Dim bSubReturnIsObject As Boolean
bSubReturnIsObject = IsObject(JSONPath(objFirst, sNewPath, False))
If bSubReturnIsObject Then
Set JSONPath = JSONPath(objFirst, sNewPath, False)
Else
JSONPath = JSONPath(objFirst, sNewPath, False)
End If
Else
Set JSONPath = objFirst
End If
Else
Debug.Assert lCount = 1
JSONPath = VBA.CallByName(objStart, sFirst, VbGet)
End If
ElseIf sFirst = "*" Then
'* we have a wildcard
If objStart.hasOwnProperty("length") Then
Dim lLength As Long
lLength = CallByName(objStart, "length", VbGet)
Dim objJSArray As Object
Set objJSArray = SC.Run("JSON_parse", "[]")
Dim lArrayLoop As Long
For lArrayLoop = 0 To lLength - 1
Set objFirst = VBA.CallByName(objStart, CStr(lArrayLoop), VbGet)
If lCount > 1 Then
Call CallByName(objJSArray, "push", VbMethod, JSONPath(objFirst, sNewPath, False))
Else
Call CallByName(objJSArray, "push", VbMethod, objFirst)
End If
Next
Set JSONPath = objJSArray
End If
Else
Stop 'not yet handled
End If
#Else
If TypeName(SC.Run("JSONPath", objStart, sJSONPath, bCheckParams)) = "JScriptTypeInfo" Then
Set JSONPath = SC.Run("JSONPath", objStart, sJSONPath, bCheckParams)
Else
JSONPath = SC.Run("JSONPath", objStart, sJSONPath, bCheckParams)
End If
#End If
' If VBA.IsObject(JSONPath) Then
' mvMyAdviceToCaller = "JSONPath(" & sJSONPath & "):Caller needs to use Set"
' Else
' mvMyAdviceToCaller = "JSONPath(" & sJSONPath & "):Caller needs to not use Set"
' End If
'
' If Not bDoNotPrintAdviceToCaller Then
' Debug.Print mvMyAdviceToCaller
' End If
End Function
Public Function JSONPathPeriodiseSquareBrackets(ByVal sJSONPath As String) As String
'function JSONPathPeriodiseSquareBrackets(sJSONPath) {
' if (JSONPathNeedsPeriodising(sJSONPath)===true) {
' if (ValidSquareBracketsForPath(sJSONPath)===true) {
' var sWork = InsertPeriodBeforeLeftSquareBracket(sJSONPath);
' while (sWork.indexOf( "..", 1) > -1) {
' sWork = RemoveDoublePeriods( sWork);
' }
' return sWork;
' }
' else
' { return '#Bad path, please check, mismatched square brackets?!'
' }
' }
' else
' { return sJSONPath;
' }
'}
#If USEVBA Then
If JSONPathNeedsPeriodising(sJSONPath) Then
If ValidSquareBracketsForPath(sJSONPath) Then
JSONPathPeriodiseSquareBrackets = InsertPeriodBeforeLeftSquareBracket(sJSONPath)
Do While IndexOf(JSONPathPeriodiseSquareBrackets, "..", 1) > -1
DoEvents
JSONPathPeriodiseSquareBrackets = RemoveDoublePeriods(JSONPathPeriodiseSquareBrackets)
Loop
Debug.Assert IndexOf(JSONPathPeriodiseSquareBrackets, "..", 1) = -1
Else
JSONPathPeriodiseSquareBrackets = "#Bad path, please check, mismatched square brackets?!"
End If
Else
JSONPathPeriodiseSquareBrackets = sJSONPath
End If
#Else
JSONPathPeriodiseSquareBrackets = SC.Run("JSONPathPeriodiseSquareBrackets", sJSONPath)
#End If
End Function
Public Function RemoveDoublePeriods(ByVal sJSONPath As String) As String
'function RemoveDoublePeriods(sJSONPath) {
' while (sJSONPath.indexOf( '..', 1) > -1) {
' sJSONPath.replace('..','.');
' }
' return sJSONPath;
'}
#If USEVBA Then
Do While IndexOf(sJSONPath, "..", 1) > -1
DoEvents
sJSONPath = VBA.Replace(sJSONPath, "..", ".")
Loop
RemoveDoublePeriods = sJSONPath
#Else
RemoveDoublePeriods = SC.Run("RemoveDoublePeriods", sJSONPath)
#End If
End Function
Public Function InsertPeriodBeforeLeftSquareBracket(ByVal sJSONPath As String) As String
'function InsertPeriodBeforeLeftSquareBracket(sJSONPath) { return sJSONPath.replace( '[' , '.['); }
#If USEVBA Then
InsertPeriodBeforeLeftSquareBracket = VBA.Replace(sJSONPath, "[", ".[")
#Else
InsertPeriodBeforeLeftSquareBracket = SC.Run("InsertPeriodBeforeLeftSquareBracket", sJSONPath)
#End If
End Function
Public Function SubString(ByVal sExpr As String, ByVal lStart As Long, ByVal lEnd As Long)
SubString = SC.Run("subString", sExpr, lStart, lEnd)
End Function
Public Function IndexOf(ByVal sExpr As String, ByVal sSearchvalue As String, lStart As Long)
IndexOf = SC.Run("indexOf", sExpr, sSearchvalue, lStart)
End Function
Public Function JSONPathNeedsPeriodising(ByVal sJSONPath As String) As Boolean
'function JSONPathNeedsPeriodising(sJSONPath) {
' var lLeftSquareBracket=GetNextLeftSquareBracket(sJSONPath,1);
' while (lLeftSquareBracket>1) {
' var sCharPrevChar = CharAndPrevChar(sJSONPath, lLeftSquareBracket)
' if (!CheckCharAndPrevChar ( sCharPrevChar) ) {
' return true;
' }
' lLeftSquareBracket=GetNextLeftSquareBracket(sJSONPath,lLeftSquareBracket + 1);
' }
' return false;
'}
#If USEVBA Then
Dim lLeftSquareBracket As Long
lLeftSquareBracket = GetNextLeftSquareBracket(sJSONPath, 1)
Do While lLeftSquareBracket > 1
DoEvents
Dim sCharPrevChar As String
sCharPrevChar = CharAndPrevChar(sJSONPath, lLeftSquareBracket)
If Not CheckCharAndPrevChar(sCharPrevChar) Then
JSONPathNeedsPeriodising = True
Exit Function
End If
lLeftSquareBracket = GetNextLeftSquareBracket(sJSONPath, lLeftSquareBracket + 1)
Loop
#Else
JSONPathNeedsPeriodising = SC.Run("JSONPathNeedsPeriodising", sJSONPath)
#End If
End Function
Public Function IsErrorMessage(ByVal sExpr As String) As Boolean
'function IsErrorMessage ( sExpr ) {
' var lLen = sExpr.length;
' return ((sExpr.substring( 0, 1) === '#') && (sExpr.substring( lLen - 1, lLen) === '!'));
'}
#If USEVBA Then
Dim lLen As Long
lLen = Len(sExpr)
IsErrorMessage = SubString(sExpr, 0, 1) = "#" And SubString(sExpr, lLen - 1, lLen) = "!"
#Else
IsErrorMessage = SC.Run("IsErrorMessage", sExpr)
#End If
End Function
Public Function GetNextLeftSquareBracket(ByVal sJSONPath As String, ByVal lStart As Long) As Long
'function GetNextLeftSquareBracket ( sJSONPath , lStart ) {
' return sJSONPath.indexOf('[',lStart);
'}
#If USEVBA Then
GetNextLeftSquareBracket = VBA.InStr(lStart, sJSONPath, "[", vbTextCompare)
#Else
GetNextLeftSquareBracket = SC.Run("GetNextLeftSquareBracket", sJSONPath, lStart)
#End If
End Function
Public Function CheckCharAndPrevChar(ByVal sCharAndPrevChar As String) As Boolean
'function CheckCharAndPrevChar( sCharAndPrevChar ) {
' if (sCharAndPrevChar.length===1) {
' return (sCharAndPrevChar === '[') ; } else {
' return (sCharAndPrevChar === '.[') ;
' }
'}
#If USEVBA Then
If Len(sCharAndPrevChar) = 1 Then
CheckCharAndPrevChar = (sCharAndPrevChar = "[")
Else
CheckCharAndPrevChar = (sCharAndPrevChar = ".[")
End If
#Else
CheckCharAndPrevChar = SC.Run("CheckCharAndPrevChar", sCharAndPrevChar)
#End If
End Function
Public Function CharAndPrevChar(ByVal sJSONPath As String, ByVal lCharAt As Long) As String
'function CharAndPrevChar(sJSONPath , lCharAt) {
' if (lCharAt===1) {
' return sJSONPath.substring(0,1); } else {
' return (sJSONPath.substring(lCharAt-1,lCharAt));
' }
'}
#If USEVBA Then
If lCharAt = 1 Then
CharAndPrevChar = Left$(sJSONPath, 1)
Else
CharAndPrevChar = Mid$(sJSONPath, lCharAt - 1, 2)
End If
#Else
CharAndPrevChar = SC.Run("CharAndPrevChar", sJSONPath, lCharAt)
#End If
End Function
Public Function LeftSquareIsMissingAdjacentPeriod(ByVal sJSONPath As String, ByVal lLeftSquareBracket As Long) As Boolean
'function LeftSquareIsMissingAdjacentPeriod(sJSONPath , lLeftSquareBracket) {
' if (lLeftSquareBracket===1) { return true; } else {
' return (sJSONPath.substring(lLeftSquareBracket-1,lLeftSquareBracket)<>'.');
' }
'}
#If USEVBA Then
If lLeftSquareBracket = 1 Then
LeftSquareIsMissingAdjacentPeriod = True
Else
LeftSquareIsMissingAdjacentPeriod = (Mid$(sJSONPath, lLeftSquareBracket - 1, 1) <> ".")
End If
#Else
LeftSquareIsMissingAdjacentPeriod = SC.Run("LeftSquareIsMissingAdjacentPeriod", sJSONPath, lLeftSquareBracket)
#End If
End Function
Public Function ExtractSquareBrackets(ByVal sExpr As String) As String
'function ExtractSquareBrackets(sExpr) {
' if (HasSquareBrackets(sExpr)===true) {
' if (sExpr.substring(0,1)==='[') {
' if (sExpr.substring(sExpr.length-1, sExpr.length)===']') {
' return sExpr.substring(1, sExpr.length-1);
' }
' }
' } else { return sExpr ; }
'}
'* assumes post periodisation
#If USEVBA Then
If HasSquareBrackets(sExpr) Then
If Left$(sExpr, 1) = "[" Then
If Right$(sExpr, 1) = "]" Then
ExtractSquareBrackets = Mid$(sExpr, 2, Len(sExpr) - 2)
Exit Function
End If
End If
Else
ExtractSquareBrackets = sExpr
End If
#Else
ExtractSquareBrackets = SC.Run("ExtractSquareBrackets", sExpr)
#End If
End Function
Public Function HasSquareBrackets(ByVal sExpr As String) As Boolean
'function HasSquareBrackets(sExpr) { return (ValidSquareBrackets(sExpr) === 1); }"
'* assumes post periodisation
#If USEVBA Then
'* assumes post periodisation
HasSquareBrackets = (ValidSquareBrackets(sExpr) = 1)
#Else
HasSquareBrackets = SC.Run("HasSquareBrackets", sExpr)
#End If
End Function
Public Function ValidSquareBracketsForPath(ByVal sPath As String) As Boolean
'function ValidSquareBracketsForPath(sPath) {
' var vSplit=sPath.split('.'); var bAllPathSgementsAreValid=true;
' for (i = 0; i < vSplit.length; i++) {
' var vSplitLoop=vSplit[i];
' var lMatchedBracketCount = ValidSquareBrackets(vSplitLoop);
' var bValid = (lMatchedBracketCount === 0 || lMatchedBracketCount === 1);
' bAllPathSgementsAreValid = bAllPathSgementsAreValid && bValid;
' }
' return bAllPathSgementsAreValid;
'}
'* returns true of false, checks each segment
#If USEVBA Then
Dim vSplit As Variant
vSplit = VBA.Split(sPath, ".")
Dim bAllPathSgementsAreValid As Boolean
bAllPathSgementsAreValid = True '* until proven otherwise
Dim vSplitLoop As Variant
For Each vSplitLoop In vSplit
Dim lMatchedBracketCount As Long
lMatchedBracketCount = ValidSquareBrackets(vSplitLoop)
Dim bValid As Boolean
bValid = (lMatchedBracketCount = 0 Or lMatchedBracketCount = 1)
bAllPathSgementsAreValid = bAllPathSgementsAreValid And bValid
Next vSplitLoop
ValidSquareBracketsForPath = bAllPathSgementsAreValid
#Else
ValidSquareBracketsForPath = SC.Run("ValidSquareBracketsForPath", sPath)
#End If
End Function
Public Function ValidSquareBrackets(ByVal sExpr As String) As Long
'function ValidSquareBrackets(sExpr) {
' var lCountLeftBrackets = CountLeftBrackets(sExpr); var lCountRightBrackets = CountRightBrackets(sExpr);
' if (lCountLeftBrackets!==lCountRightBrackets) { return -1; } else {
' if (lCountLeftBrackets===0 || lCountRightBrackets===1) { return lCountLeftBrackets;} else { return -1;}
' }}
'* returns either 0 or 1, or negative number
'* 0 or 1 means either 0 or 1 pair of matched square brackets
'* negative number means mismatch or more than 1 pair of matched brackets
#If USEVBA Then
Dim lReturn As Long
Dim lCountLeftBrackets As Long
lCountLeftBrackets = CountLeftBrackets(sExpr)
Dim lCountRightBrackets As Long
lCountRightBrackets = CountRightBrackets(sExpr)
If lCountLeftBrackets <> lCountRightBrackets Then
lReturn = -2 ^ 30
Else
Dim bValid As Boolean
bValid = (lCountLeftBrackets = 0 Or lCountLeftBrackets = 1)
If bValid Then
lReturn = lCountLeftBrackets
Else
lReturn = -2 ^ 30
End If
End If
ValidSquareBrackets = lReturn
#Else
ValidSquareBrackets = SC.Run("ValidSquareBrackets", sExpr)
#End If
End Function
Public Function CountLeftBrackets(ByVal sExpr As String) As Long
#If USEVBA Then
CountLeftBrackets = CountChars(sExpr, "[")
#Else
CountLeftBrackets = SC.Run("CountLeftBrackets", sExpr)
#End If
End Function
Public Function CountRightBrackets(ByVal sExpr As String) As Long
#If USEVBA Then
CountRightBrackets = CountChars(sExpr, "]")
#Else
CountRightBrackets = SC.Run("CountRightBrackets", sExpr)
#End If
End Function
Private Function CountChars(ByVal sExpr As String, ByVal sChar As String) As Long
Dim vSplit As Variant
vSplit = VBA.Split(sExpr, sChar)
CountChars = (UBound(vSplit) - LBound(vSplit))
End Function
Public Function IsNothing(ByVal objStart As Object) As Boolean
IsNothing = SC.Run("IsNothing", objStart)
End Function
Public Function JSONPathCheckParams2(ByVal objStart As Object, ByVal sJSONPath As String) As String
JSONPathCheckParams2 = SC.Run("JSONPathCheckParams", objStart, sJSONPath)
End Function
Public Function SegmentCount(ByVal sPath As String) As String
SegmentCount = SC.Run("segmentCount", sPath)
End Function
Public Function FirstSegment(ByVal sPath As String) As String
FirstSegment = SC.Run("firstSegment", sPath)
End Function
Public Function EatFirstSegment(ByVal sPath As String)
EatFirstSegment = SC.Run("eatFirstSegment", sPath)
End Function
Public Function ArraysOfObjectsMergeProperties(ByVal objLeftArray As Object, ByVal objRightArray As Object) As Object
Dim plLength As Long: plLength = 0
If ArraysEqualLength(objLeftArray, objRightArray, plLength) Then
Dim objNewArray As Object
Set objNewArray = SC.Run("JSON_parse", "[]")
Dim lLoop As Long
For lLoop = 0 To plLength - 1
If Not IsObject(CallByName(objLeftArray, CStr(lLoop), VbGet)) Then
Err.Raise vbObjectError, , "#Expecting left arrays of objects, upgrade literals to objects!"
End If
If Not IsObject(CallByName(objRightArray, CStr(lLoop), VbGet)) Then
Err.Raise vbObjectError, , "#Expecting right arrays of objects, upgrade literals to objects!"
End If
Dim objMerged As Object
Set objMerged = ObjectsMergeProperties(CallByName(objLeftArray, CStr(lLoop), VbGet), CallByName(objRightArray, CStr(lLoop), VbGet))
Call CallByName(objNewArray, "push", VbMethod, objMerged)
Next
Set ArraysOfObjectsMergeProperties = objNewArray
End If
End Function
Public Function ObjectsMergeProperties(ByVal objLeft As Object, ByVal objRight As Object) As Object
Dim objMergedObject As Object
Set objMergedObject = SC.Run("JSON_parse", "{}")
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
Call SC.Run("enumKeysToMsDict", objLeft, dic)
Dim vKeyLoop As Variant
For Each vKeyLoop In dic.Keys
Call SC.Run("setValueByKey", objMergedObject, vKeyLoop, CallByName(objLeft, vKeyLoop, VbGet))
Next vKeyLoop
dic.RemoveAll
Call SC.Run("enumKeysToMsDict", objRight, dic)
For Each vKeyLoop In dic.Keys
Call SC.Run("setValueByKey", objMergedObject, vKeyLoop, CallByName(objRight, vKeyLoop, VbGet))
Next vKeyLoop
Set ObjectsMergeProperties = objMergedObject
End Function
Public Function ArraysEqualLength(ByVal obj1 As Object, ByVal obj2 As Object, ByRef plLength As Long) As Boolean
Dim v(1 To 2) As Variant
v(1) = ArrayGetLength(obj1)
v(2) = ArrayGetLength(obj2)
If (Not IsEmpty(v(1))) And (Not IsEmpty(v(2))) Then
If v(1) = v(2) Then
plLength = v(2)
ArraysEqualLength = True
End If
End If
End Function
Public Function JSONPathCheckParams(ByVal objStart As Object, ByVal sJSONPath As String) As String
#If USEVBA Then
'Debug.Assert Not objStart Is Nothing
If objStart Is Nothing Then
JSONPathCheckParams = "#Null objStart!"
Exit Function
End If
If Len(sJSONPath) = 0 Then
JSONPathCheckParams = "#Null sJSONPath!"
Exit Function
End If
'* periodised path is required
JSONPathCheckParams = JSONPathPeriodiseSquareBrackets(sJSONPath)
'If IsErrorMessage(sJSONPath) Then
' JSONPathCheckParams = sJSONPath
' Exit Function
'End If
#Else
JSONPathCheckParams = SC.Run("JSONPathCheckParams", objStart, sJSONPath)
#End If
End Function
Public Function JSONParsePath(ByVal sJSONPath As String) As Object
#If USEVBA Then
Dim objReturn As Object
Set objReturn = SC.Run("JSON_parse", "{}")
Dim lCount As Long, sFirst As String, sNewPath As String
lCount = SegmentCount(sJSONPath)
sFirst = FirstSegment(sJSONPath)
sNewPath = EatFirstSegment(sJSONPath)
Call SC.Run("setValueByKey", objReturn, "lCount", lCount)
Call SC.Run("setValueByKey", objReturn, "sNewPath", sNewPath)
Dim bSquareBrackets As Boolean
bSquareBrackets = HasSquareBrackets(sFirst)
If bSquareBrackets Then
sFirst = ExtractSquareBrackets(sFirst)
End If
Call SC.Run("setValueByKey", objReturn, "sFirst", sFirst)
Set JSONParsePath = objReturn
#Else
Set JSONParsePath = SC.Run("JSONParsePath", sJSONPath)
#End If
End Function
'Public Function ParseSquareBrackets(ByRef sExpr As String) As Boolean
' 'function ParseSquareBrackets(sExpr) {
' ' sExpr = Trim(sExpr);
' ' var lMatchedBracketCount = ValidSquareBrackets(sExpr);
' ' if (lMatchedBracketCount==0 } {return true; }
' ' if (lMatchedBracketCount==1) {
' ' If (sExpr.substring(1,1) === '[') {
' '
' ' }
' ' }
' ' return false;
' '}
'
'
'
' #If USEVBA Then
' sExpr = Trim(sExpr)
'
' Dim lMatchedBracketCount As Long
' lMatchedBracketCount = ValidSquareBrackets(sExpr)
' If lMatchedBracketCount = 0 Then
' ParseSquareBrackets = True: Exit Function
' End If
'
' If lMatchedBracketCount = 1 Then
' '* expecting path to have periodised so if square brackets exists then of the form []
' If Left$(sExpr, 1) = "[" Then
'
' If Right$(sExpr, 1) = "]" Then
' sExpr = Mid$(sExpr, 2, Len(sExpr) - 2)
' ParseSquareBrackets = True
' Exit Function
' End If
' End If
' End If
'
'
'' If lMatchedBracketCount = 0 Or lMatchedBracketCount = 1 Then
'' ElseIf lMatchedBracketCount = 0 Then
'' ParseSquareBrackets = True
'' Else
'' ParseSquareBrackets = False
'' End If
'' End If
' #Else
' ParseSquareBrackets = SC.Run("ParseSquareBrackets", sExpr)
' #End If
'
'End Function
'Public Function ArrayOfLiteralsUpgradeToObjects(ByVal objArray As Object, ByVal sLiteralsProperyName As String) As Object
'
' #If USEVBA Then
' Dim vLength As Variant
' vLength = ArrayGetLength(objArray)
'
' Dim objNewArray As Object
' Set objNewArray = SC.Run("JSON_parse", "[]")
'
' If Not IsEmpty(vLength) Then
'
' Dim lLength As Long
' lLength = CLng(vLength)
' Dim lLoop As Long
' For lLoop = 0 To lLength - 1
'
' If IsObject(CallByName(objArray, CStr(lLoop), VbGet)) Then
' Err.Raise vbObjectError, , "#Expecting literals only!"
' End If
'
' Dim vLiteralElement As Variant
' vLiteralElement = CallByName(objArray, CStr(lLoop), VbGet)
'
' Dim objNewObject As Object
' If IsNumeric(vLiteralElement) Then
' Set objNewObject = SC.Run("JSON_parse", "{""" & sLiteralsProperyName & """:" & vLiteralElement & "}")
' Else
'
' Set objNewObject = SC.Run("JSON_parse", "{""" & sLiteralsProperyName & """:""" & vLiteralElement & """}")
' End If
' Call CallByName(objNewArray, "push", VbMethod, objNewObject)
'
' Next
' End If
' Set ArrayOfLiteralsUpgradeToObjects = objNewArray
'
'
' #Else
' Set ArrayOfLiteralsUpgradeToObjects = SC.Run("ArrayOfLiteralsUpgradeToObjects", objArray, sLiteralsProperyName)
' #End If
'End Function
'Private Function ArrayGetLength(ByVal obj As Object) As Variant
' If obj.hasOwnProperty("length") Then
' ArrayGetLength = CallByName(obj, "length", VbGet)
' End If
'
'End Function
Option Explicit
Option Private Module
'* module name: tstJSONPath
'* module type: standard
'* purpose: tests, unit tests, real life use cases
'* Version: 0.01
'* Date: 19 Jan 2018 20:19
'* Author: S Meaden
'* TODO:
'* Tools->References
'MSScriptControl Microsoft Script Control 1.0 C:\Windows\SysWOW64\msscript.ocx
'Scripting Microsoft Scripting Runtime C:\Windows\SysWOW64\scrrun.dll
'MSXML2 Microsoft XML, v6.0 C:\Windows\SysWOW64\msxml6.dll
Private Sub TestAll()
'End
TestCountLeftBrackets
TestCountRightBrackets
TestJSONPath
TestJSONPath0
TestJSONPathArrayWildcard0
TestJSONPathArrayWildcard1
TestJSONPathArrayWildcard2
TestJSONPathNeedsPeriodising
TestJSONPathPeriodiseSquareBrackets
TestNonObjectReturn
TestHasSquareBrackets
TestExtractSquareBrackets
'TestParseSquareBrackets
TestValidSquareBrackets
TestValidSquareBracketsForPath
End Sub
Sub TestMergeObjects()
Dim oSC As Object
Set oSC = modJSONPath.JsonPathSC
Dim obj1 As Object
Set obj1 = oSC.Run("JSON_parse", "{""a"":1}")
Dim obj2 As Object
Set obj2 = oSC.Run("JSON_parse", "{""b"":2}")
Dim objMerged As Object
Set objMerged = MergeObjects(obj1, obj2)
Debug.Assert objMerged.hasOwnProperty("a")
Debug.Assert objMerged.hasOwnProperty("b")
Debug.Assert CallByName(objMerged, "a", VbGet) = 1
Debug.Assert CallByName(objMerged, "b", VbGet) = 2
'Stop
End Sub
Private Sub TestRealLifeTest2()
'* get the title and url from the given test string
Dim oSC As Object
Set oSC = modJSONPath.JsonPathSC
Dim lHeavyLooping As Long
For lHeavyLooping = 1 To 1 '100
Dim obj As Object
Set obj = oSC.Run("JSON_parse", SimpleMasterPage)
Dim objTitles As Object
Set objTitles = JSONPath(obj, "feed.entry[*].title.$t", True)
Dim objTitlesUpgraded As Object
Set objTitlesUpgraded = UpgradeArrayElementsToObject(objTitles, "title")
Dim objHrefs As Object
Set objHrefs = JSONPath(obj, "feed.entry[*].link.[0].href", True)
Dim objHrefsUpgraded As Object
Set objHrefsUpgraded = UpgradeArrayElementsToObject(objHrefs, "href")
Dim objMergedArray As Object
Set objMergedArray = MergeEachObjectInArrays(objTitlesUpgraded, objHrefsUpgraded)
Next lHeavyLooping
Stop
End Sub
Private Sub TestUpgradeArrayElementsToObject()
Dim oSC As Object
Set oSC = modJSONPath.JsonPathSC
Dim obj As Object
Set obj = oSC.Run("JSON_parse", "[1,2,3,4]")
Dim obj2 As Object
Set obj2 = UpgradeArrayElementsToObject(obj, "goals")
Debug.Assert VBA.IsObject(CallByName(obj2, "0", VbGet))
Debug.Assert VBA.IsObject(CallByName(obj2, "1", VbGet))
Debug.Assert VBA.IsObject(CallByName(obj2, "2", VbGet))
Debug.Assert VBA.IsObject(CallByName(obj2, "3", VbGet))
Debug.Assert CallByName(obj2, "0", VbGet).hasOwnProperty("goals")
Debug.Assert CallByName(obj2, "1", VbGet).hasOwnProperty("goals")
Debug.Assert CallByName(obj2, "2", VbGet).hasOwnProperty("goals")
Debug.Assert CallByName(obj2, "3", VbGet).hasOwnProperty("goals")
Debug.Assert CallByName(CallByName(obj2, "0", VbGet), "goals", VbGet) = 1
Debug.Assert CallByName(CallByName(obj2, "1", VbGet), "goals", VbGet) = 2
Debug.Assert CallByName(CallByName(obj2, "2", VbGet), "goals", VbGet) = 3
Debug.Assert CallByName(CallByName(obj2, "3", VbGet), "goals", VbGet) = 4
End Sub
Private Sub TestUpgradeToObject()
Dim oSC As Object
Set oSC = modJSONPath.JsonPathSC
Dim obj1Upgraded As Object
Set obj1Upgraded = UpgradeToObject(1, "foo")
Debug.Assert VBA.IsObject(obj1Upgraded)
Debug.Assert CallByName(obj1Upgraded, "foo", VbGet) = 1
Set obj1Upgraded = UpgradeToObject(1, "bar")
Debug.Assert VBA.IsObject(obj1Upgraded)
Debug.Assert CallByName(obj1Upgraded, "bar", VbGet) = 1
Set obj1Upgraded = UpgradeToObject(1, "")
Debug.Assert VBA.IsObject(obj1Upgraded)
Debug.Assert CallByName(obj1Upgraded, "dummy", VbGet) = 1
Set obj1Upgraded = UpgradeToObject(False, "foo")
Debug.Assert VBA.IsObject(obj1Upgraded)
Debug.Assert CallByName(obj1Upgraded, "foo", VbGet) = False
Set obj1Upgraded = UpgradeToObject("Hello world", "foo")
Debug.Assert VBA.IsObject(obj1Upgraded)
Debug.Assert CallByName(obj1Upgraded, "foo", VbGet) = "Hello world"
Set obj1Upgraded = UpgradeToObject("Hello world", "")
Debug.Assert VBA.IsObject(obj1Upgraded)
Debug.Assert CallByName(obj1Upgraded, "dummy", VbGet) = "Hello world"
Dim objAlreadyAnObject As Object
Set objAlreadyAnObject = oSC.Run("JSON_parse", "{""a"":1}")
Dim objAlreadyAnObjectUpgraded As Object
On Error Resume Next
Set objAlreadyAnObjectUpgraded = UpgradeToObject(objAlreadyAnObject, "foo")
Dim sSavedError As String
sSavedError = Err.Description
On Error GoTo 0
Debug.Assert sSavedError = "#Already an object!"
End Sub
Private Sub TestTypeObjectByStringification()
Dim oSC As Object
Set oSC = modJSONPath.JsonPathSC
Dim objArr As Object
Set objArr = oSC.Run("JSON_parse", "[1,2,3,4]")
Debug.Assert TypeObjectByStringification(objArr) = 1
Dim obj As Object
Set obj = oSC.Run("JSON_parse", "{""a"":1}")
Debug.Assert TypeObjectByStringification(obj) = 2
Debug.Assert TypeObjectByStringification("foo") = 0
Debug.Assert TypeObjectByStringification(False) = 0
Debug.Assert TypeObjectByStringification(True) = 0
Debug.Assert TypeObjectByStringification(1) = 0
Debug.Assert TypeObjectByStringification(1.5) = 0
End Sub
Private Sub TestIsArray()
Dim oSC As Object
Set oSC = modJSONPath.JsonPathSC
Dim obj As Object
Set obj = oSC.Run("JSON_parse", "[1,2,3,4]")
Debug.Assert IsArray(obj)
Stop
End Sub
Private Sub TestIsObject()
Debug.Assert IsObject(1) = False
Debug.Assert IsObject(Nothing) = False
Debug.Assert IsObject("hello") = False
Debug.Assert IsObject(True) = False
Debug.Assert IsObject(1.5) = False
End Sub
Private Sub TestJSONPath()
TestJSONPath0
TestJSONPathArrayWildcard0
TestJSONPathArrayWildcard1
TestJSONPathArrayWildcard2
End Sub
Private Sub TestJSONPathArrayWildcard2()
Dim oSC As Object
Set oSC = modJSONPath.JsonPathSC
Dim obj As Object
Set obj = oSC.Run("JSON_parse", SimpleMasterPage)
Dim objExpected(0 To 2) As Object
Set objExpected(0) = CallByName(CallByName(CallByName(CallByName(obj, "feed", VbGet), "entry", VbGet), "0", VbGet), "title", VbGet)
Set objExpected(1) = CallByName(CallByName(CallByName(CallByName(obj, "feed", VbGet), "entry", VbGet), "1", VbGet), "title", VbGet)
Set objExpected(2) = CallByName(CallByName(CallByName(CallByName(obj, "feed", VbGet), "entry", VbGet), "2", VbGet), "title", VbGet)
Dim objExpectedArray As Object
Set objExpectedArray = oSC.Run("JSON_parse", "[]")
Call CallByName(objExpectedArray, "push", VbMethod, CallByName(objExpected(0), "$t", VbGet))
Call CallByName(objExpectedArray, "push", VbMethod, CallByName(objExpected(1), "$t", VbGet))
Call CallByName(objExpectedArray, "push", VbMethod, CallByName(objExpected(2), "$t", VbGet))
Dim objObserved As Object
Set objObserved = JSONPath(obj, "feed.entry[*].title.$t", True)
Debug.Assert oSC.Run("JSON_stringify", objExpectedArray) = oSC.Run("JSON_stringify", objObserved)
End Sub
Private Sub TestFirstSegment()
Debug.Assert FirstSegment("feed") = "feed"
'Debug.Assert FirstSegment("feed.entry") = "entry"
Debug.Assert FirstSegment("entry.[*]") = "entry"
'Debug.Assert FirstSegment("feed.entry.[*].title") = "entry.[*].title"
'Debug.Assert FirstSegment("feed.entry.[*].title.$t") = "entry.[*].title.$t"
End Sub
Private Sub TestEatFirstSegment()
Debug.Assert EatFirstSegment("feed") = ""
Debug.Assert EatFirstSegment("feed.entry") = "entry"
Debug.Assert EatFirstSegment("feed.entry.[*]") = "entry.[*]"
Debug.Assert EatFirstSegment("feed.entry.[*].title") = "entry.[*].title"
Debug.Assert EatFirstSegment("feed.entry.[*].title.$t") = "entry.[*].title.$t"
End Sub
Private Sub TestSegmentCount()
Debug.Assert SegmentCount("") = 0
Debug.Assert SegmentCount("feed") = 1
Debug.Assert SegmentCount("feed.entry") = 2
Debug.Assert SegmentCount("feed.entry.[*]") = 3
Debug.Assert SegmentCount("feed.entry.[*].title") = 4
Debug.Assert SegmentCount("feed.entry.[*].title.$t") = 5
End Sub
Private Sub TestJSONParsePath()
Dim obj As Object
Set obj = JSONParsePath("feed")
Debug.Assert VBA.CallByName(obj, "lCount", VbGet) = 1
Debug.Assert VBA.CallByName(obj, "sNewPath", VbGet) = ""
Debug.Assert VBA.CallByName(obj, "sFirst", VbGet) = "feed"
Set obj = JSONParsePath("feed.entry")
Debug.Assert VBA.CallByName(obj, "lCount", VbGet) = 2
Debug.Assert VBA.CallByName(obj, "sNewPath", VbGet) = "entry"
Debug.Assert VBA.CallByName(obj, "sFirst", VbGet) = "feed"
Set obj = JSONParsePath("feed.entry.[*]")
Debug.Assert VBA.CallByName(obj, "lCount", VbGet) = 3
Debug.Assert VBA.CallByName(obj, "sNewPath", VbGet) = "entry.[*]"
Debug.Assert VBA.CallByName(obj, "sFirst", VbGet) = "feed"
Set obj = JSONParsePath("feed.entry.[*].title")
Debug.Assert VBA.CallByName(obj, "lCount", VbGet) = 4
Debug.Assert VBA.CallByName(obj, "sNewPath", VbGet) = "entry.[*].title"
Debug.Assert VBA.CallByName(obj, "sFirst", VbGet) = "feed"
Set obj = JSONParsePath("feed.entry.[*].title.$t")
Debug.Assert VBA.CallByName(obj, "lCount", VbGet) = 5
Debug.Assert VBA.CallByName(obj, "sNewPath", VbGet) = "entry.[*].title.$t"
Debug.Assert VBA.CallByName(obj, "sFirst", VbGet) = "feed"
Set obj = JSONParsePath("[*].title.$t")
Debug.Assert VBA.CallByName(obj, "lCount", VbGet) = 3
Debug.Assert VBA.CallByName(obj, "sNewPath", VbGet) = "title.$t"
Debug.Assert VBA.CallByName(obj, "sFirst", VbGet) = "*"
'Stop
End Sub
Private Sub TestJSONPathArrayWildcard1()
Dim oSC As Object
Set oSC = modJSONPath.JsonPathSC
Dim obj As Object
Set obj = oSC.Run("JSON_parse", SimpleMasterPage)
Dim objExpected(0 To 2) As Object
Set objExpected(0) = CallByName(CallByName(CallByName(CallByName(obj, "feed", VbGet), "entry", VbGet), "0", VbGet), "title", VbGet)
Set objExpected(1) = CallByName(CallByName(CallByName(CallByName(obj, "feed", VbGet), "entry", VbGet), "1", VbGet), "title", VbGet)
Set objExpected(2) = CallByName(CallByName(CallByName(CallByName(obj, "feed", VbGet), "entry", VbGet), "2", VbGet), "title", VbGet)
Dim objExpectedArray As Object
Set objExpectedArray = oSC.Run("JSON_parse", "[]")
Call CallByName(objExpectedArray, "push", VbMethod, objExpected(0))
Call CallByName(objExpectedArray, "push", VbMethod, objExpected(1))
Call CallByName(objExpectedArray, "push", VbMethod, objExpected(2))
Dim objObserved As Object
Set objObserved = JSONPath(obj, "feed.entry[*].title", True)
Debug.Assert oSC.Run("JSON_stringify", objExpectedArray) = oSC.Run("JSON_stringify", objObserved)
End Sub
Private Sub TestJSONPathCheckParams()
Debug.Assert JSONPathCheckParams2(Nothing, "") = "#Null objStart!"
Debug.Assert JSONPathCheckParams2(Nothing, "foo") = "#Null objStart!"
Debug.Assert JSONPathCheckParams2(ThisDocument, "foo") = "foo"
Debug.Assert JSONPathCheckParams2(ThisDocument, "") = "#Null sJSONPath!"
Debug.Assert JSONPathCheckParams2(ThisDocument, "foo[2]") = "foo.[2]"
End Sub
Private Sub TestIsNothing()
Debug.Assert IsNothing(Nothing)
Debug.Assert IsNothing(ThisDocument) = False
'Debug.Assert IsNothing(0)
End Sub
Private Sub TestJSONPathArrayWildcard0()
Dim oSC As Object
Set oSC = modJSONPath.JsonPathSC
Dim obj As Object
Set obj = oSC.Run("JSON_parse", SimpleMasterPage)
Dim objExpected(0 To 2) As Object
Set objExpected(0) = CallByName(CallByName(CallByName(obj, "feed", VbGet), "entry", VbGet), "0", VbGet)
Set objExpected(1) = CallByName(CallByName(CallByName(obj, "feed", VbGet), "entry", VbGet), "1", VbGet)
Set objExpected(2) = CallByName(CallByName(CallByName(obj, "feed", VbGet), "entry", VbGet), "2", VbGet)
Dim objExpectedArray As Object
Set objExpectedArray = oSC.Run("JSON_parse", "[]")
Call CallByName(objExpectedArray, "push", VbMethod, objExpected(0))
Call CallByName(objExpectedArray, "push", VbMethod, objExpected(1))
Call CallByName(objExpectedArray, "push", VbMethod, objExpected(2))
Dim objObserved As Object
Set objObserved = JSONPath(obj, "feed.entry[*]", True)
Debug.Assert oSC.Run("JSON_stringify", objExpectedArray) = oSC.Run("JSON_stringify", objObserved)
End Sub
Private Sub TestNonObjectReturn()
Dim oSC As Object
Set oSC = modJSONPath.JsonPathSC
Dim obj As Object
Set obj = oSC.Run("JSON_parse", SimpleMasterPage)
Dim objExpectedTitleObject As Object
Set objExpectedTitleObject = CallByName(CallByName(CallByName(CallByName(obj, "feed", VbGet), "entry", VbGet), "0", VbGet), "title", VbGet)
Dim vExpectedTDollar As Variant
vExpectedTDollar = CallByName(objExpectedTitleObject, "$t", VbGet)
Dim vObservedTDollar As Variant
vObservedTDollar = JSONPath(objExpectedTitleObject, "$t", True)
Debug.Assert vExpectedTDollar = vObservedTDollar
Debug.Assert oSC.Run("JSON_stringify", vExpectedTDollar) = oSC.Run("JSON_stringify", vObservedTDollar)
End Sub
Private Sub TestJSONPath0()
Dim oSC As Object
Set oSC = modJSONPath.JsonPathSC
Dim obj As Object
Set obj = oSC.Run("JSON_parse", SimpleMasterPage)
Dim objExpected As Object
Dim objObserved As Object
Set objExpected = CallByName(obj, "feed", VbGet)
Set objObserved = JSONPath(obj, "feed", True)
Debug.Assert oSC.Run("JSON_stringify", objExpected) = oSC.Run("JSON_stringify", objObserved)
Set objExpected = CallByName(CallByName(obj, "feed", VbGet), "entry", VbGet)
Set objObserved = JSONPath(obj, "feed.entry", True)
Debug.Assert oSC.Run("JSON_stringify", objExpected) = oSC.Run("JSON_stringify", objObserved)
Set objExpected = CallByName(CallByName(CallByName(obj, "feed", VbGet), "entry", VbGet), "0", VbGet)
Set objObserved = JSONPath(obj, "feed.entry[0]", True)
Debug.Assert oSC.Run("JSON_stringify", objExpected) = oSC.Run("JSON_stringify", objObserved)
End Sub
Private Sub TestIsErrorMessage()
Debug.Assert modJSONPath.IsErrorMessage("#boo!")
Debug.Assert modJSONPath.IsErrorMessage("#boo") = False
Debug.Assert modJSONPath.IsErrorMessage("boo!") = False
Debug.Assert modJSONPath.IsErrorMessage("boo") = False
End Sub
'Private Sub TestRemoveDoublePeriod()
' Debug.Assert modJSONPath.RemoveDoublePeriod("foo..") = "foo."
' Debug.Assert modJSONPath.RemoveDoublePeriod("..") = "."
' Debug.Assert modJSONPath.RemoveDoublePeriod("...") = ".."
'
'End Sub
Private Sub TestRemoveDoublePeriods()
Debug.Assert modJSONPath.RemoveDoublePeriods("foo..") = "foo."
Debug.Assert modJSONPath.RemoveDoublePeriods("foo..bar..baz") = "foo.bar.baz"
Debug.Assert modJSONPath.RemoveDoublePeriods("foo.[].bar..[]") = "foo.[].bar.[]"
'
End Sub
Private Sub TestInsertPeriodBeforeLeftSquareBracket()
Debug.Assert modJSONPath.InsertPeriodBeforeLeftSquareBracket("foo[].bar[]") = "foo.[].bar.[]"
Debug.Assert modJSONPath.InsertPeriodBeforeLeftSquareBracket("foo[].bar.[]") = "foo.[].bar..[]"
End Sub
Private Sub TestJSONPathPeriodiseSquareBrackets()
Debug.Assert modJSONPath.JSONPathPeriodiseSquareBrackets("foo") = "foo"
Debug.Assert modJSONPath.JSONPathPeriodiseSquareBrackets("foo[]") = "foo.[]"
Debug.Assert modJSONPath.JSONPathPeriodiseSquareBrackets("foo.bar") = "foo.bar"
Debug.Assert modJSONPath.JSONPathPeriodiseSquareBrackets("foo.bar[]") = "foo.bar.[]"
Debug.Assert modJSONPath.JSONPathPeriodiseSquareBrackets("foo[].bar[]") = "foo.[].bar.[]"
Debug.Assert modJSONPath.JSONPathPeriodiseSquareBrackets("foo[].bar[].barry[]") = "foo.[].bar.[].barry.[]"
Debug.Assert modJSONPath.JSONPathPeriodiseSquareBrackets("foo[].bar[].barry") = "foo.[].bar.[].barry"
Debug.Assert modJSONPath.JSONPathPeriodiseSquareBrackets("foo.bar[].barry") = "foo.bar.[].barry"
Debug.Assert modJSONPath.JSONPathPeriodiseSquareBrackets("feed.entry[*].link.[0]") = ("feed.entry.[*].link.[0]")
End Sub
Private Sub TestValidSquareBracketsForPath()
Debug.Assert ValidSquareBracketsForPath("foo")
Debug.Assert ValidSquareBracketsForPath("foo[]")
Debug.Assert ValidSquareBracketsForPath("foo.bar")
Debug.Assert ValidSquareBracketsForPath("foo.bar[]")
Debug.Assert ValidSquareBracketsForPath("foo[].bar[]")
Debug.Assert ValidSquareBracketsForPath("foo[].bar[].barry[]")
Debug.Assert ValidSquareBracketsForPath("foo[].bar[].barry")
Debug.Assert ValidSquareBracketsForPath("foo.bar[].barry")
End Sub
Private Sub TestValidSquareBrackets()
'Dim lMatchedBracketCount As Long
Debug.Assert ValidSquareBrackets("foo") = 0
'Debug.Assert lMatchedBracketCount = 0
Debug.Assert ValidSquareBrackets("foo[") < 0 'False
'Debug.Assert lMatchedBracketCount < 0
Debug.Assert ValidSquareBrackets("foo]") < 0 '= False
'Debug.Assert lMatchedBracketCount < 0
Debug.Assert ValidSquareBrackets("foo[]") = 1
'Debug.Assert lMatchedBracketCount = 1
Debug.Assert ValidSquareBrackets("foo[[]") < 0 '= False
'Debug.Assert lMatchedBracketCount < 0
Debug.Assert ValidSquareBrackets("foo[]]") < 0 '= False
'Debug.Assert lMatchedBracketCount < 0
Debug.Assert ValidSquareBrackets("foo[[]]") < 0 'False
'Debug.Assert lMatchedBracketCount = 2
End Sub
Private Sub TestHasSquareBrackets()
Debug.Assert HasSquareBrackets("[0]")
Debug.Assert HasSquareBrackets("[*]")
Debug.Assert HasSquareBrackets("foo") = False
End Sub
Private Sub TestExtractSquareBrackets()
Debug.Assert ExtractSquareBrackets("foo") = "foo"
Debug.Assert ExtractSquareBrackets("[0]") = "0"
Debug.Assert ExtractSquareBrackets("[*]") = "*"
End Sub
Private Function SimpleMasterPage() As String
SimpleMasterPage = "{ ""feed"": {" & _
"""entry"": [ " & vbNewLine & _
" { " & _
" ""title"": { ""$t"": ""1 Med"" }, " & _
" ""link"": [ { ""href"": ""https//removed....Med"" } ] " & _
" }, " & vbNewLine & _
" { " & _
" ""title"": { ""$t"": ""2 Dent"" }, " & _
" ""link"": [ { ""href"": ""https//removed....Dent"" } ] " & _
" }, " & vbNewLine & _
" { " & _
" ""title"": { ""$t"": ""3 Vet"" }, " & _
" ""link"": [ { ""href"": ""https//removed....Vet"" }] " & _
" }" & vbNewLine & _
"] } }"
End Function
Private Sub TestLeftSquareIsMissingAdjacentPeriod()
Debug.Assert modJSONPath.LeftSquareIsMissingAdjacentPeriod("foo[", 4)
Debug.Assert modJSONPath.LeftSquareIsMissingAdjacentPeriod("fo.[", 2) = False
Debug.Assert modJSONPath.LeftSquareIsMissingAdjacentPeriod("fo.[", 3) = False
Debug.Assert modJSONPath.LeftSquareIsMissingAdjacentPeriod("fo.[", 4) = False
Debug.Assert modJSONPath.LeftSquareIsMissingAdjacentPeriod("[", 1)
End Sub
Private Function TestGetNextLeftSquareBracket()
Debug.Assert modJSONPath.GetNextLeftSquareBracket("[", 1) = 1
Debug.Assert modJSONPath.GetNextLeftSquareBracket(".[", 1) = 2
End Function
Private Function TestCheckCharAndPrevChar()
Debug.Assert modJSONPath.CheckCharAndPrevChar("[")
Debug.Assert modJSONPath.CheckCharAndPrevChar(".[")
Debug.Assert modJSONPath.CheckCharAndPrevChar("f.") = False
End Function
Private Function TestCharAndPrevChar()
Debug.Assert modJSONPath.CharAndPrevChar("foo[", 4) = "o["
Debug.Assert modJSONPath.CharAndPrevChar("fo.[", 2) = "fo"
Debug.Assert modJSONPath.CharAndPrevChar("fo.[", 3) = "o."
Debug.Assert modJSONPath.CharAndPrevChar("fo.[", 4) = ".["
Debug.Assert modJSONPath.CharAndPrevChar("[", 1) = "["
End Function
Private Sub TestIndexOf()
Debug.Assert modJSONPath.IndexOf("Hello world!", "l", 1) = 2
Debug.Assert modJSONPath.IndexOf("Hello world!", "l", 3) = 3
Debug.Assert modJSONPath.IndexOf("Hello world!", "l", 4) = 9
Debug.Assert modJSONPath.IndexOf("Hello world!", "z", 4) = -1
End Sub
Private Sub TestSubString()
Debug.Assert modJSONPath.SubString("Hello world!", 1, 4) = "ell"
Debug.Assert modJSONPath.SubString("Hello world!", 0, 4) = "Hell"
Debug.Assert Len("Hello world!") = 12
Debug.Assert modJSONPath.SubString("Hello world!", 11, 12) = "!"
'* Left$
Debug.Assert modJSONPath.SubString("Hello world!", 0, 1) = Left$("Hello world!", 1) '* identity
Debug.Assert modJSONPath.SubString("Hello world!", 0, 2) = Left$("Hello world!", 2) '* identity
'* Right$
Debug.Assert modJSONPath.SubString("Hello world!", Len("Hello world!") - 1, Len("Hello world!")) = Right$("Hello world!", 1) '* identity
Debug.Assert modJSONPath.SubString("Hello world!", Len("Hello world!") - 2, Len("Hello world!")) = Right$("Hello world!", 2) '* identity
'* Mid$
Debug.Assert modJSONPath.SubString("Hello world!", 0, 1) = Mid$("Hello world!", 1, 1) '* identity
Debug.Assert modJSONPath.SubString("Hello world!", 0, 2) = Mid$("Hello world!", 1, 2) '* identity
End Sub
Private Sub TestJSONPathNeedsPeriodising()
Debug.Assert modJSONPath.JSONPathNeedsPeriodising("foo") = False
Debug.Assert modJSONPath.JSONPathNeedsPeriodising("foo[]") = True
Debug.Assert modJSONPath.JSONPathNeedsPeriodising("foo.[]") = False
Debug.Assert modJSONPath.JSONPathNeedsPeriodising("[]") = False
Debug.Assert modJSONPath.JSONPathNeedsPeriodising("feed.entry[*].link.[0]") = True
End Sub
Private Sub TestCountLeftBrackets()
Debug.Assert modJSONPath.CountLeftBrackets("fffoo[") = 1
Debug.Assert modJSONPath.CountLeftBrackets("fffoo[0]") = 1
End Sub
Private Sub TestCountRightBrackets()
Debug.Assert modJSONPath.CountRightBrackets("fffoo]") = 1
Debug.Assert modJSONPath.CountRightBrackets("fffoo[0]") = 1
End Sub
'Private Sub TestValidSquareBrackets()
' Dim lMatchedBracketCount As Long
' Debug.Assert ValidSquareBrackets("foo", lMatchedBracketCount)
' Debug.Assert lMatchedBracketCount = 0
'
' Debug.Assert ValidSquareBrackets("foo[", lMatchedBracketCount) = False
' Debug.Assert lMatchedBracketCount < 0
'
' Debug.Assert ValidSquareBrackets("foo]", lMatchedBracketCount) = False
' Debug.Assert lMatchedBracketCount < 0
' Debug.Assert ValidSquareBrackets("foo[]", lMatchedBracketCount)
' Debug.Assert lMatchedBracketCount = 1
'
' Debug.Assert ValidSquareBrackets("foo[[]", lMatchedBracketCount) = False
' Debug.Assert lMatchedBracketCount < 0
'
' Debug.Assert ValidSquareBrackets("foo[]]", lMatchedBracketCount) = False
' Debug.Assert lMatchedBracketCount < 0
'
' Debug.Assert ValidSquareBrackets("foo[[]]", lMatchedBracketCount) = False
' Debug.Assert lMatchedBracketCount = 2
'End Sub
'Private Sub TestParseSquareBrackets()
'
' Dim sExpr As String
' sExpr = "[0]"
'
' Debug.Assert ParseSquareBrackets(sExpr)
'
' Debug.Assert sExpr = "0"
'
' sExpr = "[*]"
' Debug.Assert ParseSquareBrackets(sExpr)
' Debug.Assert sExpr = "*"
'
' sExpr = "foo"
' Debug.Assert ParseSquareBrackets(sExpr)
' Debug.Assert sExpr = "foo"
'
'
'End Sub
'Private Sub TestRealLifeTest()
' '* get the title and url from the given test string
' Dim oSC As Object
' Set oSC = modJSONPath.JsonPathSC
'
' Dim obj As Object
' Set obj = oSC.Run("JSON_parse", SimpleMasterPage)
'
' Dim objMergedArray As Object
' Set objMergedArray = ArraysOfObjectsMergeProperties( _
' ArrayOfLiteralsUpgradeToObjects(JSONPath(obj, "feed.entry[*].title.$t", True), "title"), _
' ArrayOfLiteralsUpgradeToObjects(JSONPath(obj, "feed.entry[*].link.[0].href", True), "href"))
'
'
'
' 'Stop
'
'End Sub
'
'Private Sub Recon()
'
' Dim oSC As Object
' Set oSC = modJSONPath.JsonPathSC
'
' Dim obj As Object
' Set obj = oSC.Run("JSON_parse", "[1,2,3,4]")
'
' Dim obj2 As Object
' Set obj2 = ArrayOfLiteralsUpgradeToObjects(obj, "goals")
'
' Dim obj3 As Object
' Set obj3 = UpgradeArrayElementsToObject(obj, "goals")
' Debug.Assert oSC.Run("JSON_stringify", obj2) = oSC.Run("JSON_stringify", obj3)
'End Sub
'Private Sub TestArrayOfLiteralsUpgradeToObjects()
'
' Dim oSC As Object
' Set oSC = modJSONPath.JsonPathSC
'
'
' Dim obj As Object
' Set obj = oSC.Run("JSON_parse", "[1,2,3,4]")
'
' Dim obj2 As Object
' Set obj2 = oSC.Run("upgradeArrayElementsToObject", obj, "goals")
' Stop
'End Sub
'Private Sub TestRealLifeTestDeveloper()
' '* get the title and url from the given test string
' 'End
' Dim oSC As Object
' Set oSC = modJSONPath.JsonPathSC
'
' Dim obj As Object
' Set obj = oSC.Run("JSON_parse", SimpleMasterPage)
'
' Dim objTitles As Object
' Set objTitles = JSONPath(obj, "feed.entry[*].title.$t", True)
'
' Dim objURLs As Object
' 'Set objURLs = JSONPath(obj, "feed.entry[*].link")
' 'Set objURLs = JSONPath(obj, "feed.entry[*].link[0]")
' 'Set objURLs = JSONPath(obj, "feed.entry[*].link.[0]")
' Set objURLs = JSONPath(obj, "feed.entry[*].link.[0].href", True)
' 'Set objURLs = JSONPath(obj, "feed.entry[*].link.[0]")
'
' Dim objTitlesUpgraded As Object
' Set objTitlesUpgraded = modJSONPath.ArrayOfLiteralsUpgradeToObjects(objTitles, "title")
'
' Dim objURLsUpgraded As Object
' Set objURLsUpgraded = modJSONPath.ArrayOfLiteralsUpgradeToObjects(objURLs, "href")
'
'
' Dim objTitlesUpgraded0 As Object
' Set objTitlesUpgraded0 = CallByName(objTitlesUpgraded, "0", VbGet)
'
' Dim objURLsUpgraded0 As Object
' Set objURLsUpgraded0 = CallByName(objURLsUpgraded, "0", VbGet)
'
' Dim objMerged As Object
' Set objMerged = ObjectsMergeProperties(objTitlesUpgraded0, objURLsUpgraded0)
'
' Debug.Assert oSC.Run("JSON_stringify", objMerged) = "{""title"":""1 Med"",""href"":""https//removed....Med""}"
'
'
' Dim objMergedArray As Object
' Set objMergedArray = ArraysOfObjectsMergeProperties(objTitlesUpgraded, objURLsUpgraded)
'
' Stop
'
'End Sub
No comments:
Post a Comment