[rkward-cvs] SF.net SVN: rkward-code:[4542] trunk/rkward/packages/XiMpLe
m-eik at users.sf.net
m-eik at users.sf.net
Wed Feb 20 14:19:25 UTC 2013
Revision: 4542
http://sourceforge.net/p/rkward/code/4542
Author: m-eik
Date: 2013-02-20 14:19:23 +0000 (Wed, 20 Feb 2013)
Log Message:
-----------
XiMpLe: XMLScan() and XMLScan()<- should work now, unit tests added
Modified Paths:
--------------
trunk/rkward/packages/XiMpLe/ChangeLog
trunk/rkward/packages/XiMpLe/DESCRIPTION
trunk/rkward/packages/XiMpLe/NAMESPACE
trunk/rkward/packages/XiMpLe/R/XiMpLe-package.R
trunk/rkward/packages/XiMpLe/R/zzz_is_get_utils.R
trunk/rkward/packages/XiMpLe/inst/tests/tests.R
trunk/rkward/packages/XiMpLe/man/XMLGetters-methods.Rd
trunk/rkward/packages/XiMpLe/man/XiMpLe-package.Rd
Modified: trunk/rkward/packages/XiMpLe/ChangeLog
===================================================================
--- trunk/rkward/packages/XiMpLe/ChangeLog 2013-02-19 22:26:41 UTC (rev 4541)
+++ trunk/rkward/packages/XiMpLe/ChangeLog 2013-02-20 14:19:23 UTC (rev 4542)
@@ -1,6 +1,6 @@
ChangeLog for package XiMpLe
-changes in version 0.03-19 (2013-02-19)
+changes in version 0.03-19 (2013-02-20)
added:
- new methods XMLScan() and XMLScan()<- to search an XML tree recursively
for appearances of certain node names
Modified: trunk/rkward/packages/XiMpLe/DESCRIPTION
===================================================================
--- trunk/rkward/packages/XiMpLe/DESCRIPTION 2013-02-19 22:26:41 UTC (rev 4541)
+++ trunk/rkward/packages/XiMpLe/DESCRIPTION 2013-02-20 14:19:23 UTC (rev 4542)
@@ -20,7 +20,7 @@
Authors at R: c(person(given="Meik", family="Michalke",
email="meik.michalke at hhu.de", role=c("aut", "cre")))
Version: 0.03-19
-Date: 2013-02-19
+Date: 2013-02-20
Collate:
'XiMpLe-internal.R'
'XiMpLe.node-class.R'
Modified: trunk/rkward/packages/XiMpLe/NAMESPACE
===================================================================
--- trunk/rkward/packages/XiMpLe/NAMESPACE 2013-02-19 22:26:41 UTC (rev 4541)
+++ trunk/rkward/packages/XiMpLe/NAMESPACE 2013-02-20 14:19:23 UTC (rev 4542)
@@ -1,31 +1,31 @@
-export(XMLNode)
-export(XMLTree)
+exportClasses(XiMpLe.doc)
+exportClasses(XiMpLe.node)
export(is.XiMpLe.doc)
export(is.XiMpLe.node)
-export(parseXMLTree)
-export(pasteXMLNode)
-export(pasteXMLTag)
-export(pasteXMLTree)
-exportClasses(XiMpLe.doc)
-exportClasses(XiMpLe.node)
+exportMethods(node)
+exportMethods("node<-")
+exportMethods(pasteXML)
+exportMethods(show)
+exportMethods(XMLAttrs)
exportMethods("XMLAttrs<-")
+exportMethods(XMLChildren)
exportMethods("XMLChildren<-")
-exportMethods("XMLDTD<-")
+exportMethods(XMLDecl)
exportMethods("XMLDecl<-")
-exportMethods("XMLFile<-")
-exportMethods("XMLName<-")
-exportMethods("XMLScan<-")
-exportMethods("XMLValue<-")
-exportMethods("node<-")
-exportMethods(XMLAttrs)
-exportMethods(XMLChildren)
exportMethods(XMLDTD)
-exportMethods(XMLDecl)
+exportMethods("XMLDTD<-")
exportMethods(XMLFile)
+exportMethods("XMLFile<-")
exportMethods(XMLName)
+exportMethods("XMLName<-")
exportMethods(XMLScan)
+exportMethods("XMLScan<-")
exportMethods(XMLValue)
-exportMethods(node)
-exportMethods(pasteXML)
-exportMethods(show)
+exportMethods("XMLValue<-")
+export(parseXMLTree)
+export(pasteXMLNode)
+export(pasteXMLTag)
+export(pasteXMLTree)
+export(XMLNode)
+export(XMLTree)
import(methods)
Modified: trunk/rkward/packages/XiMpLe/R/XiMpLe-package.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/XiMpLe-package.R 2013-02-19 22:26:41 UTC (rev 4541)
+++ trunk/rkward/packages/XiMpLe/R/XiMpLe-package.R 2013-02-20 14:19:23 UTC (rev 4542)
@@ -4,7 +4,7 @@
#' Package: \tab XiMpLe\cr
#' Type: \tab Package\cr
#' Version: \tab 0.03-19\cr
-#' Date: \tab 2013-02-19\cr
+#' Date: \tab 2013-02-20\cr
#' Depends: \tab R (>= 2.9.0),methods\cr
#' Enhances: \tab rkward\cr
#' Encoding: \tab UTF-8\cr
Modified: trunk/rkward/packages/XiMpLe/R/zzz_is_get_utils.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/zzz_is_get_utils.R 2013-02-19 22:26:41 UTC (rev 4541)
+++ trunk/rkward/packages/XiMpLe/R/zzz_is_get_utils.R 2013-02-20 14:19:23 UTC (rev 4542)
@@ -22,14 +22,43 @@
#'
#' These are convenience methods to get or set slots from XML objects without using the \code{@@} operator.
#'
+#' \itemize{
+#' \item{\code{XMLName()}: }{get/set the XML node name (slot \code{name} of class \code{XiMpLe.node})}
+#' \item{\code{XMLAttrs()}: }{get/set the XML node attributes (slot \code{attrs} of class \code{XiMpLe.node})}
+#' \item{\code{XMLValue()}: }{get/set the XML node value (slot \code{value} of class \code{XiMpLe.node})}
+#' \item{\code{XMLChildren()}: }{get/set the XML child nodes (slot \code{children} of both classes \code{XiMpLe.node}
+#' and \code{XiMpLe.doc})}
+#' \item{\code{XMLFile()}: }{get/set the XML document file name (slot \code{file} of class \code{XiMpLe.doc})}
+#' \item{\code{XMLDecl()}: }{get/set the XML document declaration (slot \code{xml} of class \code{XiMpLe.doc})}
+#' \item{\code{XMLDTD()}: }{get/set the XML document doctype definition (slot \code{dtd} of class \code{XiMpLe.doc})}
+#' }
+#'
+#' Another special method can scan a node/document tree object for appearances of nodes with a particular name:
+#'
+#' \itemize{
+#' \item{\code{XMLScan()}: }{get/set the XML nodes by name (recursively searches slot \code{name} of both classes
+#' \code{XiMpLe.node} and \code{XiMpLe.doc})}
+#' }
+#'
#' @param obj An object of class \code{XiMpLe.node} or \code{XiMpLe.doc}
#' @seealso
-#' \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
+#' \code{\link[XiMpLe:node]{node}},
+#' \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}},
#' \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}
#' @keywords methods
#' @docType methods
#' @rdname XMLGetters-methods
#' @exportMethod XMLName
+#' @examples
+#' xmlTestNode <- XMLNode("foo", XMLNode("testchild"))
+#' XMLName(xmlTestNode) # returns "foo"
+#' XMLName(xmlTestNode) <- "bar"
+#' XMLName(xmlTestNode) # now returns "bar"
+#'
+#' # search for a child node
+#' XMLScan(xmlTestNode, "testchild")
+#' # remove nodes of that name
+#' XMLScan(xmlTestNode, "testchild") <- NULL
setGeneric("XMLName", function(obj) standardGeneric("XMLName"))
#' @rdname XMLGetters-methods
#' @aliases
@@ -291,12 +320,13 @@
setGeneric("XMLScan", function(obj, name) standardGeneric("XMLScan"))
# internal helper function
-find.nodes <- function(nodes, nName, res){
+find.nodes <- function(nodes, nName){
+ res <- list()
for (thisNode in nodes){
if(identical(XMLName(thisNode), nName)){
res <- append(res, thisNode)
} else if(length(XMLChildren(thisNode)) > 0){
- res <- append(res, find.nodes(XMLChildren(thisNode), nName=nName, res=res))
+ res <- append(res, find.nodes(XMLChildren(thisNode), nName=nName))
} else {}
}
return(res)
@@ -313,9 +343,14 @@
function(obj, name){
node.list <- find.nodes(
nodes=child.list(obj),
- nName=name,
- res=list())
- return(node.list)
+ nName=name)
+ if(identical(node.list, list())){
+ return(NULL)
+ } else if(length(node.list) == 1){
+ return(node.list[[1]])
+ } else {
+ return(node.list)
+ }
}
)
@@ -329,9 +364,14 @@
function(obj, name){
node.list <- find.nodes(
nodes=XMLChildren(obj),
- nName=name,
- res=list())
- return(node.list)
+ nName=name)
+ if(identical(node.list, list())){
+ return(NULL)
+ } else if(length(node.list) == 1){
+ return(node.list[[1]])
+ } else {
+ return(node.list)
+ }
}
)
@@ -345,11 +385,17 @@
if(identical(XMLName(thisNode), nName)){
return(replacement)
} else if(length(XMLChildren(thisNode)) > 0){
- return(replace.nodes(child.list(XMLChildren(thisNode)), nName=nName, replacement=replacement))
+ XMLChildren(thisNode) <- replace.nodes(
+ XMLChildren(thisNode),
+ nName=nName,
+ replacement=replacement)
+ return(thisNode)
} else {
return(thisNode)
}
})
+ # get rid of NULL in list
+ nodes <- Filter(Negate(is.null), nodes)
return(nodes)
}
@@ -362,10 +408,13 @@
setMethod("XMLScan<-",
signature=signature(obj="XiMpLe.node"),
function(obj, name, value){
+ # prevent the creation of invalid results
+ stopifnot(is.XiMpLe.node(value) || is.null(value))
obj <- replace.nodes(
nodes=child.list(obj),
nName=name,
- replacement=value)
+ replacement=value)[[1]]
+ stopifnot(validObject(object=obj, test=TRUE, complete=TRUE))
return(obj)
}
)
@@ -378,10 +427,13 @@
setMethod("XMLScan<-",
signature=signature(obj="XiMpLe.doc"),
function(obj, name, value){
- obj <- replace.nodes(
- nodes=XMLChildren(obj),
- nName=name,
- replacement=value)
+ # prevent the creation of invalid results
+ stopifnot(is.XiMpLe.node(value) || is.null(value))
+ XMLChildren(obj) <- replace.nodes(
+ nodes=XMLChildren(obj),
+ nName=name,
+ replacement=value)[[1]]
+ stopifnot(validObject(object=obj, test=TRUE, complete=TRUE))
return(obj)
}
)
Modified: trunk/rkward/packages/XiMpLe/inst/tests/tests.R
===================================================================
--- trunk/rkward/packages/XiMpLe/inst/tests/tests.R 2013-02-19 22:26:41 UTC (rev 4541)
+++ trunk/rkward/packages/XiMpLe/inst/tests/tests.R 2013-02-20 14:19:23 UTC (rev 4542)
@@ -221,3 +221,31 @@
equals("somefile.xml"))
})
+
+context("getter/setter methods: XMLScan")
+
+test_that("scan XML tree for node names", {
+ load("sample_XML_tree.RData")
+
+ # this should return a list of 3
+ sampleXMLTree.nodes <- XMLScan(sampleXMLTree, "empty")
+
+ expect_is(
+ sampleXMLTree.nodes,
+ "list")
+ expect_that(
+ length(sampleXMLTree.nodes),
+ equals(3))
+})
+
+test_that("remove XML nodes from tree by name", {
+ load("sample_XML_tree.RData")
+
+ # this should remove all nodes,
+ # exept the parent "tree" node
+ XMLScan(sampleXMLTree, "empty") <- NULL
+
+ expect_identical(
+ sampleXMLTree,
+ XMLTree(XMLNode("tree")))
+})
Modified: trunk/rkward/packages/XiMpLe/man/XMLGetters-methods.Rd
===================================================================
--- trunk/rkward/packages/XiMpLe/man/XMLGetters-methods.Rd 2013-02-19 22:26:41 UTC (rev 4541)
+++ trunk/rkward/packages/XiMpLe/man/XMLGetters-methods.Rd 2013-02-20 14:19:23 UTC (rev 4542)
@@ -65,9 +65,45 @@
\details{
These are convenience methods to get or set slots from
XML objects without using the \code{@} operator.
+
+ \itemize{ \item{\code{XMLName()}: }{get/set the XML node
+ name (slot \code{name} of class \code{XiMpLe.node})}
+ \item{\code{XMLAttrs()}: }{get/set the XML node
+ attributes (slot \code{attrs} of class
+ \code{XiMpLe.node})} \item{\code{XMLValue()}: }{get/set
+ the XML node value (slot \code{value} of class
+ \code{XiMpLe.node})} \item{\code{XMLChildren()}:
+ }{get/set the XML child nodes (slot \code{children} of
+ both classes \code{XiMpLe.node} and \code{XiMpLe.doc})}
+ \item{\code{XMLFile()}: }{get/set the XML document file
+ name (slot \code{file} of class \code{XiMpLe.doc})}
+ \item{\code{XMLDecl()}: }{get/set the XML document
+ declaration (slot \code{xml} of class \code{XiMpLe.doc})}
+ \item{\code{XMLDTD()}: }{get/set the XML document doctype
+ definition (slot \code{dtd} of class \code{XiMpLe.doc})}
+ }
+
+ Another special method can scan a node/document tree
+ object for appearances of nodes with a particular name:
+
+ \itemize{ \item{\code{XMLScan()}: }{get/set the XML nodes
+ by name (recursively searches slot \code{name} of both
+ classes \code{XiMpLe.node} and \code{XiMpLe.doc})} }
}
+\examples{
+xmlTestNode <- XMLNode("foo", XMLNode("testchild"))
+XMLName(xmlTestNode) # returns "foo"
+XMLName(xmlTestNode) <- "bar"
+XMLName(xmlTestNode) # now returns "bar"
+
+# search for a child node
+XMLScan(xmlTestNode, "testchild")
+# remove nodes of that name
+XMLScan(xmlTestNode, "testchild") <- NULL
+}
\seealso{
- \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
+ \code{\link[XiMpLe:node]{node}},
+ \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}},
\code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}
}
\keyword{methods}
Modified: trunk/rkward/packages/XiMpLe/man/XiMpLe-package.Rd
===================================================================
--- trunk/rkward/packages/XiMpLe/man/XiMpLe-package.Rd 2013-02-19 22:26:41 UTC (rev 4541)
+++ trunk/rkward/packages/XiMpLe/man/XiMpLe-package.Rd 2013-02-20 14:19:23 UTC (rev 4542)
@@ -9,7 +9,7 @@
\details{
\tabular{ll}{ Package: \tab XiMpLe\cr Type: \tab
Package\cr Version: \tab 0.03-19\cr Date: \tab
- 2013-02-19\cr Depends: \tab R (>= 2.9.0),methods\cr
+ 2013-02-20\cr Depends: \tab R (>= 2.9.0),methods\cr
Enhances: \tab rkward\cr Encoding: \tab UTF-8\cr License:
\tab GPL (>= 3)\cr LazyLoad: \tab yes\cr URL: \tab
http://reaktanz.de/?c=hacking&s=XiMpLe\cr }
More information about the rkward-tracker
mailing list