steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

xml-rpc: fix post-rpc

db4
Philipp Brüschweiler 2009-09-13 21:40:58 +02:00
parent 0d4845de26
commit a8d1cd3135
1 changed files with 17 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
basis/xml-rpc/xml-rpc.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2005, 2009 Daniel Ehrenberg ! Copyright (C) 2005, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel xml arrays math generic http.client USING: accessors arrays assocs base64 calendar calendar.format
combinators hashtables namespaces io base64 sequences strings combinators debugger generic hashtables http http.client
calendar xml.data xml.writer xml.traversal assocs math.parser http.client.private io io.encodings.string io.encodings.utf8
debugger calendar.format math.order xml.syntax ; kernel math math.order math.parser namespaces sequences strings
xml xml.data xml.syntax xml.traversal xml.writer ;
IN: xml-rpc IN: xml-rpc
! * Sending RPC requests ! * Sending RPC requests
@ -174,9 +175,20 @@ TAG: array xml>item
] [ "Bad main tag name" server-error ] if ] [ "Bad main tag name" server-error ] if
] if ; ] if ;
<PRIVATE
: xml-post-data ( xml -- post-data )
xml>string utf8 encode "text/xml" <post-data> swap >>data ;
: rpc-post-request ( xml url -- request )
[ send-rpc xml-post-data ] [ "POST" <client-request> ] bi*
swap >>post-data ;
PRIVATE>
: post-rpc ( rpc url -- rpc ) : post-rpc ( rpc url -- rpc )
! This needs to do something in the event of an error ! This needs to do something in the event of an error
[ send-rpc ] dip http-post nip string>xml receive-rpc ; rpc-post-request http-request nip string>xml receive-rpc ;
: invoke-method ( params method url -- response ) : invoke-method ( params method url -- response )
[ swap <rpc-method> ] dip post-rpc ; [ swap <rpc-method> ] dip post-rpc ;