cDeadDrop.cls

'gistThat@mcpher.com :do not modify this line - see ramblings.mcpher.com for details: updated on 2/3/2014 6:52:09 PM : from manifest:8767201 gist https://gist.github.com/brucemcpherson/7943765/raw/cDeadDrop.cls
Option Explicit
' v1.2
Private pScriptDb As cScriptDbCom
Private pPackage As cJobject
Private Const deadDropKey = "xLiberationConversations"
Public Property Get willExpireAt() As Date
    willExpireAt = DateAdd("n", 24 * 60, Now())
End Property
Public Property Get key() As String
    key = pPackage.toString("key")
End Property
Public Property Get entry() As String
    entry = pPackage.toString("entry")
End Property
Public Property Get scriptDbClass() As String
    scriptDbClass = pPackage.toString("class")
End Property
Public Property Get scriptDb() As cScriptDbCom
    Set scriptDb = pScriptDb
End Property
Public Property Get self() As cDeadDrop
    Set self = Me
End Property
Public Function init(yourClass As String, _
                        Optional yourScriptDbEntry As String = vbNullString, _
                        Optional initial As Boolean = False, _
                        Optional specificKey As String = vbNullString) As cDeadDrop
    
    ' will set up a scriptDB class and give it a unique key

    
    ' this is self cleansing - will clean registry every time it is called
    cleanExpired yourClass
    
    ' firstly we'll try to get it from registry
    Set pPackage = getRegistryPackage(yourClass, specificKey)
    
    ' if we got a specific key, then we should have found it, so return null to fail
    If pPackage Is Nothing And specificKey <> vbNullString Then Exit Function
        
    
    If Not pPackage Is Nothing And Not initial Then
    
        ' we found it, by default the entry is to be found in the package, but if one is specified,we override
        If (yourScriptDbEntry <> vbNullString) Then
            pPackage.add "entry", yourScriptDbEntry
            setRegistryPackage
        End If
        
    Else
        ' this is a first time for this conversation
        If (yourScriptDbEntry = vbNullString) Then yourScriptDbEntry = "scriptDb"
        
        Set pPackage = JSONParse( _
         "{'key':'" & yourClass & Replace(CStr(tinyTime), ".", "") _
         & "','class':'" & yourClass & "','entry':'" & yourScriptDbEntry & "'}")
        
        setRegistryPackage

        
    End If
    
    ' assumes you have already set up their pc for scriptDb access (run firsttimescriptdbmessages)
    Set pScriptDb = getScriptDb(self.key, self.entry)
  
    Set init = self
End Function
Public Sub tearDown()
    If Not pPackage Is Nothing Then
        pPackage.tearDown
    End If
    If Not pScriptDb Is Nothing Then
        pScriptDb.tearDown
    End If
End Sub
'" ---- registry -----
'" in registry entries, the values are encrypted useing the salt
'" the structure is
'" xLiberation/conversations/key
Private Function getRegistryPackage(yourClass As String, _
                Optional specificKey As String = vbNullString) As cJobject
    Dim s As String, t As String, job As cJobject
    If specificKey = vbNullString Then
        Set job = getLatest(yourClass)
        If Not job Is Nothing Then t = job.toString("key")
    Else
        t = specificKey
    End If
    
    If (t <> vbNullString) Then
        s = GetSetting(deadDropKey, _
                yourClass, _
                t)
    End If
    
    If (s <> vbNullString) Then Set getRegistryPackage = JSONParse(decryptMessage(s, yourClass))
End Function
Private Sub setRegistryPackage()
    Dim s As String
    pPackage.add "expires", self.willExpireAt
    s = JSONStringify(pPackage)
    SaveSetting deadDropKey, _
            scriptDbClass(), _
            self.key, _
            encryptMessage(s, scriptDbClass())
           
End Sub
Private Function getLatest(yourClass) As cJobject
    ' find the latest conversation for this class
    Dim a As Variant, i As Long, latestJob As cJobject, job As cJobject
    a = GetAllSettings(deadDropKey, yourClass)
    If Not IsEmpty(a) Then
        For i = LBound(a, 1) To UBound(a, 1)
            Set job = JSONParse(decryptMessage(CStr(a(i, 1)), yourClass))
            If latestJob Is Nothing Then
    
                Set latestJob = job
            Else
                If (isSomething(job.childExists("expires"))) Then
                    If job.child("expires").value > job.child("expires").value Then
                        Set latestJob = job
                    End If
                End If
            End If
        Next i
    End If
    Set getLatest = latestJob
End Function

Private Sub cleanExpired(yourClass As String)
    ' this can be called to clean out old conversations from the registry
    Dim a As Variant, latest As Variant, job As cJobject, i As Long

    ' get all the entries for this class
    a = GetAllSettings(deadDropKey, yourClass)
    
    ' delete all expired
    If Not IsEmpty(a) Then
        For i = LBound(a, 1) To UBound(a, 1)
            Set job = JSONParse(decryptMessage(CStr(a(i, 1)), yourClass))
    
            If (isSomething(job.childExists("expires"))) Then
                If job.child("expires").value < Now() Then
                    DeleteSetting deadDropKey, yourClass, job.toString("key")
                End If
            Else
                DeleteSetting deadDropKey, yourClass, job.toString("key")
            End If
        Next i
    End If
    
End Sub

cScriptDbCom.cls

'gistThat@mcpher.com :do not modify this line - see ramblings.mcpher.com for details: updated on 2/3/2014 6:52:09 PM : from manifest:8767201 gist https://gist.github.com/brucemcpherson/7943765/raw/cScriptDbCom.cls
Option Explicit
' a VBA class for scriptDb
' v1.5
Private pBrowser As cBrowser
Private pPackage As cJobject
Private pClass As String
Private pApplicationHeaders As cJobject
Private pSalt As String
Private pBatch As cJobject
Private pBatchMode As Boolean
Private pClassPoint As String
Private pBatchMax As Long
Private poAuth2 As cOauth2
Private pDebug As Boolean
Public Property Get scriptDbClass() As String
    scriptDbClass = pClass
End Property
Public Property Let scriptDbClass(p As String)
    pClass = p
End Property
Public Function resultsLength(Optional job As cJobject = Nothing) As Long
    Dim j As cJobject
    Set j = job
    If j Is Nothing Then
        Set j = jObject
    End If
    If isSomething(j.childExists("results")) Then
        resultsLength = j.child("results").children.count
    End If
    If job Is Nothing Then
        j.tearDown
    End If
End Function
Public Function count(Optional queryJob As cJobject = Nothing, Optional queryParams As cJobject = Nothing) As Long
    count = 0
    With getCount(queryJob, queryParams)
        If .isOk Then
            With .jObject
                count = .child("count").value
                .tearDown
            End With
        End If
    End With
End Function
Public Property Get self() As cScriptDbCom
    Set self = Me
End Property
Public Property Get jObject() As cJobject
    Set jObject = JSONParse(browser.Text, , False)
End Property
Public Property Get browser() As cBrowser
    Set browser = pBrowser
End Property
Public Property Get isOk() As Boolean
    
    isOk = False
    If pBrowser.isOk Or (pBrowser.status = 0 And pBatchMode) Then
        With jObject
            If Not .childExists("status") Is Nothing Then
                isOk = .isValid And .toString("status") = "good"
            Else
                isOk = False
            End If
            .tearDown
        End With
    End If
End Property
Public Function init(Optional whichClass As String = "defaultClass", _
        Optional credentialsEntry As String = "scriptDb", _
        Optional scopeEntry As String = "rest", _
        Optional restAPIKey As String = vbNullString, _
        Optional clientKey As String = vbNullString, _
        Optional needDebug As Boolean = False, _
        Optional library As String = vbNullString, _
        Optional needOauth As Variant, _
        Optional newEndPoint As String = vbNullString) As cScriptDbCom

    getScriptDbCredentials credentialsEntry, scopeEntry, restAPIKey, clientKey, newEndPoint, needOauth, library
    If pPackage Is Nothing Then
        Exit Function
    End If
  
    ' get oauth detail
    If getNeedOAuth Then
        Set poAuth2 = getGoogled("drive")
    End If
    Set pApplicationHeaders = getApplicationHeaders
    pClass = whichClass
    pDebug = needDebug
    Set init = Me
    
End Function
Private Function getEndPoint() As String
    getEndPoint = pPackage.child("endPoint").value
End Function
Private Function getNeedOAuth() As String
    getNeedOAuth = pPackage.child("needAuth").value
End Function
Private Function getLibrary() As String

    If isSomething(pPackage.childExists("library")) Then
        getLibrary = pPackage.child("library").value
    Else
        getLibrary = vbNullString
    End If

End Function
Public Function getObjectById(id As String) As cScriptDbCom
    Set getObjectById = getStuff("&objectid=" & id)
End Function
Public Function getObjectsByQuery(Optional queryJob As cJobject = Nothing, _
        Optional queryParams As cJobject = Nothing) As cScriptDbCom
    Set getObjectsByQuery = getStuff(constructQueryString(queryJob, queryParams))
End Function
Private Function constructQueryString(Optional queryJob As cJobject = Nothing, _
        Optional queryParams As cJobject = Nothing) As String
    Dim qString As String, t As cStringChunker, job As cJobject
    
    ' set up parameters
    Set t = New cStringChunker
    
    If Not queryParams Is Nothing Then
        For Each job In queryParams.children
            t.add(job.key).add("=").add(job.toString).add ("&")
        Next job
    End If
    ' set up query string
    If Not queryJob Is Nothing Then
        t.add "where=" & URLEncode(JSONStringify(queryJob))
    End If
    qString = vbNullString
    t.chopIf "&"
    If t.size > 0 Then
        qString = "&" & t.content
    End If
    Set t = Nothing
    constructQueryString = qString
End Function
Private Function mergeParameters(Optional queryParams As cJobject = Nothing, Optional addParams As cJobject = Nothing) As cJobject
    Dim job As cJobject
    
    ' start with the given params
    If Not queryParams Is Nothing Then
        ' take a copy
        Set job = JSONParse(queryParams.stringify)
    End If
    
    ' add some more
    If Not addParams Is Nothing Then
        If job Is Nothing Then
            Set job = New cJobject
            job.init Nothing
        End If
        job.merge addParams
    End If
    
    Set mergeParameters = job
End Function
Public Function getCount(Optional queryJob As cJobject = Nothing, Optional queryParams As cJobject = Nothing) As cScriptDbCom
        
    Set getCount = getStuff( _
        constructQueryString(queryJob, mergeParameters(queryParams, JSONParse("{'count':1}"))))
    
End Function
Public Function createObject(addJob As cJobject) As cScriptDbCom
    Set createObject = postStuff(addJob)
End Function

Public Function updateObjectById(id As String, Optional updateJob As cJobject = Nothing) As cScriptDbCom
    
    With getObjectById(id)
        If .isOk Then
            updateJob.add "objectId", id
            postStuff updateJob, "PUT"
        End If
    End With
    Set updateObjectById = Me
    
End Function

Public Function updateObjects(Optional queryJob As cJobject = Nothing, _
        Optional updateJob As cJobject = Nothing, Optional queryParameters As cJobject = Nothing) As cScriptDbCom
    ' does a query, then update all matching
    
    Dim queryResponse As cJobject, skip As Long, jobSkip As cJobject, number As Long
    skip = 0
    Set jobSkip = JSONParse("{'skip':0}")
    ' we'll just use the default limit
    Do
        With getObjectsByQuery(queryJob, mergeParameters(queryParameters, jobSkip)).jObject
            ' this is how many were returned this time
            number = resultsLength(.self)
            ' if there were any then do soemthing with it
            If number > 0 Then
                
                ' skip what we've already had
                skip = skip + number
                jobSkip.child("skip").value = skip
                
                ' update the contents of the query we just did
                updateObjectsPart .self, updateJob
            End If
            ' clear out these results
            .tearDown
        End With
        
        ' if there were any errors or there's no more to do then exit
    Loop While isOk And number > 0

    Set updateObjects = Me
End Function
Private Function updateObjectsPart(queryResponse As cJobject, updateJob As cJobject) As cScriptDbCom

    Dim job As cJobject
    ' any matching get the same update
    If isOk And Not queryResponse Is Nothing Then
        With queryResponse
            For Each job In .child("results").children
                updateJob.add "objectId", job.child("objectId").value
                postStuff updateJob, "PUT"
            Next job
            .tearDown
        End With
    End If

    Set updateObjectsPart = Me
End Function
Public Function deleteObjects(Optional queryJob As cJobject = Nothing) As cScriptDbCom
    Dim queryResponse As cJobject
    Dim previousCount As Long, thisCount As Long
    
    ' query is limited, so we need to keep going until no results
    thisCount = self.count
    previousCount = 0
    While thisCount <> previousCount
        previousCount = thisCount
        Set queryResponse = getObjectsByQuery(queryJob).jObject
        deleteObjectsPart queryResponse
        If Not isOk Then Exit Function
        queryResponse.tearDown
        thisCount = self.count
    Wend
    Set deleteObjects = Me
End Function
Private Function deleteObjectsPart(queryResponse As cJobject) As cScriptDbCom
    ' does a query, then update all matching
    Dim job As cJobject

    ' any matching get deleted
    If isOk Then
        For Each job In queryResponse.child("results").children
            If Not deleteObject(job.child("objectId")).isOk Then Exit For
        Next job
    End If
    Set deleteObjectsPart = Me
End Function
Public Function deleteObject(jid As cJobject) As cScriptDbCom
    If pBatchMode Then
        postStuff jid, "DELETE"
    Else
        batch(True).deleteObject(jid).batch False
    End If
    Set deleteObject = Me
End Function
Public Function postStuff(Optional data As cJobject = Nothing, _
                                Optional method As String = "POST") As cScriptDbCom
    
    ' always batched, even if only one.
    If pBatchMode Then
        If isEmptyBatchNeeded Then flush
        addToBatch method, scriptDbClass, data
    Else
        batch(True).postStuff(data, method).batch False
       
    End If
    Set postStuff = Me
End Function
Private Function getOauthHeader() As String
    If poAuth2 Is Nothing Then
        getOauthHeader = vbNullString
    Else
        getOauthHeader = poAuth2.authHeader
    End If
End Function
Public Function getStuff(Optional params As String = vbNullString, Optional method As String = "GET") As cScriptDbCom
    Dim post As String
    
    'always need to flush before a get
    flush
    
    pBrowser.httpGET getEndPoint & "?db=scriptdb&" & pClassPoint & scriptDbClass & debugParam & libraryParam & params & getApiVersion, _
            , , , , getOauthHeader, pApplicationHeaders, method
    Set getStuff = Me
End Function
Private Function getApiVersion() As String
    getApiVersion = "&api=VBAv0103"
End Function
Private Function doPost(url As String, Optional data As cJobject = Nothing, Optional method As String = "POST") As cScriptDbCom
    ' called when we need to issue a get
    Dim dString As String
    If Not data Is Nothing Then dString = data.stringify
    pBrowser.httpPost url & "?db=scriptdb" & debugParam & libraryParam & getApiVersion, dString, True, getOauthHeader, pApplicationHeaders, method
    Set doPost = Me
