XMLRPC/0000755000076500000240000000000012122716130011211 5ustar duncanstaffXMLRPC/Changes0000644000076500000240000000244112064215725012516 0ustar duncanstaffVersion 0.3-0 * Serialization of R vectors to XML is much faster now, using parseXMLAndAdd(). Thanks to Paul Shannon for noticing the very long delays in serializing large vectors. Version 0.2-5 * Fixed the rpc.serialize method for raw so that it doesn't convert the values to character strings implicitly via a call go gsub(). Version 0.2-4 * Removed trailing , in switch() call. Version 0.2-3 * Remove any newlines (\n) in base64 encoded content returned in an XMLRPC call. Version 0.2-1 * Enclose within a node. Version 0.2-1 * Handle string values that are returned as string content with no outer .... Doagnosed and suggested by Paul Shannon. Version 0.2-0 * Put text in CDATA nodes. * Handle the conversion of results for lists better so as not to simplify them inappropriately. * Added serialization for raw vectors to base64 encoded content in base64 nodes. * convertToR doesn't try to simplify the results (i.e. it does not use xpathSApply) for each of the value nodes in the response. Version 0.1-2 * Patches from Andrea Bisognin to detect errors Version 0.1-1 * Put primitive values inside a node as they should be. (Strings are a special optional case.)XMLRPC/DESCRIPTION0000644000076500000240000000053712122716132012726 0ustar duncanstaffPackage: XMLRPC Version: 0.3-0 Title: Remote Procedure Call (RPC) via XML in R Description: A simple implementation of XML-RPC for R. Imports: methods, RCurl, XML License: BSD Author: Duncan Temple Lang Maintainer: Duncan Temple Lang References: http://en.wikipedia.org/wiki/Xml-rpc Packaged: 2013-03-21 23:48:42 UTC; duncan XMLRPC/man/0000755000076500000240000000000012122716130011764 5ustar duncanstaffXMLRPC/man/rpc.serialize.Rd0000644000076500000240000000164112064215476015043 0ustar duncanstaff\name{rpc.serialize} \alias{rpc.serialize} \alias{rpc.serialize,ANY-method} \alias{rpc.serialize,AsIs-method} \alias{rpc.serialize,NULL-method} \alias{rpc.serialize,Date-method} \alias{rpc.serialize,POSIXt-method} \alias{rpc.serialize,list-method} \alias{rpc.serialize,raw-method} \alias{rpc.serialize,vector-method} \title{Serialize R objects to XML-RPC format} \description{ This function and its methods convert R objects to XML for use in XML-RPC requests. } \usage{ rpc.serialize(x, ...) } \arguments{ \item{x}{the R object to be serialized in XML-RPC format} \item{\dots}{additional parameters understood by methods} } \value{ An \code{XMLInternalNode} object representing the XML content. } \references{ The XML-RPC specification at \url{http://xmlrpc.scripting.com/spec}. } \author{Duncan Temple Lang} \seealso{\code{\link{xml.rpc}}} %\examples{} \keyword{IO} \keyword{programming} \concept{RPC} \concept{XML} XMLRPC/man/xml.rpc.Rd0000644000076500000240000000656512064215317013660 0ustar duncanstaff\name{xml.rpc} \alias{xml.rpc} \title{Invoke XML-RPC method from R} \description{ This function can be used to invoke a method provided by an XML-RPC (remote procedure call) server. It can pass R objects in the request by serializing them to XML format and also converts the result back to R. } \usage{ xml.rpc(url, method, ..., .args = list(...), .opts = list(), .defaultOpts = list(httpheader = c("Content-Type" = "text/xml"), followlocation = TRUE, useragent = useragent), .convert = TRUE, .curl = getCurlHandle(), useragent = "R-XMLRPC") } %- maybe also 'usage' for other objects documented here. \arguments{ \item{url}{the URL of the XML-RPC server} \item{method}{a string giving the name of the XML-RPC method to invoke} \item{\dots}{a collection of argument valuesn} \item{.args}{an alternative way to specify the collection (list) of arguments} \item{.opts}{a list of options passed on to \code{\link[RCurl]{postForm}}. This is for the caller to specify server-specific curl options as opposed to general XML-RPC options which are set via \code{.defaultOpts}. } \item{.defaultOpts}{standard/default RCurl options used when making this call} \item{.convert}{either a logical value indicating whether to perform the defalt conversion (via \code{convertToR}) or not, or alternatively a function which is called with a string giving the body of the HTTP response of the XML-RPC call.} \item{.curl}{a CURLHandle object that the caller can specify to allow reusing existing handles and connections. This can greatly improve efficiency.} \item{useragent}{the string identifying the application that is reported to the Web server as making the request.} } \value{ If \code{.convert} is a logical value and \code{TRUE}, an R object giving the result of the XML-RPC method invocation. If \code{.convert} is \code{FALSE}, a string giving the body of the response. If \code{.convert} is a function, it is called with the body of the XML-RPC response as a string. } \references{\url{http://www.xmlrpc.com/spec} \url{http://www.cafeconleche.org/books/xmljava/chapters/ch02s05.html} for a DTD for XML-RPC and examples and discussion. } \author{Duncan Temple Lang } \seealso{ \code{\link[RCurl]{postForm}} \code{\link[RCurl]{getURL}} and REST Web services \code{SSOAP} package. } \examples{ # See http://www.advogato.org/xmlrpc.html xml.rpc('http://www.advogato.org/XMLRPC', 'test.square', 9L) xml.rpc('http://www.advogato.org/XMLRPC', 'test.sumprod', 9L, 10L) xml.rpc('http://www.advogato.org/XMLRPC', 'test.strlen', 'abcdef') xml.rpc('http://www.advogato.org/XMLRPC', 'test.capitalize', 'abcdef') xml.rpc('http://www.advogato.org/XMLRPC', 'user.exists', 'duncan') xml.rpc('http://www.advogato.org/XMLRPC', 'cert.get', 'duncan') xml.rpc('http://www.advogato.org/XMLRPC', 'diary.len', 'duncan') xml.rpc('http://www.advogato.org/XMLRPC', 'diary.get', 'duncan', 1L) xml.rpc('http://www.advogato.org/XMLRPC', 'diary.getDates', 'duncan', 4L) xml.rpc("http://xmlrpc-c.sourceforge.net/api/sample.php", "sample.sumAndDifference", 3L, 4L) # Doesn't work # xml.rpc('http://ws2.webservices.nl', 'system.methodHelp', 'addressReeksPostcodeSearch') # xml.rpc('http://www.cookcomputing.com/xmlrpcsamples/RPC2.ashx', 'example.getStateName', 2L) } \keyword{IO} \keyword{programming} XMLRPC/man/XMLRPCServer.Rd0000644000076500000240000000501111736646507014470 0ustar duncanstaff\name{XMLRPCServer} \alias{XMLRPCServer} \alias{XMLRPCServer-class} \alias{XMLRPCServerConnection-class} \alias{$,XMLRPCServer-method} \alias{$,XMLRPCServerConnection-method} \title{Create an instance of an XMLRPCServer object} \description{ The \code{XMLRPCServer} class is a means to identify a string as the URL of an XML-RPC server. We can then use this to invoke a method provided by the server either via a call to \code{\link{xml.rpc}} or via an expression of the form \code{server$methodName(arg1, arg2, ...)}. The \code{XMLRPCServerConnection} class allows us to associate a \code{CURLHandle} object with an XML-RPC server. This connection is then used in each of the calls to that server. This allows us to reuse a single curl connection to the server and also slightly simplifies passing it to each call. } \usage{ XMLRPCServer(url, curl = NULL, class = if (!is.null(curl)) "XMLRPCServerConnection" else "XMLRPCServer", ..., .opts = list(...)) } \arguments{ \item{url}{the URL for the XML-RPC server.} \item{curl}{either a logical value indicating whether to create a new \code{CURLHandle} object, or an instance of a \code{CURLHandle} or alternatively \code{NULL}. If CURL options are specified via the \code{\dots} or \code{.opts} parameters, then a CURL handle is automatically created using these. } \item{class}{the name of the class to create.} \item{\dots}{name=value pairs of CURL options that are used to create a new \code{CURLHandle} object.} \item{.opts}{an alternative way to specify the CURL options for the handle to be created.} } \value{ An object of class given by the value of \code{class}. } \author{ Duncan Temple Lang } \seealso{ \code{\link{xml.rpc}} } \examples{ server = XMLRPCServer('http://www.advogato.org/XMLRPC') server = XMLRPCServer('http://www.advogato.org/XMLRPC', TRUE) server = XMLRPCServer('http://www.advogato.org/XMLRPC', verbose = TRUE, followlocation = TRUE, cookie = "MyCookie=abcd", ssl.verifypeer = FALSE) library(RCurl) server = XMLRPCServer('http://www.advogato.org/XMLRPC', getCurlHandle(verbose = TRUE, followlocation = TRUE, cookie = "MyCookie=abcd", ssl.verifypeer = FALSE)) if(url.exists(as(server, "character"))) server$test.capitalize('abCdef') } \keyword{IO} \concept{XMLRPC} \concept{OOP} XMLRPC/NAMESPACE0000644000076500000240000000075311763316556012457 0ustar duncanstaff# The following inhibits R CMD check from complaining about not # being able to load the namespace based on the specified dependencies. #import(methods) importFrom(methods, show) import(RCurl) import(XML) export(xml.rpc) exportClass("XMLRPCServer") export("XMLRPCServer") exportMethods("$") export(rpc.serialize) # rpc.serialize - convert to XML-RPC from R # covertToR, xmlRPCToR - convert response from XML-RPC method call # createBody - for creating the body of the XML-RPC request XMLRPC/R/0000755000076500000240000000000012064445313011421 5ustar duncanstaffXMLRPC/R/classes.R0000644000076500000240000000165611736646507013226 0ustar duncanstaffsetClass("XMLRPCServer", contains = "character") setClass("XMLRPCServerConnection", representation (curl = "CURLHandle"), contains = "XMLRPCServer") XMLRPCServer = function(url, curl = NULL, class = if(!is.null(curl)) "XMLRPCServerConnection" else "XMLRPCServer", ..., .opts = list(...)) { if(is.null(curl) && length(.opts) || (is.logical(curl) && curl)) curl = getCurlHandle(.opts = .opts) ans = new(class, url) if(!is.null(curl)) ans@curl = curl ans } setMethod("$", "XMLRPCServer", function(x, name) { function(...) xml.rpc(as(x, "character"), name, ...) }) setMethod("$", "XMLRPCServerConnection", function(x, name) { function(...) xml.rpc(as(x, "character"), name, ..., .curl = x@curl) }) XMLRPC/R/serialize.R0000644000076500000240000002066312064445313013542 0ustar duncanstaff xml.rpc = function(url, method, ..., .args = list(...), .opts = list(), .defaultOpts = list(httpheader = c('Content-Type' = "text/xml"), followlocation = TRUE, useragent = useragent), .convert = TRUE, .curl = getCurlHandle(), useragent = "R-XMLRPC") { # Turn the method and arguments to an RPC body. body = createBody(method, .args) # merge the .defaultOpts and the .opts into one list. .defaultOpts[["postfields"]] = saveXML(body) if(length(.opts)) .defaultOpts[names(.opts)] = .opts rdr = dynCurlReader(.curl, baseURL = url) .defaultOpts[["headerfunction"]] = rdr$update ans = postForm(url, .opts = .defaultOpts, style = "POST", curl = .curl) hdr = parseHTTPHeader(rdr$header()) if(as.integer(hdr[["status"]]) %/% 100 != 2) { # call an RCurl error generator function. stop("Problems") } ans = rdr$value() # Now either convert using the default converter fnction (convertToR) # or return as is or allow the caller to specify a function to use for conversion. if(is.logical(.convert)) { if(.convert) convertToR(ans) else ans } else if(is.function(.convert)) .convert(ans) else ans } createBody = function(method, args) { top = newXMLNode("methodCall", newXMLNode("methodName", method)) params = newXMLNode("params", parent = top) sapply(args, function(x) newXMLNode("param", rpc.serialize(x), parent = params)) top } setGeneric("rpc.serialize", function(x, ...) standardGeneric("rpc.serialize")) setMethod("rpc.serialize", "ANY", function(x, ...) { if(isS4(x)) return(rpc.serialize.S4Object(x, ...)) stop("Not sure how to convert this type of object to XMLRPC format") }) rpc.serialize.S4Object = function(x, ...) { els = slotNames(x) rpc.serialize(structure(lapply(els, function(id) slot(x, id)), names = els), ...) } basicTypeMap = c("integer" = "i4", "double" = "double", "character" = "string", "logical" = "boolean", "POSIXt" = "dateTime.iso8601", "POSIXct" = "dateTime.iso8601", "Date" = "dateTime.iso8601", "raw" = "base64") cast <- function(x) { if (is.logical(x)) as.integer(x) else x } setOldClass("AsIs") setMethod("rpc.serialize", "AsIs", function(x) { type = basicTypeMap[typeof(x)] vectorArray(x, type) }) setMethod("rpc.serialize", "NULL", function(x, ...) { rpc.serialize(list()) }) setMethod("rpc.serialize", "raw", function(x, ...) { # x = gsub("\\n", "", x) val = base64Encode(x) newXMLNode("value", newXMLNode("base64", val)) }) setMethod("rpc.serialize", "Date", function(x, ...) { val = format(x, "%Y%m%dT%H:%H:%S") if(length(x) == 1) newXMLNode("value", newXMLNode("dateTime.iso8601", val)) else vectorArray(val, basicTypeMap["Date"]) }) setMethod("rpc.serialize", "POSIXt", function(x, ...) { val = format(as.POSIXct(x), "%Y%m%dT%H:%H:%S") if(length(x) == 1) newXMLNode("value", newXMLNode("dateTime.iso8601", val)) else vectorArray(val, basicTypeMap["POSIXt"]) }) setMethod("rpc.serialize", "vector", function(x, ...) { type = basicTypeMap[typeof(x)] x = cast(x) if(length(names(x))) { warning("Skipping names on vector!") names(x) = NULL } # else { if(length(x) == 1) newXMLNode("value", newXMLNode(type, if(type == "string") newXMLCDataNode(x) else x)) else { vectorArray(x, type) } } }) FormatStrings = c(numeric = "%f", int = "%d", integer = "%d", logical = "%s", i4 = "%d", double = "%f", string = "%s", Date = "%s", POSIXt = "%s", POSIXct = "%s") vectorArray = function(x, type) { top = newXMLNode("value") a = newXMLNode("array", parent = top) data = newXMLNode("data", parent = a) # sapply(x, function(x) newXMLNode("value", newXMLNode(type, if(type == "string") newXMLCDataNode(x) else x), parent = data)) tmpl = if(type == "string") # is.character(x)) sprintf("<%s>", type, type) else if(type == "dateTime.iso8601") { if(is(x, "Date")) x = format(x, "%Y%m%dT00:00:00") else x = format(as.POSIXct(x), "%Y%m%dT%H:%H:%S") sprintf("<%s>%%s", type, type) } else { if(type == "double") { x = as.character(x) pct = "%s" } else pct = FormatStrings[type] if(is.na(pct)) pct = "%s" sprintf("<%s>%s", type, pct, type) } txt = sprintf(tmpl, x) parseXMLAndAdd(txt, data) # sapply(x, function(x) newXMLNode(type, if(type == "string") newXMLCDataNode(x) else x, parent = data)) top } setMethod("rpc.serialize", "list", function(x, ...) { if(length(names(x))) { a = newXMLNode("struct") sapply(names(x), function(id) { type = basicTypeMap[typeof(x[[id]])] newXMLNode("member", newXMLNode("name", id), rpc.serialize(x[[id]] # newXMLNode("value", rpc.serialize(x[[id]]) ), parent = a) }) a } else { a = newXMLNode("array") data = newXMLNode("data", parent = a) sapply(x, function(x) { elName = basicTypeMap[typeof(x)] newXMLNode("value", newXMLNode(elName, if(elName == "string") newXMLCDataNode(x) else x, parent = data)) }) a } }) setGeneric('convertToR', function(node) standardGeneric('convertToR')) setMethod('convertToR', 'XMLInternalDocument', function(node) { fault = getNodeSet(node,path="//methodResponse/fault/value/struct") if (length(fault) > 0) { fault = xmlRPCToR(fault[[1]]) e = simpleError(paste("faultCode: ", fault$faultCode, " faultString: ", fault$faultString)) class(e) = c("XMLRPCError", class(e)) stop(e) } a = xpathApply(node, "//param/value", xmlRPCToR) if(length(a) == 1) a[[1]] else a }) setMethod('convertToR', 'XMLInternalNode', function(node) { if(length(getNodeSet(node, "./param/value"))) { ans = xpathApply(node, "./param/value", xmlRPCToR, simplify = FALSE) } else xmlToList(node) }) setMethod('convertToR', 'character', function(node) { convertToR(xmlParse(node, asText = TRUE)) }) xmlRPCToR = function(node, ...) { if(is.null(node)) return(NULL) if(xmlName(node) == "value") node = node[[1]] if(is(node, "XMLInternalTextNode")) return(xmlValue(node)) type = xmlName(node) switch(type, 'array' = xmlRPCToR.array(node, ...), 'struct' = xmlRPCToR.struct(node, ...), 'i4' = as.integer(xmlValue(node)), 'int' = as.integer(xmlValue(node)), 'boolean' = if(xmlValue(node) == "1") TRUE else FALSE, 'double' = as.numeric(xmlValue(node)), 'string' = xmlValue(node), 'dateTime.iso8601' = as.POSIXct(strptime(xmlValue(node), "%Y%m%dT%H:%M:%S")), 'base64' = base64(xmlValue(node), encode = FALSE), xmlValue(node) ) } xmlRPCToR.struct = function(node, ...) { ans = xmlApply(node, function(x) xmlRPCToR(x[["value"]][[1]], ...)) names(ans) = xmlSApply(node, function(x) xmlValue(x[["name"]])) ans } xmlRPCToR.array = function(node, ...) { ans = xmlApply(node[["data"]], function(x) xmlRPCToR(x[[1]])) if(!is.list(ans[[1]]) && all(sapply(ans, typeof) == typeof(ans[[1]]))) structure(unlist(ans), names = NULL) else ans } XMLRPC/tests/0000755000076500000240000000000011736646507012377 5ustar duncanstaffXMLRPC/tests/pingomatic.R0000644000076500000240000000022611736646507014654 0ustar duncanstafflibrary(XMLRPC) # Doesn't work # xml.rpc('http://rpc.pingomatic.com/', 'weblogUpdates.ping', c('My Photoblog', 'http://www.my-site.com/photoblog/')) XMLRPC/tests/types.R0000644000076500000240000000050511736646507013666 0ustar duncanstafflibrary(XMLRPC) library(XML) doc = xmlParse('xmlrpcTypes.xml') top = xmlRoot(doc) XMLRPC:::xmlRPCToR(top[["array"]]) XMLRPC:::xmlRPCToR(top[["struct"]]) XMLRPC:::xmlRPCToR(top[["base64"]]) xmlApply(top, XMLRPC:::xmlRPCToR) ############## # Round trip the data. x = XMLRPC:::rpc.serialize(1:10) XMLRPC:::xmlRPCToR(x) XMLRPC/tests/xmlrpcTypes.xml0000644000076500000240000000115511736646507015455 0ustar duncanstaff 10 11 A string 3.1415 1 0 19980717T14:08:55 eW91IGNhbid0IHJlYWQgdGhpcyE= 12 Egypt 0 -31 lowerBound 18 upperBound 139