From dd9068b7c64144e53275594e4c3e51be888c6bca Mon Sep 17 00:00:00 2001 From: Tim Hall Date: Sun, 3 Aug 2014 15:56:59 -0400 Subject: [PATCH] Add plain text and xml formats --- specs/RestClientSpecs.bas | 72 +++++++++++++++++++++++++++++++++++ specs/RestHelpersSpecs.bas | 17 +++++++++ specs/server.js | 10 +++++ src/RestHelpers.bas | 77 ++++++++++++++++++++++++++++---------- src/RestRequest.cls | 40 +++++++------------- 5 files changed, 170 insertions(+), 46 deletions(-) diff --git a/specs/RestClientSpecs.bas b/specs/RestClientSpecs.bas index 5cfcd7d1..199bc85d 100644 --- a/specs/RestClientSpecs.bas +++ b/specs/RestClientSpecs.bas @@ -21,6 +21,7 @@ Public Function Specs() As SpecSuite Dim BodyToString As String Dim i As Integer Dim Options As Dictionary + Dim XMLBody As Object Client.BaseUrl = "http://localhost:3000/" @@ -272,6 +273,77 @@ Public Function Specs() As SpecSuite .Expect(Response.Data("headers")("accept")).ToEqual "application/json" End With + With Specs.It("should convert and parse json") + Set Request = New RestRequest + Request.Resource = "json" + Request.Format = json + Request.Method = httpGET + + Set Body = New Dictionary + Body.Add "a", 123 + Body.Add "b", 456 + Request.AddBody Body + + Set Response = Client.Execute(Request) + + .Expect(Request.Body).ToEqual "{""a"":123,""b"":456}" + .Expect(Response.Data("a")).ToEqual "1" + .Expect(Response.Data("b")).ToEqual 2 + .Expect(Response.Data("c")).ToEqual 3.14 + End With + + With Specs.It("should convert and part url-encoded") + Set Request = New RestRequest + Request.Resource = "formurlencoded" + Request.Format = formurlencoded + Request.Method = httpGET + + Set Body = New Dictionary + Body.Add "a", 123 + Body.Add "b", 456 + Request.AddBody Body + + Set Response = Client.Execute(Request) + + .Expect(Request.Body).ToEqual "a=123&b=456" + .Expect(Response.Data("a")).ToEqual "1" + .Expect(Response.Data("b")).ToEqual "2" + .Expect(Response.Data("c")).ToEqual "3.14" + End With + + With Specs.It("should convert and parse XML") + Set Request = New RestRequest + Request.Resource = "xml" + Request.Format = xml + Request.Method = httpGET + + Set XMLBody = New MSXML2.DOMDocument60 + XMLBody.async = False + XMLBody.LoadXML "1.234.56" + Request.AddBody XMLBody + + Set Response = Client.Execute(Request) + + .Expect(Request.Body).ToEqual "1.234.56" + .Expect(Response.Content).ToEqual "1.234.56" + .Expect(Response.Data.FirstChild.SelectSingleNode("X").Text).ToEqual "1.23" + .Expect(Response.Data.FirstChild.SelectSingleNode("Y").Text).ToEqual "4.56" + End With + + With Specs.It("should convert and parse plaintext") + Set Request = New RestRequest + Request.Resource = "howdy" + Request.Format = plaintext + Request.Method = httpGET + + Request.AddBody "Hello?" + Set Response = Client.Execute(Request) + + .Expect(Request.Body).ToEqual "Hello?" + .Expect(Response.Content).ToEqual "Howdy!" + .Expect(Response.Data).ToBeUndefined + End With + Set Client = Nothing InlineRunner.RunSuite Specs diff --git a/specs/RestHelpersSpecs.bas b/specs/RestHelpersSpecs.bas index b800f02e..e333fea3 100644 --- a/specs/RestHelpersSpecs.bas +++ b/specs/RestHelpersSpecs.bas @@ -42,6 +42,7 @@ Public Function Specs() As SpecSuite Dim Request As RestRequest Dim Response As RestResponse Dim UpdatedResponse As RestResponse + Dim XMLBody As Object ' ============================================= ' ' 2. Converters and encoding @@ -168,6 +169,22 @@ Public Function Specs() As SpecSuite .Expect(Parsed("d & e")).ToEqual "A + B" End With + With Specs.It("should convert to XML") + Set XMLBody = New MSXML2.DOMDocument60 + XMLBody.async = False + XMLBody.LoadXML "1.234.56" + + Encoded = RestHelpers.ConvertToXML(XMLBody) + .Expect(Encoded).ToEqual "1.234.56" + End With + + With Specs.It("should parse XML") + Set Parsed = RestHelpers.ParseXML("1.234.56") + + .Expect(Parsed.FirstChild.SelectSingleNode("X").Text).ToEqual "1.23" + .Expect(Parsed.FirstChild.SelectSingleNode("Y").Text).ToEqual "4.56" + End With + ' ============================================= ' ' 3. Url handling ' ============================================= ' diff --git a/specs/server.js b/specs/server.js index 39381839..6e40d3b0 100644 --- a/specs/server.js +++ b/specs/server.js @@ -37,6 +37,16 @@ app.get('/json', function(req, res) { res.json({a: '1', b: 2, c: 3.14, d: false, e: [4, 5], f: {a: '1', b: 2}}); }); +// form-urlencoded +app.get('/formurlencoded', function(req, res) { + res.send(200, 'a=1&b=2&c=3.14'); +}); + +// xml +app.get('/xml', function(req, res) { + res.send(200, '1.234.56') +}); + // Cookies app.get('/cookie', function(req, res) { res.cookie('unsigned-cookie', 'simple-cookie'); diff --git a/src/RestHelpers.bas b/src/RestHelpers.bas index 816959b1..80af9bb9 100644 --- a/src/RestHelpers.bas +++ b/src/RestHelpers.bas @@ -279,18 +279,28 @@ Public Function ConvertToUrlEncoded(Obj As Variant) As String ConvertToUrlEncoded = Encoded End Function -Public Function DictionariesToUrlEncodedString(ParamArray Dictionaries() As Variant) As String - Debug.Print "Excel-REST: DEPRECATED DictionariesToUrlEncodedString has been deprecated in favor of ConvertToUrlEncoded. It will be removed in Excel-REST v4" - - Dim i As Integer - Dim Combined As Dictionary - - Set Combined = Dictionaries(LBound(Dictionaries)) - For i = LBound(Dictionaries) + 1 To UBound(Dictionaries) - Set Combined = CombineObjects(Combined, Dictionaries(i)) - Next i - - DictionariesToUrlEncodedString = ConvertToUrlEncoded(Combined) +'' +' Parse XML string to XML +' +' @param {String} Encoded +' @return {Object} XML +' --------------------------------------------- ' +Public Function ParseXML(Encoded As String) As Object + Set ParseXML = New MSXML2.DOMDocument + ParseXML.async = False + ParseXML.LoadXML Encoded +End Function + +'' +' Convert MSXML2.DomDocument to string +' +' @param {Object: MSXML2.DomDocument} XML +' @return {String} XML string +' --------------------------------------------- ' + +Public Function ConvertToXML(Obj As Variant) As String + On Error Resume Next + ConvertToXML = Trim(Replace(Obj.xml, vbCrLf, "")) End Function '' @@ -306,6 +316,8 @@ Public Function ParseByFormat(Value As String, Format As AvailableFormats) As Ob Set ParseByFormat = ParseJSON(Value) Case AvailableFormats.formurlencoded Set ParseByFormat = ParseUrlEncoded(Value) + Case AvailableFormats.xml + Set ParseByFormat = ParseXML(Value) End Select End Function @@ -322,6 +334,8 @@ Public Function ConvertToFormat(Obj As Variant, Format As AvailableFormats) As S ConvertToFormat = ConvertToJSON(Obj) Case AvailableFormats.formurlencoded ConvertToFormat = ConvertToUrlEncoded(Obj) + Case AvailableFormats.xml + ConvertToFormat = ConvertToXML(Obj) End Select End Function @@ -603,7 +617,7 @@ End Function ' --------------------------------------------- ' Public Function IsArray(Obj As Variant) As Boolean If Not IsEmpty(Obj) Then - If VarType(Obj) = vbObject Then + If IsObject(Obj) Then If TypeOf Obj Is Collection Then IsArray = True End If @@ -614,6 +628,21 @@ Public Function IsArray(Obj As Variant) As Boolean End If End Function +'' +' Add or update key/value in dictionary +' +' @param {Dictionary} Dict +' @param {String} Key +' @param {Variant} Value +' --------------------------------------------- ' +Public Sub AddToDictionary(ByRef Dict As Dictionary, Key As String, Value As Variant) + If Not Dict.Exists(Key) Then + Dict.Add Key, Value + Else + Dict(Key) = Value + End If +End Sub + ' ============================================= ' ' 5. Request preparation / handling ' ============================================= ' @@ -790,7 +819,9 @@ Public Function CreateResponseFromHttp(ByRef Http As Object, Optional Format As CreateResponseFromHttp.Content = Http.ResponseText ' Convert content to data by format - Set CreateResponseFromHttp.Data = RestHelpers.ParseByFormat(Http.ResponseText, Format) + If Format <> AvailableFormats.plaintext Then + Set CreateResponseFromHttp.Data = RestHelpers.ParseByFormat(Http.ResponseText, Format) + End If ' Extract headers Set CreateResponseFromHttp.Headers = ExtractHeadersFromResponseHeaders(Http.getAllResponseHeaders) @@ -924,7 +955,7 @@ Public Function UpdateResponse(ByRef Original As RestResponse, Updated As RestRe Set Original.Cookies = Updated.Cookies If Not IsEmpty(Updated.Data) Then - If VarType(Updated.Data) = vbObject Then + If IsObject(Updated.Data) Then Set Original.Data = Updated.Data Else Original.Data = Updated.Data @@ -946,6 +977,10 @@ Public Function FormatToName(Format As AvailableFormats) As String FormatToName = "form-urlencoded" Case AvailableFormats.json FormatToName = "json" + Case AvailableFormats.xml + FormatToName = "xml" + Case AvailableFormats.plaintext + FormatToName = "txt" End Select End Function @@ -961,6 +996,10 @@ Public Function FormatToContentType(Format As AvailableFormats) As String FormatToContentType = "application/x-www-form-urlencoded;charset=UTF-8" Case AvailableFormats.json FormatToContentType = "application/json" + Case AvailableFormats.xml + FormatToContentType = "application/xml" + Case AvailableFormats.plaintext + FormatToContentType = "text/plain" End Select End Function @@ -1090,18 +1129,18 @@ Public Function BytesToHex(Bytes() As Byte) As String End Function Public Function BytesToBase64(Bytes() As Byte) As String - Dim XML As Object + Dim xml As Object Dim Node As Object - Set XML = CreateObject("MSXML2.DOMDocument") + Set xml = CreateObject("MSXML2.DOMDocument") ' byte array to base64 - Set Node = XML.createElement("b64") + Set Node = xml.createElement("b64") Node.DataType = "bin.base64" Node.nodeTypedValue = Bytes BytesToBase64 = Node.Text Set Node = Nothing - Set XML = Nothing + Set xml = Nothing End Function '' diff --git a/src/RestRequest.cls b/src/RestRequest.cls index 7aa96d12..869acca8 100644 --- a/src/RestRequest.cls +++ b/src/RestRequest.cls @@ -48,8 +48,10 @@ Public Enum AvailableMethods httpPATCH End Enum Public Enum AvailableFormats + plaintext json formurlencoded + xml End Enum ' --------------------------------------------- ' @@ -178,7 +180,11 @@ Public Property Get Body() As String BodyValue = pBody End If - Body = RestHelpers.ConvertToFormat(BodyValue, Me.RequestFormat) + If Me.RequestFormat <> AvailableFormats.plaintext Then + Body = RestHelpers.ConvertToFormat(BodyValue, Me.RequestFormat) + Else + Body = BodyValue + End If End If End If End Property @@ -281,11 +287,7 @@ End Property ' --------------------------------------------- ' Public Sub AddHeader(Key As String, Value As String) - If Not Me.Headers.Exists(Key) Then - Me.Headers.Add Key, Value - Else - Me.Headers(Key) = Value - End If + RestHelpers.AddToDictionary Me.Headers, Key, Value End Sub '' @@ -296,11 +298,7 @@ End Sub ' --------------------------------------------- ' Public Sub AddUrlSegment(segment As String, Value As String) - If Not Me.UrlSegments.Exists(segment) Then - Me.UrlSegments.Add segment, Value - Else - Me.UrlSegments(segment) = Value - End If + RestHelpers.AddToDictionary Me.UrlSegments, segment, Value End Sub '' @@ -311,11 +309,7 @@ End Sub ' --------------------------------------------- ' Public Sub AddParameter(Key As String, Value As Variant) - If Not Me.Parameters.Exists(Key) Then - Me.Parameters.Add Key, Value - Else - Me.Parameters(Key) = Value - End If + RestHelpers.AddToDictionary Me.Parameters, Key, Value End Sub '' @@ -326,11 +320,7 @@ End Sub ' --------------------------------------------- ' Public Sub AddQuerystringParam(Key As String, Value As Variant) - If Not Me.QuerystringParams.Exists(Key) Then - Me.QuerystringParams.Add Key, Value - Else - Me.QuerystringParams(Key) = Value - End If + RestHelpers.AddToDictionary Me.QuerystringParams, Key, Value End Sub '' @@ -341,11 +331,7 @@ End Sub ' --------------------------------------------- ' Public Sub AddCookie(Key As String, Value As Variant) - If Not Me.Cookies.Exists(Key) Then - Me.Cookies.Add Key, Value - Else - Me.Cookies(Key) = Value - End If + RestHelpers.AddToDictionary Me.Cookies, Key, Value End Sub '' @@ -355,7 +341,7 @@ End Sub ' --------------------------------------------- ' Public Function AddBody(BodyVal As Variant) - If VarType(BodyVal) = vbObject Then + If IsObject(BodyVal) Then Set pBody = BodyVal ElseIf RestHelpers.IsArray(BodyVal) Then pBody = BodyVal