Skip to content

Instantly share code, notes, and snippets.

@brucemcpherson

brucemcpherson/cRest.cls

Last active July 4, 2024 04:39
Show Gist options
  • Save brucemcpherson/3423885 to your computer and use it in GitHub Desktop.
Save brucemcpherson/3423885 to your computer and use it in GitHub Desktop.
Download ZIP
Excel rest library
Raw
cRest.cls
'[email protected] :do not modify this line - see ramblings.mcpher.com for details: updated on 15/10/2013 10:52:06 : from manifest:5055578 gist https://gist.github.com/brucemcpherson/3423885/raw/cRest.cls
' This is a generalized class for dealing with rest queries
Option Explicit
' v2.13
'for more about this
' http://ramblings.mcpher.com/Home/excelquirks/classeslink/data-manipulation-classes
'to contact me
' http://groups.google.com/group/excel-ramblings
'reuse of code
' http://ramblings.mcpher.com/Home/excelquirks/codeuse
Public Enum erRestType
erQueryPerRow ' one query for each row
erSingleQuery ' one single query fills multiple rows
End Enum
Public Enum erResultsFormat
erJSON ' expected json
erAUTO ' detect
erXML ' expect xml
erUnknown ' not yet decided
End Enum
Public Enum erAuthType
erOAUTH2 ' google oauth2
End Enum
Private pResultsFormat As erResultsFormat
Private pCollectionNeeded As Boolean
Private perType As erRestType
Private pQueryhCell As cCell
Private pQueryString As String
Private pDset As cDataSet
Private pPopulate As Boolean
Private pRestUrlStem As String
Private pResponse As String
Private pResponseData As String
Private pClearMissingCells As Boolean
Private pJobjects As Collection
Private pTreeSearch As Boolean
Private pIgnore As String
Private pPass As String
Private pUser As String
Private pAccept As String
Private pDatajObject As cJobject
Private pAppend As Boolean
Private pStamp As cCell
Private pAppendQuery As String
Private pWire As Boolean
Private pAlwaysEncode As Boolean
Private pTimeout As Long
Private pPost As String
Private pBrowser As cBrowser
Private poAuth2 As cOauth2
Public Sub tearDown()
Dim cj As cJobject
If Not pDset Is Nothing Then pDset.tearDown
Set pDatajObject = Nothing
If Not pJobjects Is Nothing And pCollectionNeeded Then
For Each cj In pJobjects
cj.tearDown
Next cj
Set pJobjects = Nothing
End If
If Not pBrowser Is Nothing Then
pBrowser.tearDown
Set pBrowser = Nothing
End If
If Not poAuth2 Is Nothing Then
poAuth2.tearDown
Set poAuth2 = Nothing
End If
End Sub
Public Property Get jObjects() As Collection
Set jObjects = pJobjects
End Property
Public Property Get datajObject() As cJobject
Set datajObject = pDatajObject
End Property
Public Property Get jObject(Optional complain As Boolean = True) As cJobject
If pResultsFormat = erXML Then
Set jObject = xmlStringToJobject(pResponse)
ElseIf pResultsFormat = erAUTO Then
Set jObject = xmlStringToJobject(pResponse, False)
If (jObject Is Nothing) Then
Set jObject = JSONParse(pResponse, , complain)
End If
Else
Set jObject = JSONParse(pResponse, , complain)
End If
End Property
Public Property Get erType() As erRestType
erType = perType
End Property
Public Property Get response() As String
response = pResponse
End Property
Public Property Get encodedUri() As String
Dim p As Long, s As String, sq As String
s = pRestUrlStem
sq = pQueryString & pAppendQuery
' sometimes a query can contain stuff not to be encoded.. we identify this by the presence of = in the query string
' and encode after that. if there is no = then no encoding is needed
If (Not pAlwaysEncode) Then
p = InStrRev(sq, "=")
If (p > 0) Then
s = s & left(sq, p)
If (p < Len(sq)) Then s = s & URLEncode(Mid(sq, p + 1))
Else
s = s & sq
End If
Else
s = s & URLEncode(sq)
End If
encodedUri = s
End Property
Public Property Get queryhCell() As cCell
Set queryhCell = pQueryhCell
End Property
Public Property Let queryString(p As String)
pQueryString = p
End Property
Public Property Let restUrlStem(p As String)
pRestUrlStem = p
End Property
Public Property Get queryString() As String
queryString = pQueryString
End Property
Public Property Get dset() As cDataSet
Set dset = pDset
End Property
Private Function respRootJob(job As cJobject) As cJobject
If pResponseData = vbNullString Then
Set respRootJob = job
Else
Set respRootJob = childOrFindJob(job, pResponseData)
End If
End Function
Private Function stripDots(s As String) As String
' this is to deal with sytax like object..field in columns headers and returns the object part
stripDots = rxReplace("\.{2}.*", s, "")
End Function
Private Function dotsTail(s As String) As String
' this returns the field of object..field
dotsTail = rxGroup("(.*?)\.{2}(.*)", s, 2)
End Function
Private Function isDots(s As String) As Boolean
' detects if there are dots like object..field
isDots = stripDots(s) <> s
End Function
Public Function childOrFindJob(job As cJobject, s As String) As cJobject
Dim t As String
t = stripDots(s)
If pTreeSearch Then
Set childOrFindJob = job.find(t)
Else
Set childOrFindJob = job.child(t)
End If
End Function
Public Function init(Optional rData As String = "responsedata.results", _
Optional et As erRestType = erQueryPerRow, _
Optional hc As cCell = Nothing, _
Optional rq As String = vbNullString, _
Optional ds As cDataSet = Nothing, _
Optional pop As Boolean = True, _
Optional pUrl As String = vbNullString, _
Optional clearmissing As Boolean = True, _
Optional treesearch As Boolean = False, _
Optional complain As Boolean = True, _
Optional sIgnore As String = vbNullString, _
Optional user As String = vbNullString, _
Optional pass As String = vbNullString, _
Optional append As Boolean = False, _
Optional stampQuery As cCell = Nothing, _
Optional appendQuery As String = vbNullString, _
Optional libAccept As String = vbNullString, _
Optional bWire As Boolean = False, _
Optional collectionNeeded As Boolean = True, _
Optional bAlwaysEncode As Boolean = False, _
Optional timeout As Long = 0, _
Optional postData As String = vbNullString, _
Optional resultsFormat As erResultsFormat = erJSON, _
Optional oa As cOauth2 = Nothing) As cRest
' query control
pAlwaysEncode = bAlwaysEncode
pAppendQuery = appendQuery
pResponseData = rData
perType = et
pTreeSearch = treesearch
pClearMissingCells = clearmissing
pIgnore = sIgnore
pPass = pass
pUser = user
pAppend = append
pAccept = libAccept
pWire = bWire
pCollectionNeeded = collectionNeeded
pTimeout = timeout
pPost = postData
Set pStamp = stampQuery
pResultsFormat = resultsFormat
Set poAuth2 = oa
' every jobject for every row
Set pJobjects = New Collection
Set pQueryhCell = hc
If perType = erQueryPerRow And pQueryhCell Is Nothing Then
If complain Then
MsgBox ("You need to specify a column for rowwise queries")
End If
Exit Function
End If
pQueryString = rq
pRestUrlStem = pUrl
' data set control
Set pDset = ds
If pDset Is Nothing Then
If Not hc Is Nothing Then
Set pDset = hc.parent.parent
End If
End If
' population control
pPopulate = pop
If pDset Is Nothing And pPopulate Then
If complain Then
MsgBox ("You need to specify a dataset")
End If
Exit Function
End If
Set init = Me
End Function
Private Function executeSingle(Optional rurl As String = vbNullString, _
Optional qry As String = vbNullString, _
Optional complain As Boolean = True, _
Optional sFix As String = vbNullString _
) As cJobject
Dim job As cJobject, jot As cJobject, authHeader As String
' we can supply this at run time
If rurl <> vbNullString Then pRestUrlStem = rurl
If qry <> vbNullString Then pQueryString = qry
If (sFix = vbNullString) Then
Debug.Print encodedUri
' we can use post if any post data is specified
authHeader = vbNullString
If Not poAuth2 Is Nothing Then
authHeader = poAuth2.authHeader
End If
If (pPost = vbNullString) Then
pResponse = pBrowser.httpGET(encodedUri, pUser, pPass, pAccept, pTimeout, authHeader)
Else
pResponse = pBrowser.httpPost(encodedUri, pPost, , authHeader)
End If
If pIgnore <> vbNullString And pResultsFormat = erJSON Then
If left(pResponse, Len(pIgnore)) = pIgnore Then
pResponse = "{" & "'crest'" & ":" _
& Mid(pResponse, Len(pIgnore) + 1) & "}"
End If
End If
' now another tweak no quotes round the keys
If pWire Then pResponse = rxReplace("(\w+)(:)", pResponse, "'$1':")
Else
pResponse = sFix
End If
' deserialize the result
Set job = jObject(complain)
If (job Is Nothing) Then Exit Function
If pCollectionNeeded Then
pJobjects.add job
Else
pJobjects.add job.key
End If
If Not job.isValid Then
If complain Then
MsgBox ("Badly formed jSon returned for query" & _
pQueryString & "-" & pResponse)
End If
Else
If respRootJob(job) Is Nothing Then
If complain Then
MsgBox ("No results for query " _
& pQueryString _
& "-" & job.serialize(True))
End If
Else
Set executeSingle = job
End If
End If
End Function
Public Function execute(Optional qry As String = vbNullString, _
Optional sFix As String = vbNullString, _
Optional complain As Boolean = True) As cRest
Dim Cc As cCell, dr As cDataRow, job As cJobject, n As Long
Select Case perType
Case erSingleQuery
'clear current data
If Not pDset Is Nothing Then
If Not pDset.where Is Nothing And Not pAppend Then
pDset.where.ClearContents
End If
End If
' do a single query that populates multiple rows
Set job = executeSingle(, qry, complain, sFix)
If Not job Is Nothing Then
If (Not populateRows(job, complain) Is Nothing) Then
'update the dataset with the new values
Set pDset = pDset.rePopulate
Set execute = Me
End If
End If
Case erQueryPerRow
' do a query for each row
With pDset
n = 0
For Each dr In .rows
Set job = executeSingle(, URLEncode(dr.cell(pQueryhCell.toString).toString), , sFix)
If Not job Is Nothing Then
If (Not populateOneRow(job, dr) Is Nothing) Then n = n + 1
End If
Next dr
' write it all back to the sheet
If (n > 0) Then
If (pClearMissingCells) Then
.bigCommit
Else
.flushDirtyColumns
End If
End If
End With
Case default
Debug.Assert False
Exit Function
End Select
Set execute = Me
End Function
Private Function populateOneRow(job As cJobject, dr As cDataRow) As cDataRow
Dim jo As cJobject, dc As cCell, jof As cJobject
'populate cells with response - this populate cells in this row
If Not pPopulate Then Exit Function
' this is a real update data call
Set jo = respRootJob(job)
Set pDatajObject = jo
For Each dc In pDset.headings
' leave the query column intact
If (dc.column <> pQueryhCell.column) Then
' update with new value
Set jof = childOrFindJob(jo, dc.toString)
If Not jof Is Nothing Then
dr.cell(dc.column).value = getValueFromJo(jof, dc.toString)
' if its not a reponse item, then clear it if required
ElseIf pClearMissingCells Then
dr.cell(dc.column).value = Empty
End If
End If
Next dc
' for convenience
Set populateOneRow = dr
End Function
Private Function populateRows(job As cJobject, Optional complain As Boolean = True) As cRest
Dim jo As cJobject, dc As cCell, iAppend As Long, dotless As String
'populate cells with response - this populate cells in this row
Set pDatajObject = respRootJob(job)
If Not pPopulate Then Exit Function
' this is a real update data call
iAppend = 0
If pAppend Then iAppend = pDset.rows.count
With pDatajObject
If .hasChildren Then
For Each jo In .children
' now match whatever column headings there are
For Each dc In pDset.headings
dotless = stripDots(dc.toString)
If Not jo.child(dotless) Is Nothing Then
dc.where.Offset(jo.childIndex + iAppend).value = _
getValueFromJo(jo.child(dotless), dc.toString)
' this is to deal with when a query which is supposed to create and array doesnt
ElseIf Not jo.parent.child(dotless) Is Nothing Then
dc.where.Offset(jo.childIndex + iAppend).value = _
getValueFromJo(jo.parent.child(dotless), dc.toString)
End If
Next dc
If Not pStamp Is Nothing Then
pStamp.where.Offset(jo.childIndex + iAppend).value = queryString
End If
' this is where it wasnt actually an array, but should have been
If Not .isArrayRoot Then Exit For
Next jo
Set populateRows = Me
Else
If complain Then
MsgBox ("Could find no data for query " _
& pQueryString _
& "-" & job.serialize)
End If
End If
End With
End Function
Function getValueFromJo(jo As cJobject, originalKey As String) As Variant
Dim s As String, jom As cJobject, searchKey As String, _
needDots As Boolean, t As String, jot As cJobject
' now deal with syntax like obj..field
needDots = isDots(originalKey)
If needDots Then searchKey = dotsTail(originalKey)
If jo.isArrayRoot Then
s = vbNullString
If jo.hasChildren Then
' this is aboutmaking a comma separated array
For Each jom In jo.children
t = vbNullString
With jom
If (needDots) Then
Set jot = .find(searchKey)
If Not jot Is Nothing Then
t = jot.toString
End If
Else
t = .toString
End If
If t <> vbNullString Then
If s <> vbNullString Then s = s & ","
s = s & t
End If
End With
Next jom
End If
getValueFromJo = s
Else
getValueFromJo = jo.value
End If
End Function
Public Property Get browser() As cBrowser
Set browser = pBrowser
End Property
Private Sub Class_Initialize()
Set pBrowser = New cBrowser
End Sub
Raw
restLibrary.vba
'[email protected] :do not modify this line - see ramblings.mcpher.com for details: updated on 4/28/2014 10:14:55 AM : from manifest:5055578 gist https://gist.github.com/brucemcpherson/3423885/raw/restLibrary.vba
Option Explicit
' v2.25
'for more about this
' http://ramblings.mcpher.com/Home/excelquirks/classeslink/data-manipulation-classes
'to contact me
' http://groups.google.com/group/excel-ramblings
'reuse of code
' http://ramblings.mcpher.com/Home/excelquirks/codeuse
' restlibrary - this is an automated rest query to excel table set of known queries
'
Const getItFrom = ""
''Const getItFrom = "https://script.google.com/a/macros/mcpher.com/s/AKfycbzLqpnQ2ey8CKAMmzchb2n2FU-aiae0iTKPzAOfAgEpxGwaJgk/exec"
' simplified interface
Public Function generalQuery(sheetName As String, _
libEntry As String, queryString As String, _
Optional breport As Boolean = True, _
Optional queryCanBeBlank As Boolean = False, _
Optional appendQuery As String = vbNullString) As cRest
Set generalQuery = generalReport( _
restQuery(sheetName, libEntry, queryString, , , , , , , , queryCanBeBlank, , , , , , appendQuery), breport)
End Function
Public Function generalDataSetQuery(sheetName As String, _
libEntry As String, colName As String, _
Optional breport As Boolean = True, _
Optional queryCanBeBlank As Boolean = False, _
Optional appendQuery As String = vbNullString, _
Optional collectionNeeded As Boolean = True) As cRest
Set generalDataSetQuery = generalReport( _
restQuery(sheetName, libEntry, , colName, _
, , , , , , , , , , , , appendQuery, collectionNeeded), breport)
End Function
Public Function generalReport(cr As cRest, breport As Boolean) As cRest
If cr Is Nothing Then
MsgBox ("failed to get any data")
Else
If breport Then
MsgBox (cr.jObjects.Count & " items retrieved ")
End If
End If
Set generalReport = cr
End Function
Public Function getRestLibrary() As cJobject
' build it locally as previously
Dim cb As cBrowser, cj As cJobject
If getItFrom = vbNullString Then
Set getRestLibrary = createRestLibrary
Else
' get it from an API server
Set cb = New cBrowser
cb.init
Set cj = New cJobject
Set getRestLibrary = cj.init(Nothing).deSerialize(cb.httpGET(getItFrom))
End If
End Function
Public Function createRestLibrary() As cJobject
' this creates the restlibrary as a jSon object
Dim cj As cJobject
Set cj = New cJobject
cj.init Nothing, "restLibrary"
With cj
With .add("lescourses")
.add "restType", erSingleQuery
.add "url", "http://www.geny.com/stats-records-hand-flux-donnees?typeStats=jockey-pmu&type=json&id_course="
.add "results", "ResultSet.partants"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("imdb by id")
.add "restType", erQueryPerRow
.add "url", "http://www.omdbapi.com/?i="
.add "results", vbNullString
.add "treeSearch", False
.add "ignore", vbNullString
End With
With .add("ua accounts")
.add "restType", erSingleQuery
.add "url", "https://www.googleapis.com/analytics/v3/management/accounts"
.add "results", "items"
.add "treeSearch", True
.add "ignore", vbNullString
.add "authType", erOAUTH2
.add "authScope", "analytics"
End With
With .add("ua web properties")
.add "restType", erSingleQuery
.add "url", "https://www.googleapis.com/analytics/v3/management/accounts/"
.add "results", "items"
.add "treeSearch", True
.add "ignore", vbNullString
.add "authType", erOAUTH2
.add "authScope", "analytics"
.add "append", "/webproperties"
End With
With .add("ua data")
.add "restType", erSingleQuery
.add "url", "https://www.googleapis.com/analytics/v3/data/ga?ids=ga:"
.add "results", ""
.add "treeSearch", True
.add "ignore", vbNullString
.add "authType", erOAUTH2
.add "authScope", "analytics"
End With
With .add("open weather xml")
.add "restType", erQueryPerRow
.add "url", "http://api.openweathermap.org/data/2.5/weather?q="
.add "results", "current"
.add "treeSearch", True
.add "ignore", vbNullString
.add "append", "&mode=xml"
.add "resultsFormat", erAUTO
End With
With .add("funds")
.add "restType", erSingleQuery
.add "url", "https://newtemplate.hosts.webrecs.com/alfresco/service/webrecs/fundsearcher.xml?full=true"
.add "results", "funds.sites"
.add "treeSearch", True
.add "ignore", vbNullString
.add "resultsFormat", erAUTO
End With
With .add("fusiondata")
.add "restType", erSingleQuery
.add "url", "https://www.googleapis.com/fusiontables/v1/query?key="
.add "results", ""
.add "treeSearch", True
.add "ignore", vbNullString
.add "append", "&sql="
End With
With .add("my society")
.add "restType", erQueryPerRow
.add "url", "http://mapit.mysociety.org/postcode/"
.add "results", "areas"
.add "treeSearch", True
.add "ignore", vbNullString
.add "alwaysEncode", True
End With
With .add("tagsite")
.add "restType", erSingleQuery
.add "url", "https://script.google.com/macros/s/AKfycbz4Q0o4R3Kq9KubpgOSU5iy4eY6rcN2KcqGzo6GHi6hxZUM0bA/exec?"
.add "results", "data"
.add "treeSearch", True
.add "ignore", vbNullString
.add "timeout", 200
End With
With .add("tagsitejson")
.add "restType", erSingleQuery
.add "url", "https://googledrive.com/host/"
.add "results", "data"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("colorschemer")
.add "restType", erQueryPerRow
.add "url", "https://script.google.com/macros/s/AKfycbzSdgK85uGHdQ9m076QkPV0B9a2kkgh7JHDmV8kzRgtkriSIwTn/exec?hex="
.add "results", ""
.add "treeSearch", True
.add "ignore", vbNullString
.add "timeout", 30
End With
With .add("fql")
.add "restType", erSingleQuery
.add "url", "http://graph.facebook.com/fql?q="
.add "results", "data"
.add "treeSearch", True
.add "ignore", vbNullString
.add "alwaysEncode", True
End With
With .add("fqlfeed")
.add "restType", erSingleQuery
.add "url", "https://graph.facebook.com/"
.add "results", "data"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("villas")
.add "restType", erSingleQuery
.add "url", "http://www.villasofdistinction.com/tools/export-json/?destination="
.add "results", vbNullString
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("lukas")
.add "restType", erSingleQuery
.add "url", "http://somehere.com/someURL?someparameter="
.add "results", vbNullString
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("foobar")
.add "restType", erSingleQuery
.add "url", "http://somehere.com/someURL?someparameter="
.add "results", "fooson"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("btc-e")
.add "restType", erSingleQuery
.add "url", "https://btc-e.com/api/2/ftc_btc/"
.add "results", vbNullString
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("btc-e-ticker")
.add "restType", erSingleQuery
.add "url", "https://btc-e.com/api/2/ftc_btc/"
.add "results", "ticker"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("nestoria")
.add "restType", erQueryPerRow
.add "url", "http://api.nestoria.co.uk/api?country=uk&pretty=1&action=metadata&encoding=json&"
.add "results", "response.metadata"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("publicstuff")
.add "restType", erSingleQuery
.add "url", "https://script.google.com/a/macros/mcpher.com/s/AKfycbzLXr1aQKQVK2imlIJp9C6m_HEBAmLBiYM28mfnLn_3oIe3c2kN/exec?entry="
.add "results", "results"
.add "treeSearch", False
.add "ignore", vbNullString
End With
With .add("restserver")
.add "restType", erSingleQuery
.add "url", "?entry="
.add "results", "restlibrary"
.add "treeSearch", False
.add "ignore", vbNullString
.add "indirect", "publicstuff"
End With
With .add("duckduckgo")
.add "restType", erSingleQuery
.add "url", "http://api.duckduckgo.com/?format=json&q="
.add "results", "relatedtopics"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("google patents")
.add "restType", erSingleQuery
.add "url", "https://ajax.googleapis.com/ajax/services/search/patent?v=1.0&rsz=8&q="
.add "results", "responseData.results"
.add "treeSearch", False
.add "ignore", vbNullString
End With
With .add("twitter")
.add "restType", erSingleQuery
.add "url", "http://search.twitter.com/search.json?q="
.add "results", "results"
.add "treeSearch", False
.add "ignore", vbNullString
End With
With .add("google books by isbn")
.add "restType", erQueryPerRow
.add "url", "https://www.googleapis.com/books/v1/volumes?q=isbn:"
.add "results", "Items"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("rxNorm drugs")
.add "restType", erSingleQuery
.add "url", "http://rxnav.nlm.nih.gov/REST/drugs?name="
.add "results", "drugGroup.conceptgroup.2.conceptProperties"
.add "treeSearch", True
.add "ignore", vbNullString
.add "accept", "application/json"
End With
With .add("yahoo geocode")
.add "restType", erQueryPerRow
' this was discontinued by yahoo
'.add "url", "http://where.yahooapis.com/geocode?flags=J&location="
.add "url", "http://gws2.maps.yahoo.com/findlocation?flags=J&location="
.add "results", "ResultSet.Result"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("imdb by title")
.add "restType", erQueryPerRow
.add "url", "http://www.imdbapi.com/?tomatoes=true&t="
.add "results", vbNullString
.add "treeSearch", False
.add "ignore", vbNullString
End With
With .add("itunes movie")
.add "restType", erSingleQuery
.add "url", "http://itunes.apple.com/search?entity=movie&media=movie&term="
.add "results", "results"
.add "treeSearch", False
.add "ignore", vbNullString
End With
With .add("google finance")
.add "restType", erQueryPerRow
.add "url", "http://www.google.com/finance/info?infotype=infoquoteall&q="
.add "results", "crest"
.add "treeSearch", True
.add "ignore", vbLf & "//"
End With
With .add("whatthetrend")
.add "restType", erSingleQuery
.add "url", "http://api.whatthetrend.com/api/v2/trends.json"
.add "results", "trends"
.add "treeSearch", False
.add "ignore", vbNullString
End With
With .add("neildegrassetysonquotes")
.add "restType", erSingleQuery
.add "url", "http://www.neildegrassetysonquotes.com/quote_api/random"
.add "results", ""
.add "treeSearch", False
.add "ignore", vbNullString
End With
With .add("tweetsentiments")
.add "restType", erQueryPerRow
.add "url", "http://data.tweetsentiments.com:8080/api/analyze.json?q="
.add "results", "sentiment"
.add "treeSearch", False
.add "ignore", vbNullString
End With
With .add("topsy histogram")
.add "restType", erQueryPerRow
.add "url", "http://otter.topsy.com/searchhistogram.json?period=30&q="
.add "results", "response"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("topsy count")
.add "restType", erQueryPerRow
.add "url", "http://otter.topsy.com/searchcount.json?q="
.add "results", "response"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("tweetsentiment topics")
.add "restType", erQueryPerRow
.add "url", "http://data.tweetsentiments.com:8080/api/search.json?topic="
.add "results", ""
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("tweetsentiment details")
.add "restType", erSingleQuery
.add "url", "http://data.tweetsentiments.com:8080/api/search.json?topic="
.add "results", "results"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("opencorporates reconcile")
.add "restType", erSingleQuery
.add "url", "http://opencorporates.com/reconcile?query="
.add "results", "result"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("f1")
.add "restType", erSingleQuery
.add "url", "http://ergast.com/api/f1.json?limit="
.add "results", "MRData.RaceTable.Races"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("f1 drivers")
.add "restType", erSingleQuery
.add "url", "http://ergast.com/api/f1/drivers.json?limit="
.add "results", "MRData.DriverTable.Drivers"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("e-sim")
.add "restType", erSingleQuery
.add "url", "http://e-sim.org/apiMilitaryUnitMembers.html?id="
.add "results", ""
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("statwiki")
.add "restType", erSingleQuery
.add "url", "http://stats.grok.se/json/fr/"
.add "results", "daily_views"
.add "treeSearch", False
.add "ignore", vbNullString
End With
With .add("GHStatListDB")
.add "restType", erSingleQuery
.add "url", "http://dl.dropbox.com/u/6341433/statlist.txt"
.add "results", "result"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("craea")
.add "restType", erRestType.erSingleQuery
.add "url", "http://api.cscpro.org/esim/primera/tax/"
.add "results", "tax"
.add "treeSearch", True
.add "ignore"
.add "append", ".json"
End With
With .add("eSimResource")
.add "restType", erRestType.erSingleQuery
.add "url", "http://api.cscpro.org/esim/primera/market/"
.add "results", "offer"
.add "treeSearch", True
.add "ignore"
.add "append", ".json"
End With
With .add("battlenet")
.add "restType", erRestType.erQueryPerRow
.add "url", "http://us.battle.net/api/wow/item/"
.add "results", ""
.add "treeSearch", False
.add "ignore"
End With
With .add("trello")
.add "restType", erRestType.erSingleQuery
.add "url", "https://api.trello.com/1/board/4ff1644acb179efe1718ec61?key=b5acff6f87bda62eba4ac7f6419fad20"
.add "results", ""
.add "treeSearch", True
.add "ignore"
End With
With .add("huffingtonpost elections")
.add "restType", erRestType.erSingleQuery
.add "url", "http://elections.huffingtonpost.com/pollster/api/charts.json"
.add "results", ""
.add "treeSearch", True
.add "ignore"
End With
With .add("jorum")
.add "restType", erRestType.erSingleQuery
.add "url", "http://dashboard.jorum.ac.uk/stats/"
.add "results", ""
.add "treeSearch", True
.add "ignore"
End With
With .add("mercadolibre")
.add "restType", erRestType.erSingleQuery
.add "url", "https://api.mercadolibre.com/sites/MLA/search?q="
.add "results", "results"
.add "treeSearch", True
.add "ignore"
End With
With .add("EC2")
.add "restType", erRestType.erSingleQuery
.add "url", "http://aws.amazon.com/ec2/pricing/pricing-reserved-instances.json"
.add "results", "config.regions"
.add "treeSearch", True
.add "ignore", ""
End With
With .add("crunchbase relationships")
.add "restType", erRestType.erSingleQuery
.add "url", "http://api.crunchbase.com/v/1/person/"
.add "results", "relationships"
.add "treeSearch", True
.add "ignore", ""
.add "append", ".js"
End With
With .add("crunchbase companies")
.add "restType", erRestType.erSingleQuery
.add "url", "http://api.crunchbase.com/v/1/company/"
.add "results", "relationships"
.add "treeSearch", True
.add "ignore", ""
.add "append", ".js"
End With
With .add("scraperWiki")
.add "restType", erRestType.erSingleQuery
.add "url", "https://api.scraperwiki.com/api/1.0/scraper/search?format=jsondict&maxrows="
.add "results", ""
.add "treeSearch", False
.add "ignore", ""
End With
With .add("who was In parliament")
.add "restType", erRestType.erSingleQuery
.add "url", "http://hansard.millbanksystems.com/all-members/"
.add "results", ""
.add "treeSearch", True
.add "ignore", ""
End With
With .add("page rank")
.add "restType", erRestType.erQueryPerRow
.add "url", "http://prapi.net/pr.php?f=json&url="
.add "results", ""
.add "treeSearch", False
.add "ignore", ""
End With
With .add("faa airport status")
.add "restType", erRestType.erQueryPerRow
.add "url", "http://services.faa.gov/airport/status/"
.add "results", ""
.add "treeSearch", False
.add "ignore", ""
.add "append", "?format=json"
End With
With .add("url shorten")
.add "restType", erRestType.erQueryPerRow
.add "url", "http://ttb.li/api/shorten?format=json&appname=ramblings&url="
.add "results", ""
.add "treeSearch", False
.add "ignore", ""
.add "append", ""
End With
With .add("uk postcodes")
.add "restType", erRestType.erQueryPerRow
.add "url", "http://www.uk-postcodes.com/postcode/"
.add "results", ""
.add "treeSearch", False
.add "ignore", ""
.add "append", ".json"
End With
With .add("freegeoip")
.add "restType", erRestType.erQueryPerRow
.add "url", "http://freegeoip.net/json/"
.add "results", ""
.add "treeSearch", False
.add "ignore", ""
.add "append", ""
End With
With .add("googlecurrencyconverter")
.add "restType", erRestType.erQueryPerRow
.add "url", "http://www.google.com/ig/calculator?hl=en&q=1USD=?"
.add "results", ""
.add "treeSearch", False
.add "ignore", vbNullString
.add "wire", True
End With
With .add("rate exchange")
.add "restType", erRestType.erQueryPerRow
.add "url", "http://rate-exchange.appspot.com/currency?from=USD&to="
.add "results", ""
.add "treeSearch", False
.add "ignore", vbNullString
End With
With .add("scraperwikidata")
.add "restType", erRestType.erSingleQuery
.add "url", "https://api.scraperwiki.com/api/1.0/datastore/sqlite?format=jsondict&name="
.add "results", ""
.add "treeSearch", False
.add "ignore", vbNullString
End With
With .add("urbarama")
.add "restType", erRestType.erSingleQuery
.add "url", "http://www.urbarama.com/api/project?sort=popular&offset=0&count=100&size=small&format=json"
.add "results", "projects"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("urbaramamashup")
.add "restType", erRestType.erSingleQuery
.add "url", "?address="
.add "results", "projects"
.add "treeSearch", True
.add "ignore", vbNullString
.add "indirect", "publicstuff"
End With
With .add("builtwith")
.add "restType", erRestType.erSingleQuery
.add "url", "http://api.builtwith.com/api.json?lookup="
.add "results", "Technologies"
.add "treeSearch", False
.add "ignore", vbNullString
.add "append", "&key="
End With
With .add("ESRI Query")
.add "restType", erQueryPerRow
.add "url", "http://server.arcgisonline.com/ArcGIS/rest/services/Specialty/Soil_Survey_Map/MapServer/identify?geometryType=esriGeometryPoint&sr=4326&layers=1&time=&layerTimeOptions=&layerdefs=&tolerance=0&mapExtent=-119%2C38%2C-121%2C41&imageDisplay=400%2C300%2C96&returnGeometry=true&maxAllowableOffset=0&f=json&geometry="
.add "results", "attributes"
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("sina")
.add "restType", erRestType.erSingleQuery
.add "url", "http://stock.finance.sina.com.cn/usstock/api/json.php/US_MinKService.getMinK?type=15&___qn=3&symbol="
.add "results", ""
.add "treeSearch", True
.add "ignore", vbNullString
End With
With .add("blister")
.add "restType", erRestType.erSingleQuery
.add "url", "https://script.google.com/a/macros/mcpher.com/s/AKfycbzhzIDmgY9BNeBu87puxMVUlMkJ4UkD_Yvjdt5MhOxR1R6RG88/exec?type=jsonp&source=scriptdb&module=blister&library="
.add "results", "results"
.add "treeSearch", True
.add "ignore", vbNullString
.add "append", "&query="
End With
With .add("blisterFunctions")
.add "restType", erRestType.erSingleQuery
.add "url", "https://script.google.com/macros/s/AKfycbzBskBK17poScDU9yHnfgmgPHyvgNejM3zxV7niGdhLeXPjw7Y4/exec"
.add "results", ""
.add "treeSearch", False
.add "ignore", vbNullString
End With
With .add("postTest")
.add "restType", erRestType.erSingleQuery
.add "url", "http://posttestserver.com/post.php"
.add "results", ""
.add "treeSearch", False
.add "ignore", vbNullString
End With
End With
Set createRestLibrary = cj
End Function
Public Function restQuery(Optional sheetName As String = vbNullString, _
Optional sEntry As String = vbNullString, _
Optional sQuery As String = vbNullString, _
Optional sQueryColumn As String = vbNullString, _
Optional sRestUrl As String = vbNullString, _
Optional sResponseResults As String = vbNullString, _
Optional bTreeSearch As Boolean = True, _
Optional bPopulate As Boolean = True, _
Optional bClearMissing As Boolean = True, _
Optional complain As Boolean = True, _
Optional queryCanBeBlank As Boolean = False, _
Optional sFix As String = vbNullString, _
Optional user As String = vbNullString, _
Optional pass As String = vbNullString, _
Optional append As Boolean = False, _
Optional stampQuery As String = vbNullString, _
Optional appendQuery As String = vbNullString, _
Optional collectionNeeded As Boolean = True, _
Optional postData As String = vbNullString, _
Optional resultsFormat As erResultsFormat = erUnknown) As cRest
' give it a known name, and somewhere to put the result
' in the case where 1 query returns multiple rows, sQuery is the query contents
' where 1 column contains the query for each row, sQueryColumn contains the name of the column
Dim qType As erRestType, sUrl As String, sResults As String, sEntryType As erRestType, sc As cCell
Dim dset As cDataSet, cr As cRest, sIgnore As String, cj As cJobject, cEntry As cJobject, job As cJobject
Dim libAppend As String, _
libAccept As String, bWire As Boolean, crIndirect As cRest, _
rPlace As Range, bAlwaysEncode As Boolean, timeout As Long, oa As cOauth2
libAppend = vbNullString
libAccept = vbNullString
Dim UA As cUAMeasure
Set UA = registerUA("restQuery_" & sEntry)
timeout = 0
' this is now a library object
Set cEntry = getRestLibrary()
If Not (sQuery = vbNullString Xor sQueryColumn = vbNullString) Then
If Not queryCanBeBlank Then
MsgBox ("you must provide one of either query contents or a query column name")
Exit Function
End If
End If
If Not (sEntry = vbNullString Xor sRestUrl = vbNullString) Then
MsgBox ("you must provide one of either a known library entry or a rest URL")
Exit Function
End If
' based on whether a column name or a query argument was supplied
If sQuery = vbNullString And Not queryCanBeBlank Then
qType = erQueryPerRow
Else
qType = erSingleQuery
End If
' get the characteristics from the crest library
If sEntry = vbNullString Then
sUrl = sRestUrl
sResults = sResponseResults
Set cj = New cJobject
Else
Set cj = cEntry.childExists(sEntry)
If (cj Is Nothing) Then
MsgBox (sEntry & " is not a known library entry")
Exit Function
End If
sEntryType = cj.child("restType").toString
sUrl = cj.child("url").toString
sResults = cj.child("results").toString
bTreeSearch = cj.child("treeSearch").toString = "True"
sIgnore = cj.child("ignore").toString
bAlwaysEncode = False
If Not cj.childExists("timeout") Is Nothing Then timeout = cj.child("timeout").value
If Not cj.childExists("alwaysEncode") Is Nothing Then bAlwaysEncode = cj.child("alwaysEncode").value
If Not cj.childExists("append") Is Nothing Then libAppend = cj.child("append").toString
If Not cj.childExists("accept") Is Nothing Then libAccept = cj.child("accept").toString
If Not cj.childExists("wire") Is Nothing Then bWire = cj.child("wire").value
If resultsFormat = erUnknown And _
Not cj.childExists("resultsFormat") Is Nothing Then resultsFormat = cj.child("resultsFormat").value
If Not cj.childExists("indirect") Is Nothing Then
If cj.child("indirect").toString <> vbNullString Then
' now need to go off and execute that indirection - this could be recursive
Set crIndirect = restQuery("", cj.child("indirect").toString, sEntry, , , , False)
If crIndirect Is Nothing Then Exit Function
sUrl = crIndirect.jObject.children("results").child("1.mystuff.publish").toString & sUrl
End If
End If
If complain Then
If abandonType(sEntry, qType, sEntryType) Then Exit Function
End If
End If
If resultsFormat = erUnknown Then resultsFormat = erJSON
Set cr = New cRest
' first we need to do oauth if its needed
Set job = cj.childExists("authtype")
If Not job Is Nothing And sFix = vbNullString Then
If job.value = erOAUTH2 Then
' need to authorize and get token
Set oa = getGoogled(cj.child("authScope").value)
If (oa Is Nothing) Then Exit Function
Else
MsgBox ("Dont understand authtype " & CStr(job.value))
Exit Function
End If
End If
' lets get the data
Application.Calculation = xlCalculationManual
If (sheetName <> vbNullString) Then
Set dset = New cDataSet
If (InStr(1, sheetName, "!") > 0) Then
Set rPlace = Range(sheetName)
Else
Set rPlace = wholeSheet(sheetName)
End If
If (IsEmpty(rPlace.Cells(1, 1))) Then rPlace.Cells(1, 1).value = "crest"
With dset.populateData(toEmptyBox(rPlace))
' ensure that the query column exists if it was asked for
If qType = erQueryPerRow Then
If Not .headingRow.validate(True, sQueryColumn) Then Exit Function
End If
If stampQuery <> vbNullString Then
If Not .headingRow.validate(True, stampQuery) Then Exit Function
Set sc = .headingRow.exists(stampQuery)
End If
' alsmost there
Set cr = cr.init(sResults, qType, .headingRow.exists(sQueryColumn), _
, dset, bPopulate, sUrl, bClearMissing, _
bTreeSearch, complain, sIgnore, user, pass, append, sc, _
libAppend & appendQuery, libAccept, bWire, collectionNeeded, _
bAlwaysEncode, timeout, postData, resultsFormat, oa)
End With
Else
Set cr = cr.init(sResults, qType, , _
, , False, sUrl, , _
bTreeSearch, complain, sIgnore, user, pass, append, sc, _
libAppend & appendQuery, libAccept, bWire, collectionNeeded, _
bAlwaysEncode, timeout, postData, resultsFormat, oa)
End If
If cr Is Nothing Then
If complain Then MsgBox ("failed to initialize a rest class")
Else
Set cr = cr.execute(sQuery, sFix, complain)
If cr Is Nothing Then
If complain Then MsgBox ("failed to execute " & sQuery)
Else
Set restQuery = cr
End If
End If
UA.postAppKill.tearDown
Application.Calculation = xlCalculationAutomatic
End Function
Private Function abandonType(sEntry, qType As erRestType, targetType As erRestType) As Boolean
If qType <> targetType Then
abandonType = Not (vbYes = MsgBox(sEntry & " is normally " & _
whichType(targetType) & _
" but you have specified " & _
whichType(qType) & ": try anyway?", vbYesNo))
Else
abandonType = False
End If
End Function
Private Function whichType(t As erRestType) As String
Select Case t
Case erSingleQuery
whichType = " single query that can return multiple rows"
Case erQueryPerRow
whichType = " a single column provides the query data for each row"
Case Default
Debug.Assert False
End Select
End Function
Public Function createHeadingsFromKeys(job As cJobject, ds As cDataSet) As cDataSet
' use the keys of a cJobject as the headings
Dim r As Range, jo As cJobject, dsNew As cDataSet
' clear the existing set
Set r = ds.headingRow.where
r.Worksheet.Cells.ClearContents
If (Not job.hasChildren) Then
MsgBox ("cjobject has no children to create headers from")
Else
For Each jo In job.children
r.Offset(, jo.childIndex - 1).value = "'" & jo.key()
Next jo
Set dsNew = New cDataSet
Set createHeadingsFromKeys = dsNew.populateData(r, , ds.name & "crest", , , , True)
End If
End Function
Public Function getAndMakeJobjectFromXML(url As String) As cJobject
' we do an get on the given url
Dim cb As cBrowser, helperUrl As String
Set cb = New cBrowser
helperUrl = _
"https://script.google.com/macros/s/AKfycbziYOdWjNFtUR_TTQU-GiMYkan2h5ZDtaqeWIsYUAKEa6irjzNa/exec"
With cb
' get the xml
.httpGET url
If .isOk Then
Set getAndMakeJobjectFromXML = makeJobjectFromXML(.Text)
Else
MsgBox ("error getting " & url)
End If
.tearDown
End With
End Function
Public Function makeJobjectFromXML(theXml As String, Optional complain As Boolean = True) As cJobject
' we do an get on the given url
Dim cb As cBrowser, helperUrl As String
Set cb = New cBrowser
helperUrl = _
"https://script.google.com/macros/s/AKfycbziYOdWjNFtUR_TTQU-GiMYkan2h5ZDtaqeWIsYUAKEa6irjzNa/exec"
With cb
'now convert to json using google apps script helper
.httpPost helperUrl, theXml, True
' now we have it converted to json
If .isOk Then
With JSONParse(.Text)
If .toString("status") = "good" Then
Set makeJobjectFromXML = .child("json")
Else
If complain Then MsgBox (.toString("error") & " converting xml")
End If
End With
Else
If complain Then MsgBox (.status & " error getting xml convertor")
End If
.tearDown
End With
End Function
Public Function getAndMakeJobjectAuto(url As String) As cJobject
' we do an get on the given url
Dim cb As cBrowser, job As cJobject
Set cb = New cBrowser
With cb
' get the xml
.httpGET url
If .isOk Then
' try converting it from xml
Set job = xmlStringToJobject(.Text, False)
' that didnt work, so assume its already json
If job Is Nothing Then
Set job = JSONParse(.Text)
End If
Set getAndMakeJobjectAuto = job
Else
MsgBox ("error getting " & url)
End If
.tearDown
End With
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment