Skip to content

Commit dd9068b

Browse files
timhalltimhall
committed
Add plain text and xml formats
1 parent 3c51334 commit dd9068b

File tree

5 files changed

+170
-46
lines changed

5 files changed

+170
-46
lines changed

‎specs/RestClientSpecs.bas‎

Lines changed: 72 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ Public Function Specs() As SpecSuite
2121
Dim BodyToString As String
2222
Dim i As Integer
2323
Dim Options As Dictionary
24+
Dim XMLBody As Object
2425

2526
Client.BaseUrl = "http://localhost:3000/"
2627

@@ -272,6 +273,77 @@ Public Function Specs() As SpecSuite
272273
.Expect(Response.Data("headers")("accept")).ToEqual "application/json"
273274
End With
274275

276+
With Specs.It("should convert and parse json")
277+
Set Request = New RestRequest
278+
Request.Resource = "json"
279+
Request.Format = json
280+
Request.Method = httpGET
281+
282+
Set Body = New Dictionary
283+
Body.Add "a", 123
284+
Body.Add "b", 456
285+
Request.AddBody Body
286+
287+
Set Response = Client.Execute(Request)
288+
289+
.Expect(Request.Body).ToEqual "{""a"":123,""b"":456}"
290+
.Expect(Response.Data("a")).ToEqual "1"
291+
.Expect(Response.Data("b")).ToEqual 2
292+
.Expect(Response.Data("c")).ToEqual 3.14
293+
End With
294+
295+
With Specs.It("should convert and part url-encoded")
296+
Set Request = New RestRequest
297+
Request.Resource = "formurlencoded"
298+
Request.Format = formurlencoded
299+
Request.Method = httpGET
300+
301+
Set Body = New Dictionary
302+
Body.Add "a", 123
303+
Body.Add "b", 456
304+
Request.AddBody Body
305+
306+
Set Response = Client.Execute(Request)
307+
308+
.Expect(Request.Body).ToEqual "a=123&b=456"
309+
.Expect(Response.Data("a")).ToEqual "1"
310+
.Expect(Response.Data("b")).ToEqual "2"
311+
.Expect(Response.Data("c")).ToEqual "3.14"
312+
End With
313+
314+
With Specs.It("should convert and parse XML")
315+
Set Request = New RestRequest
316+
Request.Resource = "xml"
317+
Request.Format = xml
318+
Request.Method = httpGET
319+
320+
Set XMLBody = New MSXML2.DOMDocument60
321+
XMLBody.async = False
322+
XMLBody.LoadXML "<Point><X>1.23</X><Y>4.56</Y></Point>"
323+
Request.AddBody XMLBody
324+
325+
Set Response = Client.Execute(Request)
326+
327+
.Expect(Request.Body).ToEqual "<Point><X>1.23</X><Y>4.56</Y></Point>"
328+
.Expect(Response.Content).ToEqual "<Point><X>1.23</X><Y>4.56</Y></Point>"
329+
.Expect(Response.Data.FirstChild.SelectSingleNode("X").Text).ToEqual "1.23"
330+
.Expect(Response.Data.FirstChild.SelectSingleNode("Y").Text).ToEqual "4.56"
331+
End With
332+
333+
With Specs.It("should convert and parse plaintext")
334+
Set Request = New RestRequest
335+
Request.Resource = "howdy"
336+
Request.Format = plaintext
337+
Request.Method = httpGET
338+
339+
Request.AddBody "Hello?"
340+
Set Response = Client.Execute(Request)
341+
342+
.Expect(Request.Body).ToEqual "Hello?"
343+
.Expect(Response.Content).ToEqual "Howdy!"
344+
.Expect(Response.Data).ToBeUndefined
345+
End With
346+
275347
Set Client = Nothing
276348

277349
InlineRunner.RunSuite Specs

‎specs/RestHelpersSpecs.bas‎

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -42,6 +42,7 @@ Public Function Specs() As SpecSuite
4242
Dim Request As RestRequest
4343
Dim Response As RestResponse
4444
Dim UpdatedResponse As RestResponse
45+
Dim XMLBody As Object
4546