End Function
Private Function debugParam(Optional argJoin As String = "&") As String
    If pDebug Then
        debugParam = argJoin & "debug=1"
    Else
        debugParam = vbNullString
    End If
End Function
Private Function libraryParam(Optional argJoin As String = "&") As String
    If getLibrary = vbNullString Then
        libraryParam = vbNullString
    Else
        libraryParam = argJoin & "library=" & getLibrary
    End If
End Function
Private Function clearDown(o As Object) As cScriptDbCom
    If Not o Is Nothing Then
        o.tearDown
        Set o = Nothing
    End If
    Set clearDown = Me
End Function
Private Function isEmptyBatchNeeded() As Boolean

    ' there's a maximum to how many we can batch at once
    isEmptyBatchNeeded = False
    If Not pBatch Is Nothing Then isEmptyBatchNeeded = (pBatch.child("requests").children.count >= pBatchMax)
    
End Function
Private Function addToBatch(method As String, path As String, Optional body As cJobject = Nothing)
    If pBatch Is Nothing Then
        Set pBatch = New cJobject
        pBatch.init Nothing
    End If
    ' first in?
    If Not pBatch.hasChildren Then
        pBatch.add("requests").addArray
    End If
    With pBatch.child("requests").add
        .add "method", method
        .add "path", path
        If Not body Is Nothing Then
            With .add("body")
                .append body
            End With
        End If
    End With
    Set addToBatch = Me
End Function
Public Function batch(Optional batchItUp As Boolean = True) As cScriptDbCom

    ' use this to set up batching. if any outstanding it will clear it if changing batching mode
    If pBatchMode <> batchItUp Then
        flush
    End If

    pBatchMode = batchItUp
    Set batch = Me
    
End Function
Public Property Get batchMode() As Boolean
    batchMode = pBatchMode
End Property
Public Function flush() As cScriptDbCom
    ' been storing stuff up
    If Not pBatch Is Nothing Then
        If (pBatch.hasChildren) Then
            doPost getEndPoint, pBatch, "POST"
            If Not isOk Then
                MsgBox "failed to flush:" & browser.status & ":" & browser.Text
            End If
            pBatch.tearDown
        End If
        Set pBatch = Nothing
    End If
    Set flush = Me
End Function
Public Sub tearDown()
    clearDown pBrowser
    clearDown pPackage
    clearDown pApplicationHeaders
    clearDown pBatch
End Sub
Private Sub Class_Initialize()
    Set pBrowser = New cBrowser
    pClassPoint = "class="
    pSalt = "xLiberation"
    pBatchMode = False
    pBatchMax = 50
End Sub
Private Function getScriptDbCredentials(entry As String, scope As String, _
        Optional restAPIKey As String = vbNullString, _
        Optional clientKey As String = vbNullString, _
        Optional endPoint As String = vbNullString, _
        Optional needAuth As Variant, _
        Optional library As String = vbNullString) As cScriptDbCom

    Set pPackage = getRegistryPackage(entry, scope)
    Dim b As Boolean
    If IsMissing(needAuth) Then b = True
    
    If pPackage Is Nothing Then
        If (restAPIKey = vbNullString Or clientKey = vbNullString) Then
            MsgBox ("First time you need to provide keys")
            Exit Function
        End If
        Set pPackage = New cJobject
        
        With pPackage.init(Nothing)
            .add "scopeEntry", scope
            .add "authFlavor", entry
            .add "restAPIKey", restAPIKey
            .add "applicationID", clientKey
            .add "endPoint", endPoint
            .add "needauth", b
            .add "library", library
        End With

    End If
    ' in case anything changed
    If restAPIKey <> vbNullString Then
        pPackage.add "restAPIKey", restAPIKey
    End If
    
    If clientKey <> vbNullString Then
        pPackage.add "applicationID", clientKey
    End If
    
    If endPoint <> vbNullString Then
        pPackage.add "endPoint", endPoint
    End If
    
    If library <> vbNullString Then
        pPackage.add "library", library
    End If
    
    If Not IsMissing(needAuth) Then
        pPackage.add "needAuth", needAuth
    End If
    
    ' update registry in case any changes
    setRegistryPackage

End Function
Private Function getApplicationHeaders() As cJobject
    Dim job As cJobject, a As cJobject
    Set job = New cJobject
    
    With job.init(Nothing)
        .add "X-scriptDb-Application-Id", pPackage.child("applicationID").value
        .add "X-scriptDb-REST-API-Key", pPackage.child("restAPIKey").value
    End With
    Set getApplicationHeaders = job
End Function
'" ---- registry -----
'" in registry entries, the values are encrypted useing the salt
'" the structure is
'" xLiberation/scriptDbAuth/scope - json pPackage values
Private Function getRegistryPackage(authFlavor As String, scopeEntry As String) As cJobject
    Dim s As String
    s = GetSetting("xLiberation", _
            authFlavor, _
            scopeEntry)
    
    If (s <> vbNullString) Then Set getRegistryPackage = JSONParse(decrypt(s))
End Function
Private Sub setRegistryPackage()
    Dim s As String
    s = JSONStringify(pPackage)
    SaveSetting "xLiberation", _
            pPackage.child("authFlavor").value, _
            pPackage.child("scopeEntry").value, _
            encrypt(s)
            
End Sub

Private Function encrypt(s As String) As String
'    " uses capicom
    encrypt = encryptMessage(s, pSalt)
End Function
Private Function decrypt(s As String) As String
'    " uses capicom
    decrypt = decryptMessage(s, pSalt)
End Function

scriptDbCom.vba

'gistThat@mcpher.com :do not modify this line - see ramblings.mcpher.com for details: updated on 2/3/2014 6:52:09 PM : from manifest:8767201 gist https://gist.github.com/brucemcpherson/7943765/raw/scriptDbCom.vba
Option Explicit
'v1.4

' examples for cScriptDbCom
' see http://ramblings.mcpher.com/Home/excelquirks/scriptdb/scriptdbapi
Private Sub firstTimescriptdbComdbTest()
    Dim scriptdbCom As cScriptDbCom, url As String
    Set scriptdbCom = New cScriptDbCom
    
    ' you only need to run this once per PC. Once you've done it, delete it from here and keep a safe private copy  somewhere
    
    ' this url is for the dbHandler google apps script webapp
    url = "https://script.google.com/a/macros/mcpher.com/s/AKfycbyro1-9LNOnaykvBJ4_6pRZJwNkgf-VFpeQ8drJBqzOK3QZIhU/exec"
    
    'substitute in your google oauth2 credentials (clientid/secret) from the google cloud console
    getGoogled("drive", , "xxx.apps.googleusercontent.com", "xxx").tearDown
    
    ' get full access to the test environment
    With scriptdbCom.init(, "dbTest", , _
                "yourApp", _
                "yourKey", , , True, _
                "https://script.google.com/a/macros/mcpher.com/s/AKfycbyro1-9LNOnaykvBJ4_6pRZJwNkgf-VFpeQ8drJBqzOK3QZIhU/exec")
        .tearDown
    End With
    
    ' and full access to the production environment
    With scriptdbCom.init(, "dbProduction", , _
                "yourApp", _
                "yourKey", , "dbProduction", True, _
                "https://script.google.com/a/macros/mcpher.com/s/AKfycbyro1-9LNOnaykvBJ4_6pRZJwNkgf-VFpeQ8drJBqzOK3QZIhU/exec")
        .tearDown
    End With
End Sub


Private Sub firstTimescriptdbComPrimer()
    
    Dim scriptdbCom As cScriptDbCom
    Set scriptdbCom = New cScriptDbCom
    
    With scriptdbCom.init(, _
                "prepareStart", _
                , _
                "xliberationApp", _
                "xliberation", _
                False, _
                "scriptDBPrimer", _
                True, _
                "https://script.google.com/macros/s/AKfycbzvnq2IZu3JpngnuVxfnPAZYPooVBTULkUyiLFnItfvRxY0NrI/exec")
        .tearDown
    End With
    
End Sub
Private Sub firstTimescriptdbComReadonly()
    
    Dim scriptdbCom As cScriptDbCom
    Set scriptdbCom = New cScriptDbCom
    
    With scriptdbCom.init(, _
                "getStarted", _
                , _
                "primerApp", _
                "xliberation", _
                False, _
                "scriptDBPrimer", _
                False, _
                "https://script.google.com/macros/s/AKfycbx7_gPpc38Map4QqHOQrzx_kvIX00nfYGO9OLq8_cMD486Va6M/exec")
        .tearDown
    End With
    
End Sub
Private Sub firstTimescriptdbMessages()
    
    Dim scriptdbCom As cScriptDbCom
    Set scriptdbCom = New cScriptDbCom
    
    With scriptdbCom.init(, _
                "messages", _
                , _
                "messagesKey", _
                "xliberation", _
                False, _
                "scriptDBMessages", _
                False, _
                "https://script.google.com/macros/s/AKfycbzvnq2IZu3JpngnuVxfnPAZYPooVBTULkUyiLFnItfvRxY0NrI/exec")
        .tearDown
    End With
    
End Sub
Public Sub testdbCount()
    Debug.Print getScriptDb("VBAParseCustomers", "dbProduction").count(); " objects  in customers class: production DB"
    Debug.Print getScriptDb("VBAParseData", "dbProduction").count(); " objects  in data class: production DB"
    
    Debug.Print getScriptDb("VBAParseCustomers", "dbTest").count(); " objects  in customers class: test DB"
    Debug.Print getScriptDb("VBAParseData", "dbTest").count(); " objects  in data class: test DB"
    