4647
' ============================================= '
4748
' 2. Converters and encoding
@@ -168,6 +169,22 @@ Public Function Specs() As SpecSuite
168169
.Expect(Parsed("d & e")).ToEqual "A + B"
169170
End With
170171

172+
With Specs.It("should convert to XML")
173+
Set XMLBody = New MSXML2.DOMDocument60
174+
XMLBody.async = False
175+
XMLBody.LoadXML "<Point><X>1.23</X><Y>4.56</Y></Point>"
176+
177+
Encoded = RestHelpers.ConvertToXML(XMLBody)
178+
.Expect(Encoded).ToEqual "<Point><X>1.23</X><Y>4.56</Y></Point>"
179+
End With
180+
181+
With Specs.It("should parse XML")
182+
Set Parsed = RestHelpers.ParseXML("<Point><X>1.23</X><Y>4.56</Y></Point>")
183+
184+
.Expect(Parsed.FirstChild.SelectSingleNode("X").Text).ToEqual "1.23"
185+
.Expect(Parsed.FirstChild.SelectSingleNode("Y").Text).ToEqual "4.56"
186+
End With
187+
171188
' ============================================= '
172189
' 3. Url handling
173190
' ============================================= '

‎specs/server.js‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,16 @@ app.get('/json', function(req, res) {
3737
res.json({a: '1', b: 2, c: 3.14, d: false, e: [4, 5], f: {a: '1', b: 2}});
3838
});
3939

40+
// form-urlencoded
41+
app.get('/formurlencoded', function(req, res) {
42+
res.send(200, 'a=1&b=2&c=3.14');
43+
});
44+
45+
// xml
46+
app.get('/xml', function(req, res) {
47+
res.send(200, '<Point><X>1.23</X><Y>4.56</Y></Point>')
48+
});
49+
4050
// Cookies
4151
app.get('/cookie', function(req, res) {
4252
res.cookie('unsigned-cookie', 'simple-cookie');

‎src/RestHelpers.bas‎

Lines changed: 58 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -279,18 +279,28 @@ Public Function ConvertToUrlEncoded(Obj As Variant) As String
279279
ConvertToUrlEncoded = Encoded
280280
End Function
281281

282-
Public Function DictionariesToUrlEncodedString(ParamArray Dictionaries() As Variant) As String
283-
Debug.Print "Excel-REST: DEPRECATED DictionariesToUrlEncodedString has been deprecated in favor of ConvertToUrlEncoded. It will be removed in Excel-REST v4"
284-
285-
Dim i As Integer
286-
Dim Combined As Dictionary
287-
288-
Set Combined = Dictionaries(LBound(Dictionaries))
289-
For i = LBound(Dictionaries) + 1 To UBound(Dictionaries)
290-
Set Combined = CombineObjects(Combined, Dictionaries(i))
291-
Next i
292-
293-
DictionariesToUrlEncodedString = ConvertToUrlEncoded(Combined)
282+
''
283+
' Parse XML string to XML
284+
'
285+
' @param {String} Encoded
286+
' @return {Object} XML
287+
' --------------------------------------------- '
288+
Public Function ParseXML(Encoded As String) As Object
289+
Set ParseXML = New MSXML2.DOMDocument
290+
ParseXML.async = False
291+
ParseXML.LoadXML Encoded
292+
End Function
293+
294+
''
295+
' Convert MSXML2.DomDocument to string
296+
'
297+
' @param {Object: MSXML2.DomDocument} XML
298+
' @return {String} XML string
299+
' --------------------------------------------- '
300+
301+
Public Function ConvertToXML(Obj As Variant) As String
302+
On Error Resume Next
303+
ConvertToXML = Trim(Replace(Obj.xml, vbCrLf, ""))
294304
End Function
295305

296306
''
@@ -306,6 +316,8 @@ Public Function ParseByFormat(Value As String, Format As AvailableFormats) As Ob
306316
Set ParseByFormat = ParseJSON(Value)
307317
Case AvailableFormats.formurlencoded
308318
Set ParseByFormat = ParseUrlEncoded(Value)
319+
Case AvailableFormats.xml
320+
Set ParseByFormat = ParseXML(Value)
309321
End Select
310322
End Function
311323

@@ -322,6 +334,8 @@ Public Function ConvertToFormat(Obj As Variant, Format As AvailableFormats) As S
322334
ConvertToFormat = ConvertToJSON(Obj)
323335
Case AvailableFormats.formurlencoded
324336
ConvertToFormat = ConvertToUrlEncoded(Obj)
337+
Case AvailableFormats.xml
338+
ConvertToFormat = ConvertToXML(Obj)
325339
End Select
326340
End Function
327341

@@ -603,7 +617,7 @@ End Function
603617
' --------------------------------------------- '
604618
Public Function IsArray(Obj As Variant) As Boolean
605619
If Not IsEmpty(Obj) Then
606-
If VarType(Obj) = vbObject Then
620+
If IsObject(Obj) Then
607621
If TypeOf Obj Is Collection Then
608622
IsArray = True
609623
End If
@@ -614,6 +628,21 @@ Public Function IsArray(Obj As Variant) As Boolean
614628
End If
615629
End Function
616630

631+
''
632+
' Add or update key/value in dictionary
633+
'
634+
' @param {Dictionary} Dict
635+
' @param {String} Key
636+
' @param {Variant} Value
637+
' --------------------------------------------- '
638+
Public Sub AddToDictionary(ByRef Dict As Dictionary, Key As String, Value As Variant)
639+
If Not Dict.Exists(Key) Then
640+
Dict.Add Key, Value
641+
Else
642+
Dict(Key) = Value
643+
End If
644+
End Sub
645+
617646
' ============================================= '
618647
' 5. Request preparation / handling
619648
' ============================================= '
@@ -790,7 +819,9 @@ Public Function CreateResponseFromHttp(ByRef Http As Object, Optional Format As
790819
CreateResponseFromHttp.Content = Http.ResponseText
791820

792821
' Convert content to data by format
793-
Set CreateResponseFromHttp.Data = RestHelpers.ParseByFormat(Http.ResponseText, Format)
822+
If Format <> AvailableFormats.plaintext Then
823+
Set CreateResponseFromHttp.Data = RestHelpers.ParseByFormat(Http.ResponseText, Format)
824+
End If
794825

795826
' Extract headers
796827
Set CreateResponseFromHttp.Headers = ExtractHeadersFromResponseHeaders(Http.getAllResponseHeaders)
@@ -924,7 +955,7 @@ Public Function UpdateResponse(ByRef Original As RestResponse, Updated As RestRe
924955
Set Original.Cookies = Updated.Cookies
925956

926957
If Not IsEmpty(Updated.Data) Then
927-
If VarType(Updated.Data) = vbObject Then
958+
If IsObject(Updated.Data) Then
928959
Set Original.Data = Updated.Data
929960
Else
930961
Original.Data = Updated.Data
@@ -946,6 +977,10 @@ Public Function FormatToName(Format As AvailableFormats) As String
946977
FormatToName = "form-urlencoded"
947978
Case AvailableFormats.json
948979
FormatToName = "json"
980+
Case AvailableFormats.xml
981+
FormatToName = "xml"
982+
Case AvailableFormats.plaintext
983+
FormatToName = "txt"
949984
End Select
950985
End Function
951986

@@ -961,6 +996,10 @@ Public Function FormatToContentType(Format As AvailableFormats) As String
961996
FormatToContentType = "application/x-www-form-urlencoded;charset=UTF-8"
962997
Case AvailableFormats.json
963998
FormatToContentType = "application/json"
999+
Case AvailableFormats.xml
1000+
FormatToContentType = "application/xml"
1001+
Case AvailableFormats.plaintext
1002+
FormatToContentType = "text/plain"
9641003
End Select
9651004
End Function
9661005

@@ -1090,18 +1129,18 @@ Public Function BytesToHex(Bytes() As Byte) As String
10901129
End Function
10911130

10921131
Public Function BytesToBase64(Bytes() As Byte) As String
1093-
Dim XML As Object
1132+
Dim xml As Object
10941133
Dim Node As Object
1095-
Set XML = CreateObject("MSXML2.DOMDocument")
1134+
Set xml = CreateObject("MSXML2.DOMDocument")
10961135

10971136
' byte array to base64
1098-
Set Node = XML.createElement("b64")
1137+
Set Node = xml.createElement("b64")
10991138
Node.DataType = "bin.base64"
11001139
Node.nodeTypedValue = Bytes
11011140
BytesToBase64 = Node.Text
11021141

11031142
Set Node = Nothing
1104-
Set XML = Nothing
1143+
Set xml = Nothing
11051144
End Function
11061145

11071146
''

‎src/RestRequest.cls‎

Lines changed: 13 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -48,8 +48,10 @@ Public Enum AvailableMethods
4848
httpPATCH
4949
End Enum
5050
Public Enum AvailableFormats
51+
plaintext
5152
json
5253
formurlencoded
54+
xml
5355
End Enum
5456

5557
' --------------------------------------------- '
@@ -178,7 +180,11 @@ Public Property Get Body() As String
178180
BodyValue = pBody
179181
End If
180182

181-
Body = RestHelpers.ConvertToFormat(BodyValue, Me.RequestFormat)
183+
If Me.RequestFormat <> AvailableFormats.plaintext Then
184+
Body = RestHelpers.ConvertToFormat(BodyValue, Me.RequestFormat)
185+
Else
186+
Body = BodyValue
187+
End If
182188
End If
183189
End If
184190
End Property
@@ -281,11 +287,7 @@ End Property
281287
' --------------------------------------------- '
282288

283289
Public Sub AddHeader(Key As String, Value As String)
284-
If Not Me.Headers.Exists(Key) Then
285-
Me.Headers.Add Key, Value
286-
Else
287-
Me.Headers(Key) = Value
288-
End If
290+
RestHelpers.AddToDictionary Me.Headers, Key, Value
289291
End Sub
290292

291293
''
@@ -296,11 +298,7 @@ End Sub
296298
' --------------------------------------------- '
297299

298300
Public Sub AddUrlSegment(segment As String, Value As String)
299-
If Not Me.UrlSegments.Exists(segment) Then
300-
Me.UrlSegments.Add segment, Value
301-
Else
302-
Me.UrlSegments(segment) = Value
303-
End If
301+
RestHelpers.AddToDictionary Me.UrlSegments, segment, Value
304302
End Sub
305303

306304
''
@@ -311,11 +309,7 @@ End Sub
311309
' --------------------------------------------- '
312310

313311
Public Sub AddParameter(Key As String, Value As Variant)
314-
If Not Me.Parameters.Exists(Key) Then
315-
Me.Parameters.Add Key, Value
316-
Else
317-
Me.Parameters(Key) = Value
318-
End If
312+
RestHelpers.AddToDictionary Me.Parameters, Key, Value
319313
End Sub
320314

321315
''
@@ -326,11 +320,7 @@ End Sub
326320
' --------------------------------------------- '
327321

328322
Public Sub AddQuerystringParam(Key As String, Value As Variant)
329-
If Not Me.QuerystringParams.Exists(Key) Then
330-
Me.QuerystringParams.Add Key, Value
331-
Else
332-
Me.QuerystringParams(Key) = Value
333-
End If
323+
RestHelpers.AddToDictionary Me.QuerystringParams, Key, Value
334324
End Sub
335325

336326
''
@@ -341,11 +331,7 @@ End Sub
341331
' --------------------------------------------- '
342332

343333
Public Sub AddCookie(Key As String, Value As Variant)
344-
If Not Me.Cookies.Exists(Key) Then
345-
Me.Cookies.Add Key, Value
346-
Else
347-
Me.Cookies(Key) = Value
348-
End If
334+
RestHelpers.AddToDictionary Me.Cookies, Key, Value
349335
End Sub
350336

351337
''
@@ -355,7 +341,7 @@ End Sub
355341
' --------------------------------------------- '
356342

357343
Public Function AddBody(BodyVal As Variant)
358-
If VarType(BodyVal) = vbObject Then
344+
If IsObject(BodyVal) Then
359345
Set pBody = BodyVal
360346
ElseIf RestHelpers.IsArray(BodyVal) Then
361347
pBody = BodyVal

0 commit comments

Comments
 (0)