End Sub
Private Sub scriptDBandParseCopy()
    ' copy from scriptDB to Parse
    Dim dbParse As cParseCom, dbScriptDb As cScriptDbCom, Class As String
    
    Class = "VBAParseCustomers"
    Set dbParse = getParsed(Class)
    Set dbScriptDb = getScriptDb(Class, "dbTest")
    
    ' copy from scriptdb to parse
    dbCopyAny dbScriptDb, dbParse
    
    ' see what we have
    Debug.Print dbParse.count
    Debug.Print dbParse.getObjectsByQuery(JSONParse("{'country':'Turkey'}")).jObject.stringify(True)
    
    ' copy back again
    dbCopyAny dbParse, dbScriptDb
    
    ' see what we have
    Debug.Print dbScriptDb.count
    Debug.Print dbScriptDb.getObjectsByQuery(JSONParse("{'country':'Turkey'}")).jObject.stringify(True)
    
    ' clean up
    dbParse.tearDown
    dbScriptDb.tearDown
    
End Sub


Private Sub dbCopyAny(dbSource As Object, dbTarget As Object)
    Dim jobSkip As cJobject, job As cJobject
    
    ' delete everything in target db of this class
    dbTarget.batch.deleteObjects
    
    'we have to do it in chunks because of potential query limits
    Set jobSkip = JSONParse("{'skip':0}")

    ' we'll just use the default limit for a big query
    Do
        With dbSource.getObjectsByQuery(Nothing, jobSkip).jObject.child("results")
            If .children.count = 0 Or Not dbSource.isOk Or Not dbTarget.isOk Then Exit Do
            ' There are special reserved fields we need to delete between databases
            For Each job In .children
                dbTarget.createObject _
                    job.deleteChild("objectId").deleteChild("updatedAt").deleteChild("createdAt").deleteChild("siloId")
            Next job
            jobSkip.child("skip").value = jobSkip.child("skip").value + .children.count
        End With
    Loop
    
    ' clean up
    dbTarget.batch (False)
    
  
End Sub

Private Sub dbTestPopulates()
    ' copy two sheets to scriptdb.com
    populateFromSheet "VBAParseData", "dbTest"
    populateFromSheet "VBAParseCustomers", "dbTest"
    
End Sub
Private Sub dbTestCopy()
    dbCopy "dbProduction", "dbTest", "VBAParseData"
    dbCopy "dbProduction", "dbTest", "VBAParseCustomers"
End Sub

Public Sub dbCopy(source As String, target As String, Class As String)
    Dim dbSource As cScriptDbCom, dbTarget As cScriptDbCom, _
        jobSkip As cJobject, job As cJobject
    ' copying class from one database to another
    Set dbSource = getScriptDb(Class, source)
    Set dbTarget = getScriptDb(Class, target).batch(True)
    
    ' delete everything in source db of this class
    dbTarget.deleteObjects
    
    'we have to do it in chunks because of potential query limits
    Set jobSkip = JSONParse("{'skip':0}")

    ' we'll just use the default limit for a big query
    Do
        With dbSource.getObjectsByQuery(Nothing, jobSkip).jObject.child("results")
            If .children.count = 0 Or Not dbSource.isOk Or Not dbTarget.isOk Then Exit Do
            For Each job In .children
                dbTarget.createObject job
            Next job
            jobSkip.child("skip").value = jobSkip.child("skip").value + .children.count
        End With
    Loop
    
    ' clean up
    dbTarget.batch(False).tearDown
    dbSource.tearDown
  
End Sub
Private Sub primerCount()
    Debug.Print getScriptDb("VBAParseCustomers", "getStarted").count(JSONParse("{'country':'United States'}"))
End Sub
Private Sub primerQueries()
    With getScriptDb("VBAParseCustomers", "getStarted")
        Debug.Print .getObjectsByQuery(JSONParse("{'country':'United States'}")).jObject.stringify(True)
    End With
End Sub
Private Sub primerQueries2()
    With getScriptDb("VBAParseData", "getStarted")
        Debug.Print .getObjectsByQuery(JSONParse("{'customerid':1}")).jObject.stringify(True)
    End With
End Sub
Private Sub primerUnique()
    Debug.Print getScriptDb("VBAParseData", "getStarted").getObjectById("S321104310680").jObject.stringify(True)
End Sub
Private Sub primerShouldFail()
    getScriptDb("VBAParseData", "getStarted").deleteObjects
End Sub
Private Sub primerDate()
    With getScriptDb("VBAParseData", "getStarted").getObjectById("S321104310680").jObject.child("results.1")
        Debug.Print getAnIsoDate(.child("date"))
    End With
End Sub
Private Sub populates()
    ' copy two sheets to scriptdb.com
    populateFromSheet "VBAParseData", "prepareStart"
    populateFromSheet "VBAParseCustomers", "prepareStart"
End Sub
Private Sub populateFromSheet(sheetName As String, Optional authEntry As String = vbNullString)
    Dim scriptdbCom As cScriptDbCom, job As cJobject, dset As cDataSet
    
    ' this will clear out an existing scriptdb class, and create a new one from a worksheet
    ' we'll use batch mode throughout
    
    Set scriptdbCom = getScriptDb(sheetName, authEntry).batch
    
    ' clear out existing any existing data
    scriptdbCom.deleteObjects
    
    'get the data from the sheet and populate database
    Set dset = New cDataSet
    With dset.populateData(wholeSheet(sheetName), , , , , , True).jObject(, True, True)
        For Each job In .children
            Debug.Assert scriptdbCom.createObject(job).isOk
        Next job
        .tearDown
    End With
    
    ' commit any outstanding  and clean up
    With scriptdbCom.flush.batch(False)
        Debug.Assert .isOk
        ' show how many are there now
        Debug.Print .count & " in class" & sheetName
        .tearDown
    End With

End Sub
Private Function getAnIsoDate(job As cJobject) As Date
    getAnIsoDate = 0
    If Not job Is Nothing Then
        If Not job.childExists("__type") Is Nothing Then
            If job.toString("__type") = "Date" Then
                getAnIsoDate = fromISODateTime(job.child("iso").value)
            End If
        End If
    End If
End Function
Private Sub testGetItemByUniqueId()
    Dim d As Date, job As cJobject, jor As cJobject
    ' get an item by unique object ID
    With getScriptDb("VBAParseData", "readonly")
        Debug.Print .getObjectsByQuery().jObject.stringify
        .getObjectById ("S320996777097")
        ' test if it worked, and do something with the results
        If .isOk Then
            Debug.Print .jObject.stringify(True)
            ' how to do something with parse.com like dates & times
            ' look through each row in the results
            For Each jor In .jObject.child("results").children
                ' look through each field in each row
                For Each job In jor.children
                    d = getAnIsoDate(job)
                    If d <> 0 Then Debug.Print "date detected", d, "from", job.stringify
                Next job
                ' how to get a specifc date/time
                Debug.Print "date converted", getAnIsoDate(jor.child("date"))
            Next jor

            
        Else
            Debug.Print "failed to get object:" & .browser.url & ":" & .browser.status & ":" & .browser.Text
        End If
        .tearDown
    End With

End Sub
Private Sub testdbtest()
    Dim d As Date, job As cJobject, jor As cJobject
    ' get an item by unique object ID
    With getScriptDb("VBAParseData", "dbtest")
        ''Debug.Print .updateObjectById("S342112900210", JSONParse("{'value':9999}")).flush.jObject.stringify
        Debug.Print .getObjectById("S342112900210").jObject.stringify
        'Debug.Print .updateObjects(JSONParse("{'customerid':22}"), JSONParse("{'value':9999}")).jObject.stringify
        ' test if it worked, and do something with the results
        If .isOk Then
            ''Debug.Print .jObject.stringify
            ''Debug.Print .updateObjects(JSONParse("{'customerid':22}"), JSONParse("{'value':9999}")).jObject.stringify
            ''Debug.Print .getObjectsByQuery(JSONParse("{'customerid':22}")).jObject.stringify(True)
        Else
            Debug.Print "failed to get object:" & .browser.url & ":" & .browser.status & ":" & .browser.Text
        End If
        
        'Debug.Print .getObjectsByQuery().jObject.stringify
        .tearDown
    End With

End Sub
Private Sub testscriptdbUpdate()

    ' get some items by query and change the scheme name to something else
    With getScriptDb("somesilo").batch
        With .updateObjects(JSONParse("{'customerid':1}"), JSONParse("{'name':'john'}"))
            ' test if it worked, and do something with the results
            If .isOk Then
                Debug.Print "all is good", .jObject.stringify
            Else
                Debug.Print "failed to update:" & .browser.url & ":" & .browser.status & ":" & .browser.Text
            End If
        End With
        .flush
        Debug.Print .getObjectsByQuery().jObject.stringify
        .tearDown
    End With
   
End Sub

Private Sub testbigquery()
    Dim jobStore As cJobject, jobSkip As cJobject, sdb As cScriptDbCom, job As cJobject
    Set jobSkip = JSONParse("{'skip':0}")
    Set jobStore = New cJobject
    Set jobStore = jobStore.init(Nothing).add("results").addArray
    Set sdb = getScriptDb("VBAParseData")
    ' we'll just use the default limit for a big query, and make a list of objectIds
    Do
        With sdb.getObjectsByQuery(Nothing, jobSkip).jObject.child("results")
            If .children.count = 0 Or Not sdb.isOk Then Exit Do
            jobSkip.child("skip").value = jobSkip.child("skip").value + .children.count
            For Each job In .children
                jobStore.add , job.toString("objectId")
            Next job
        End With
    Loop
    
    Debug.Print jobStore.stringify
    sdb.tearDown
End Sub
Private Sub testscriptdbDelete()

    ' get some items by query and change the scheme name to something else
    With getScriptDb("VBAParseData").batch
        With .deleteObjects()
            ' test if it worked, and do something with the results
            If .isOk Then
                Debug.Print "all is good", .jObject.stringify
            Else
                Debug.Print "failed to delete:" & .browser.url & ":" & .browser.status & ":" & .browser.Text
            End If
        End With
        .flush.tearDown
    End With

End Sub


Private Sub testscriptdbquery()
    
    ' get a number of items that match a query by example
    With getScriptDb("VBAParseData")
        With .getObjectsByQuery(JSONParse("{'customerid':1}"), JSONParse("{'limit':10}"))
            'test if it worked, and do something with the results
            If .isOk Then
                Debug.Print "all is ok", .jObject.stringify(True)
            Else
                Debug.Print "failed to do query:" & .browser.url & ":" & .browser.status & ":" & .browser.Text
            End If
        End With
        .tearDown
    End With
    
End Sub
Private Sub testscriptdbCount()
    
    ' get a number of items that match a query by example
    With getScriptDb("VBAParseData")
        Debug.Print .count()
        If Not .isOk Then
            Debug.Print "fail count", .browser.status, .browser.Text
        End If
        .tearDown
    End With
    
End Sub
Private Sub testscriptdbCreate()
    
    ' create a new object with the given contents
    With getScriptDb("somesilo").createObject(JSONParse("{'customerid':1}"))
        If Not .isOk Then
            Debug.Print "fail creation", .browser.status, .browser.Text
        Else
            Debug.Print .jObject.serialize(True)
        End If
        .tearDown
    End With
    
End Sub

Private Sub scriptdbMatch()
    Dim pCustomer As New cScriptDbCom, pData As cScriptDbCom, job As cJobject, joc As cJobject, queryJob As cJobject
    ' look up data in another table based on data in another
    
    ' data abot the pantone colors of the year
    Set pCustomer = getScriptDb("VBAParseCustomers")
    Set pData = getScriptDb("VBAParseData")
    
    ' set up a query by example, restricting to a particular customer
    Set queryJob = New cJobject
    queryJob.init(Nothing).add "country", "United States"
        
    ' go through all matching customers
    With pCustomer.getObjectsByQuery(queryJob)
        If .isOk Then
            With .jObject.child("results")
                For Each job In .children
                    With pData.getObjectsByQuery(job.child("customerid"))
                        If .isOk Then
                            With .jObject.child("results")
                                For Each joc In .children
                                    Debug.Print job.toString("country"), job.toString("name"), job.child("customerid").value, joc.child("invoiceid").value
                                Next joc
                            End With
                        End If
                    End With
                Next
            End With
        End If
    End With

    
    ' clean up
    queryJob.tearDown
    pCustomer.tearDown
    pData.tearDown
    
End Sub
Public Function getScriptDb(scriptDbClass As String, Optional entry As String = "scriptDb") As cScriptDbCom
    Dim p As cScriptDbCom
    Set p = New cScriptDbCom
    Set getScriptDb = p.init(scriptDbClass, entry)
    
End Function

Private Sub feedbackTest()

    ' create a conversation conection
    With getdeaddrop("webpagexyz", "messages", , "webpagexyz336262847563596")
        ' now we have a scriptDb we can use to read/write stuff to this unique conversation
        With .scriptDb
            Debug.Print .scriptDbClass, .getObjectsByQuery().jObject.stringify(True)
        End With
        .tearDown
    End With

End Sub

Public Sub testDeleteConversation()
    testConversation "webpagexyz"
    deleteConversation "webpagexyz"
    testConversation "webpagexyz"
    deleteConversation "webpagexyz", "webpagexyz336312618855121"
    testConversation "webpagexyz", "webpagexyz336312618855121"
End Sub
Public Sub deleteConversation(yourClass As String, Optional specific As String = vbNullString)
    Dim c As cDeadDrop
    ' create a conversation conection
    With getdeaddrop(yourClass, "messages", , specific)
        ' now we have a scriptDb we can use to read/write stuff to this unique conversation
        With .scriptDb
            ' delete any existing objects in this conversation
            .batch.deleteObjects.flush
        End With
        .tearDown
    End With
End Sub
Public Sub makeConversation()
    Dim c As cDeadDrop
    '
    ' create a conversation conection
    With getdeaddrop("webpagexyz", "messages")
        ' now we have a scriptDb we can use to read/write stuff to this unique conversation
        With .scriptDb
            ' delete any existing objects in this conversation
            .deleteObjects
            
            ' write some data to be accessed by some other application
            .batch
            .createObject JSONParse("{'id':1,'content':'content 1'}")
            .createObject JSONParse("{'id':2,'content':'content 2'}")
            .flush
        End With
        
        ' see if it worked for the latest and a specific key
        testConversation .scriptDbClass
        testConversation .scriptDbClass, "webpagexyz336262847563596"
        
        .tearDown
    End With
End Sub
Public Sub testConversation(yourClass As String, Optional specific As String = vbNullString)
    Dim c As cDeadDrop
    ' create a conversation conection
    With getdeaddrop("webpagexyz", "messages", , specific)
        ' now we have a scriptDb we can use to read/write stuff to this unique conversation
        With .scriptDb
            Debug.Print .scriptDbClass, .getObjectsByQuery().jObject.stringify
        End With
        .tearDown
    End With
End Sub

Public Function getdeaddrop(yourClass As String, _
            Optional yourScriptDbEntry As String = vbNullString, _
            Optional initial As Boolean = False, _
            Optional specificKey As String = vbNullString) As cDeadDrop
    Dim c As cDeadDrop
    Set c = New cDeadDrop
    Set getdeaddrop = c.init(yourClass, yourScriptDbEntry, initial, specificKey)
End Function