[rkward] packages/XiMpLe: merging changes (XiMpLe package) into master
m.eik michalke
meik.michalke at uni-duesseldorf.de
Wed Dec 9 13:22:21 UTC 2015
Git commit ff1eb3cd8a90ef8da01a352d53ebd1b4246d65d9 by m.eik michalke.
Committed on 09/12/2015 at 13:23.
Pushed by meikm into branch 'master'.
merging changes (XiMpLe package) into master
- was updated in releases/0.6.4
M +7 -0 packages/XiMpLe/ChangeLog
M +4 -1 packages/XiMpLe/DESCRIPTION
M +5 -0 packages/XiMpLe/NAMESPACE
M +44 -44 packages/XiMpLe/R/00_class_01_XiMpLe.node.R
M +32 -32 packages/XiMpLe/R/00_class_02_XiMpLe.doc.R
A +74 -0 packages/XiMpLe/R/00_class_03_XiMpLe.validity.R
A +269 -0 packages/XiMpLe/R/01_method_04_validXML.R
A +82 -0 packages/XiMpLe/R/XMLValidity.R
M +91 -0 packages/XiMpLe/R/XiMpLe-internal.R
M +2 -2 packages/XiMpLe/R/XiMpLe-package.R
M +8 -2 packages/XiMpLe/R/zzz_is_get_utils.R
M +5 -11 packages/XiMpLe/man/XMLGetters-methods.Rd
M +4 -12 packages/XiMpLe/man/XMLNode.Rd
M +4 -13 packages/XiMpLe/man/XMLTree.Rd
A +53 -0 packages/XiMpLe/man/XMLValidity.Rd
M +3 -5 packages/XiMpLe/man/XiMpLe-package.Rd
M +27 -7 packages/XiMpLe/man/XiMpLe.doc-class.Rd
M +37 -18 packages/XiMpLe/man/XiMpLe.node-class.Rd
A +41 -0 packages/XiMpLe/man/XiMpLe.validity-class.Rd
M +5 -11 packages/XiMpLe/man/node.Rd
M +3 -6 packages/XiMpLe/man/parseXMLTree.Rd
M +3 -6 packages/XiMpLe/man/pasteXML-methods.Rd
M +7 -14 packages/XiMpLe/man/pasteXMLTag.Rd
A +119 -0 packages/XiMpLe/man/validXML.Rd
A +- -- packages/XiMpLe/tests/testthat/sample_XML_validity.RData
M +368 -174 packages/XiMpLe/tests/testthat/tests.R
http://commits.kde.org/rkward/ff1eb3cd8a90ef8da01a352d53ebd1b4246d65d9
diff --git a/packages/XiMpLe/ChangeLog b/packages/XiMpLe/ChangeLog
index 336c603..7aacc6b 100644
--- a/packages/XiMpLe/ChangeLog
+++ b/packages/XiMpLe/ChangeLog
@@ -3,6 +3,13 @@ ChangeLog for package XiMpLe
changes in version 0.03-24 (2015-11-24)
unreleased:
- this release is under development
+added:
+ - new method validXML() for some basic validity checks (WIP)
+ - new class XiMpLe.validity to define valid child nodes and attributes
+ - new function is.XiMpLe.validity()
+changed:
+ - moved docimentation of is.XiMpLe.node() and is.XiMpLe.doc() to the
+ respective classes
changes in version 0.03-23 (2015-11-24)
changed:
diff --git a/packages/XiMpLe/DESCRIPTION b/packages/XiMpLe/DESCRIPTION
index 0221419..17fab58 100644
--- a/packages/XiMpLe/DESCRIPTION
+++ b/packages/XiMpLe/DESCRIPTION
@@ -19,17 +19,20 @@ LazyLoad: yes
URL: http://reaktanz.de/?c=hacking&s=XiMpLe
Authors at R: c(person(given="Meik", family="Michalke", email="meik.michalke at hhu.de", role=c("aut", "cre")))
Version: 0.03-24
-Date: 2015-11-24
+Date: 2015-12-08
RoxygenNote: 5.0.1
Collate:
'00_class_01_XiMpLe.node.R'
'00_class_02_XiMpLe.doc.R'
+ '00_class_03_XiMpLe.validity.R'
'01_method_01_pasteXML.R'
'XiMpLe-internal.R'
'01_method_02_node.R'
'01_method_03_show.R'
+ '01_method_04_validXML.R'
'XMLNode.R'
'XMLTree.R'
+ 'XMLValidity.R'
'XiMpLe-package.R'
'parseXMLTree.R'
'pasteXMLTag.R'
diff --git a/packages/XiMpLe/NAMESPACE b/packages/XiMpLe/NAMESPACE
index 7fc7573..e1a44a1 100644
--- a/packages/XiMpLe/NAMESPACE
+++ b/packages/XiMpLe/NAMESPACE
@@ -19,17 +19,22 @@ export(XMLNode)
export(XMLScan)
export(XMLScanDeep)
export(XMLTree)
+export(XMLValidity)
export(XMLValue)
export(is.XiMpLe.doc)
export(is.XiMpLe.node)
+export(is.XiMpLe.validity)
export(node)
export(parseXMLTree)
export(pasteXML)
export(pasteXMLNode)
export(pasteXMLTag)
export(pasteXMLTree)
+export(validXML)
exportClasses(XiMpLe.doc)
exportClasses(XiMpLe.node)
+exportClasses(XiMpLe.validity)
exportMethods("XMLScan<-")
exportMethods(show)
+exportMethods(validXML)
import(methods)
diff --git a/packages/XiMpLe/R/00_class_01_XiMpLe.node.R b/packages/XiMpLe/R/00_class_01_XiMpLe.node.R
index e628f9b..a51c535 100644
--- a/packages/XiMpLe/R/00_class_01_XiMpLe.node.R
+++ b/packages/XiMpLe/R/00_class_01_XiMpLe.node.R
@@ -16,31 +16,31 @@
# along with XiMpLe. If not, see <http://www.gnu.org/licenses/>.
-# Class XiMpLe.node
-#
-# This class is used to create DOM trees of XML documents, like objects that are returned
-# by \code{\link[XiMpLe:parseXMLTree]{parseXMLTree}}.
-#
-# There are certain special values predefined for the \code{name} slot to easily create special XML elements:
-# \describe{
-# \item{\code{name=""}}{If the name is an empty character string, a pseudo node is created,
-# \code{\link[XiMpLe:pasteXMLNode]{pasteXMLNode}} will paste its \code{value} as plain text.}
-# \item{\code{name="!--"}}{Creates a comment tag, i.e., this will comment out all its \code{children}.}
-# \item{\code{name="![CDATA["}}{Creates a CDATA section and places all its \code{children} in it.}
-# \item{\code{name="*![CDATA["}}{Creates a CDATA section and places all its \code{children} in it, where the CDATA markers are
-# commented out by \code{/* */}, as is used for JavaScript in XHTML.}
-# }
-#
-# @slot name Name of the node (i.e., the XML tag identifier). For special names see details.
-# @slot attributes A list of named character values, representing the attributes of this node.
-# @slot children A list of further objects of class XiMpLe.node, representing child nodes of this node.
-# @slot value Plain text to be used as the enclosed value of this node. Set to \code{value=""} if you
-# want a childless node to be forced into an non-empty pair of start and end tags by \code{\link[XiMpLe:pasteXMLNode]{pasteXMLNode}}.
-# @name XiMpLe.node,-class
-# @aliases XiMpLe.node-class XiMpLe.node,-class
+#' Class XiMpLe.node
+#'
+#' This class is used to create DOM trees of XML documents, like objects that are returned
+#' by \code{\link[XiMpLe:parseXMLTree]{parseXMLTree}}.
+#'
+#' There are certain special values predefined for the \code{name} slot to easily create special XML elements:
+#' \describe{
+#' \item{\code{name=""}}{If the name is an empty character string, a pseudo node is created,
+#' \code{\link[XiMpLe:pasteXMLNode]{pasteXMLNode}} will paste its \code{value} as plain text.}
+#' \item{\code{name="!--"}}{Creates a comment tag, i.e., this will comment out all its \code{children}.}
+#' \item{\code{name="![CDATA["}}{Creates a CDATA section and places all its \code{children} in it.}
+#' \item{\code{name="*![CDATA["}}{Creates a CDATA section and places all its \code{children} in it, where the CDATA markers are
+#' commented out by \code{/* */}, as is used for JavaScript in XHTML.}
+#' }
+#'
+#' @slot name Name of the node (i.e., the XML tag identifier). For special names see details.
+#' @slot attributes A list of named character values, representing the attributes of this node.
+#' @slot children A list of further objects of class XiMpLe.node, representing child nodes of this node.
+#' @slot value Plain text to be used as the enclosed value of this node. Set to \code{value=""} if you
+#' want a childless node to be forced into an non-empty pair of start and end tags by \code{\link[XiMpLe:pasteXMLNode]{pasteXMLNode}}.
+#' @name XiMpLe.node,-class
+#' @aliases XiMpLe.node-class XiMpLe.node,-class
#' @import methods
-# @keywords classes
-# @rdname XiMpLe.node-class
+#' @keywords classes
+#' @rdname XiMpLe.node-class
#' @export
setClass("XiMpLe.node",
@@ -59,30 +59,30 @@ setClass("XiMpLe.node",
)
setValidity("XiMpLe.node", function(object){
- obj.name <- object at name
- obj.attributes <- object at attributes
- obj.children <- object at children
- obj.value <- object at value
+ obj.name <- slot(object, "name")
+ obj.attributes <- slot(object, "attributes")
+ obj.children <- slot(object, "children")
+ obj.value <- slot(object, "value")
- if(isTRUE(!nchar(obj.name) > 0) & isTRUE(!nchar(obj.value) > 0)){
- print(str(object))
- stop(simpleError("Invalid object: A node must at least have a name or a value!"))
- } else {}
+ if(isTRUE(!nchar(obj.name) > 0) & isTRUE(!nchar(obj.value) > 0)){
+ print(str(object))
+ stop(simpleError("Invalid object: A node must at least have a name or a value!"))
+ } else {}
- obj.attributes.names <- names(obj.attributes)
- # if there are attributes, check that they all have names
- if(length(obj.attributes) > 0){
- if(length(obj.attributes) != length(obj.attributes.names)){
- stop(simpleError("Invalid object: All attributes must have names!"))
- } else {}
+ obj.attributes.names <- names(obj.attributes)
+ # if there are attributes, check that they all have names
+ if(length(obj.attributes) > 0){
+ if(length(obj.attributes) != length(obj.attributes.names)){
+ stop(simpleError("Invalid object: All attributes must have names!"))
} else {}
+ } else {}
- # check content of children
- if(length(obj.children) > 0){
- child.nodes <- sapply(obj.children, function(this.child){is.XiMpLe.node(this.child)})
- if(!all(child.nodes)){
- stop(simpleError("Invalid object: All list elements of children must be of class XiMpLe.node!"))
- } else {}
+ # check content of children
+ if(length(obj.children) > 0){
+ child.nodes <- sapply(obj.children, function(this.child){is.XiMpLe.node(this.child)})
+ if(!all(child.nodes)){
+ stop(simpleError("Invalid object: All list elements of children must be of class XiMpLe.node!"))
} else {}
+ } else {}
return(TRUE)
})
diff --git a/packages/XiMpLe/R/00_class_02_XiMpLe.doc.R b/packages/XiMpLe/R/00_class_02_XiMpLe.doc.R
index cd76b6d..6552bdd 100644
--- a/packages/XiMpLe/R/00_class_02_XiMpLe.doc.R
+++ b/packages/XiMpLe/R/00_class_02_XiMpLe.doc.R
@@ -16,20 +16,20 @@
# along with XiMpLe. If not, see <http://www.gnu.org/licenses/>.
-# Class XiMpLe.doc
-#
-# This class is used for objects that are returned by \code{\link[XiMpLe:parseXMLTree]{parseXMLTree}}.
-#
-# @slot file Character string, Name of the file.
-# @slot xml A named list, XML declaration of the file.
-# @slot dtd A named list, Doctype definition of the file.
-# @slot children A list of objects of class XiMpLe.node, representing the DOM structure of the XML document.
-# @name XiMpLe.doc,-class
-# @aliases XiMpLe.doc-class XiMpLe.doc,-class
+#' Class XiMpLe.doc
+#'
+#' This class is used for objects that are returned by \code{\link[XiMpLe:parseXMLTree]{parseXMLTree}}.
+#'
+#' @slot file Character string, Name of the file.
+#' @slot xml A named list, XML declaration of the file.
+#' @slot dtd A named list, Doctype definition of the file.
+#' @slot children A list of objects of class XiMpLe.node, representing the DOM structure of the XML document.
+#' @name XiMpLe.doc,-class
+#' @aliases XiMpLe.doc-class XiMpLe.doc,-class
#' @include 00_class_01_XiMpLe.node.R
#' @import methods
-# @keywords classes
-# @rdname XiMpLe.doc-class
+#' @keywords classes
+#' @rdname XiMpLe.doc-class
#' @export
setClass("XiMpLe.doc",
@@ -48,30 +48,30 @@ setClass("XiMpLe.doc",
)
setValidity("XiMpLe.doc", function(object){
- obj.xml <- object at xml
- obj.dtd <- object at dtd
- obj.children <- object at children
+ obj.xml <- slot(object, "xml")
+ obj.dtd <- slot(object, "dtd")
+ obj.children <- slot(object, "children")
- obj.xml.names <- names(obj.xml)
- obj.dtd.names <- names(obj.dtd)
- # if there are declarations, check that they all have names
- if(length(obj.xml) > 0){
- if(length(obj.xml) != length(obj.xml.names)){
- stop(simpleError("Invalid object: All xml declarations must have names!"))
- } else {}
+ obj.xml.names <- names(obj.xml)
+ obj.dtd.names <- names(obj.dtd)
+ # if there are declarations, check that they all have names
+ if(length(obj.xml) > 0){
+ if(length(obj.xml) != length(obj.xml.names)){
+ stop(simpleError("Invalid object: All xml declarations must have names!"))
} else {}
- if(length(obj.dtd) > 0){
- if(length(obj.dtd) != length(obj.dtd.names)){
- stop(simpleError("Invalid object: All doctype declarations must have names!"))
- } else {}
+ } else {}
+ if(length(obj.dtd) > 0){
+ if(length(obj.dtd) != length(obj.dtd.names)){
+ stop(simpleError("Invalid object: All doctype declarations must have names!"))
} else {}
+ } else {}
- # check content of children
- if(length(obj.children) > 0){
- child.nodes <- sapply(obj.children, function(this.child){is.XiMpLe.node(this.child)})
- if(!all(child.nodes)){
- stop(simpleError("Invalid object: All list elements of children must be of class XiMpLe.node!"))
- } else {}
+ # check content of children
+ if(length(obj.children) > 0){
+ child.nodes <- sapply(obj.children, function(this.child){is.XiMpLe.node(this.child)})
+ if(!all(child.nodes)){
+ stop(simpleError("Invalid object: All list elements of children must be of class XiMpLe.node!"))
} else {}
+ } else {}
return(TRUE)
})
diff --git a/packages/XiMpLe/R/00_class_03_XiMpLe.validity.R b/packages/XiMpLe/R/00_class_03_XiMpLe.validity.R
new file mode 100644
index 0000000..0df0258
--- /dev/null
+++ b/packages/XiMpLe/R/00_class_03_XiMpLe.validity.R
@@ -0,0 +1,74 @@
+# Copyright 2015 Meik Michalke <meik.michalke at hhu.de>
+#
+# This file is part of the R package XiMpLe.
+#
+# XiMpLe is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# XiMpLe is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with XiMpLe. If not, see <http://www.gnu.org/licenses/>.
+
+
+#' Class XiMpLe.validity
+#'
+#' Used for objects that describe valid child nodes and attributes of XiMpLe.nodes.
+#'
+#' You should use \code{\link[XiMpLe:XMLValidity]{XMLValidity}} to create objects of this class.
+#'
+#' @slot children Named list of character vectors, where the element name defines the parent node
+#' name and each character string a valid child node name.
+#' @slot attrs Named list of character vectors, where the element name defines the parent node
+#' name and each character string a valid attribute name.
+#' @slot allChildren Character vector, names of globally valid child nodes for all nodes, if any.
+#' @slot allAttrs Character vector, names of globally valid attributes for all nodes, if any.
+#' @slot empty Character vector, names of nodes that must be empty nodes (i.e., no closing tag), if any.
+#' @name XiMpLe.validity,-class
+#' @aliases XiMpLe.validity-class XiMpLe.validity,-class
+#' @import methods
+#' @keywords classes
+#' @seealso
+#' \code{\link[XiMpLe:XMLValidity]{XMLValidity}},
+#' \code{\link[XiMpLe:validXML]{validXML}}
+#' @rdname XiMpLe.validity-class
+#' @export
+
+setClass("XiMpLe.validity",
+ representation=representation(
+ children="list",
+ attrs="list",
+ allChildren="character",
+ allAttrs="character",
+ empty="character"
+ ),
+ prototype(
+ children=list(),
+ attrs=list(),
+ allChildren=character(),
+ allAttrs=character(),
+ empty=character()
+ )
+)
+
+setValidity("XiMpLe.validity", function(object){
+ obj.children <- slot(object, "children")
+ obj.attrs <- slot(object, "attrs")
+
+ for (thisChild in obj.children){
+ if(!is.character(thisChild)){
+ stop(simpleError("Invalid object: all \"children\" must be character vectors!"))
+ } else {}
+ }
+ for (thisAttr in obj.attrs){
+ if(!is.character(thisAttr)){
+ stop(simpleError("Invalid object: all \"attrs\" must be character vectors!"))
+ } else {}
+ }
+ return(TRUE)
+})
diff --git a/packages/XiMpLe/R/01_method_04_validXML.R b/packages/XiMpLe/R/01_method_04_validXML.R
new file mode 100644
index 0000000..99c7412
--- /dev/null
+++ b/packages/XiMpLe/R/01_method_04_validXML.R
@@ -0,0 +1,269 @@
+# Copyright 2015 Meik Michalke <meik.michalke at hhu.de>
+#
+# This file is part of the R package XiMpLe.
+#
+# XiMpLe is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# XiMpLe is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with XiMpLe. If not, see <http://www.gnu.org/licenses/>.
+
+
+#' Validate S4 objects of XiMpLe XML classes
+#'
+#' Check whether objects of class \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
+#' or \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}} have valid child nodes.
+#'
+#' XiMpLe can't handle DOM specifications yet, but this method can be used to construct
+#' validation schemes.
+#'
+#' @note: If no \code{parent} is specified, \code{obj} will be checked recursively. If
+#'
+#' @param obj An object of class \code{XiMpLe.doc} or \code{XiMpLe.node}. If \code{parent=NULL}, this object
+#' will be checked for validity, including its child nodes. If \code{parent} is either a character string
+#' or another XiMpLe node, it will be checked whether \code{obj} is a valid child node of \code{parent}.
+#' @param validity An object of class \code{\link[XiMpLe:XiMpLe.validity-class]{XiMpLe.validity}},
+#' see \code{\link[XiMpLe:XMLValidity]{XMLValidity}}.
+#' @param parent Either a character string (name of the parent node) or a XiMpLe node, whose name will be used
+#' as name of the parent node.
+#' @param children Logical, whether child node names should be checked for validity.
+#' @param attributes Logical, whether attributes should be checked for validity.
+#' @param warn Logical, whether invalid objects should cause a warning or stop with an error.
+#' @param section Either a character string (name of the section) or a XiMpLe node, whose name will be used
+#' as name of the XML section this check refers to. This is only relevant for warnings and error messages,
+#' in case you want to use something different than the actual parent node name.
+#' @param caseSens Logical, whether checks should be case sensitive or not.
+#' @return Returns \code{TRUE} if tests pass, and depending on the setting of \code{warn} either \code{FALSE} or
+#' an error if a test fails.
+#' @aliases
+#' validXML,-methods
+#' validXML,XiMpLe.doc-method
+#' validXML,XiMpLe.node-method
+#' validXML,XiMpLe.XML-method
+#' @seealso
+#' \code{\link[XiMpLe:validXML]{validXML}},
+#' \code{\link[XiMpLe:XMLValidity]{XMLValidity}},
+#' \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}, and
+#' \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}
+#' @keywords methods
+#' @docType methods
+#' @export
+#' @rdname validXML
+#' @include 00_class_01_XiMpLe.node.R
+#' @include 00_class_02_XiMpLe.doc.R
+setGeneric("validXML", function(obj, validity=XMLValidity(), parent=NULL, children=TRUE, attributes=TRUE, warn=FALSE, section=parent, caseSens=TRUE){standardGeneric("validXML")})
+
+#' @rdname validXML
+#' @export
+#' @examples
+#' HTMLish <- XMLValidity(
+#' children=list(
+#' body=c("a", "p", "ol", "ul", "strong"),
+#' head=c("title"),
+#' html=c("head", "body"),
+#' li=c("a", "br", "strong"),
+#' ol=c("li"),
+#' p=c("a", "br", "ol", "ul", "strong"),
+#' ul=c("li")
+#' ),
+#' attrs=list(
+#' a=c("href", "name"),
+#' p=c("align")
+#' ),
+#' allChildren=c("!--"),
+#' allAttrs=c("id", "class"),
+#' empty=c("br")
+#' )
+#' # make XML object
+#' validChildNodes <- XMLNode("html",
+#' XMLNode("head",
+#' XMLNode("!--", "comment always passes"),
+#' XMLNode("title", "test")
+#' ),
+#' XMLNode("body",
+#' XMLNode("p",
+#' XMLNode("a", "my link"),
+#' XMLNode("br"),
+#' "text goes on"
+#' )
+#' )
+#' )
+#' invalidChildNodes <- XMLNode("html",
+#' XMLNode("head",
+#' XMLNode("title",
+#' XMLNode("body", "test")
+#' )
+#' )
+#' )
+#'
+#' # do validity checks
+#' # the first should pass
+#' validXML(
+#' validChildNodes,
+#' validity=HTMLish
+#' )
+#'
+#' # now this one should cause a warning and return FALSE
+#' validXML(
+#' invalidChildNodes,
+#' validity=HTMLish,
+#' warn=TRUE
+#' )
+setMethod("validXML", signature(obj="XiMpLe.XML"), function(obj, validity=XMLValidity(), parent=NULL, children=TRUE, attributes=TRUE,
+ warn=FALSE, section=parent, caseSens=TRUE){
+ childValidity <- attributeValidity <- emptyValidity <- NULL
+ if(!is.XiMpLe.validity(validity)){
+ stop(simpleError(paste0(
+ "Invalid value for \"validity\": Got class ",
+ class(validity),
+ ", should be XiMpLe.validity!"))
+ )
+ }
+ # two possibilities:
+ # a) there's no "parent" value
+ # we're checking "obj" as the parent node itself
+ # - check attributes of "obj" directly
+ # - check child nodes of "obj" for valid node names
+ # - check if "obj" should be empty but is not
+ # - recursion: check attributes of child nodes etc.
+ # b) "parent" is given
+ # we're checking "obj" as child node for a given parent
+ # - check if "obj" node name is valid for parent node
+ # - check attributes of "obj"
+ # - no recursion
+ recursion <- FALSE
+ if(is.null(parent)){
+ parentName <- XMLName(obj)
+ nodeChildren <- XMLChildren(obj)
+ # check for violations of mandatory empty nodes
+ emptyNodes <- slot(validity, "empty")
+ if(!isTRUE(caseSens)){
+ emptyNodes <- tolower(emptyNodes)
+ } else {}
+ if(parentName %in% emptyNodes){
+ if(length(nodeChildren) > 0 | !identical(XMLValue(obj), character())){
+ return.message <- paste0("Invalid XML node <", parentName, " />: Should be empty, but it isn't!")
+ if(isTRUE(warn)){
+ warning(return.message, call.=FALSE)
+ emptyValidity <- FALSE
+ } else {
+ stop(simpleError(return.message))
+ }
+ } else {}
+ } else {}
+ recursion <- TRUE
+ } else if(is.XiMpLe.node(parent)){
+ parentName <- XMLName(parent)
+ } else if(is.character(parent) & length(parent) == 1){
+ parentName <- parent
+ } else {
+ stop(simpleError(paste0(
+ "Invalid value for \"parent\": Got class \"",
+ class(parent),
+ "\", should be XiMpLe.node or single character string!"))
+ )
+ }
+
+ if(is.null(section)){
+ section <- parentName
+ } else if(is.XiMpLe.node(section)){
+ section <- XMLName(section)
+ } else if(!is.character(section) | length(section) != 1){
+ stop(simpleError(paste0(
+ "Invalid value for \"section\": Got class \"",
+ class(section),
+ "\", should be XiMpLe.node or single character string!"))
+ )
+ } else {}
+
+ if(isTRUE(children)){
+ if(isTRUE(recursion)){
+ # are there any children to check in the first place?
+ if(length(nodeChildren) > 0){
+ childValidity <- all(sapply(
+ nodeChildren,
+ function(thisChild){
+ # check child itself
+ thisChildValidity <- valid.child(
+ parent=parentName,
+ children=thisChild,
+ validity=validity,
+ warn=warn,
+ section=section,
+ caseSens=caseSens
+ )
+ # check grandchildren
+ grandChildValidity <- validXML(
+ thisChild,
+ validity=validity,
+ children=children,
+ attributes=attributes,
+ warn=warn,
+ section=thisChild,
+ caseSens=caseSens
+ )
+ return(all(thisChildValidity, grandChildValidity))
+ }
+ ))
+ } else {
+ childValidity <- NULL
+ }
+ } else {
+ childValidity <- valid.child(
+ parent=parentName,
+ children=obj,
+ validity=validity,
+ warn=warn,
+ section=section,
+ caseSens=caseSens
+ )
+ }
+ } else {}
+ if(isTRUE(attributes)){
+ # we only check attributes of "obj"
+ attributeValidityObj <- valid.attribute(
+ node=XMLName(obj),
+ attrs=XMLAttrs(obj),
+ validity=validity,
+ warn=warn,
+ caseSens=caseSens
+ )
+ if(isTRUE(recursion) & !isTRUE(children)){
+ # we can skip this if children was TRUE, because attributes were
+ # already checked recursively, then. but if not:
+ # are there any children to check in the first place?
+ if(length(nodeChildren) > 0){
+ attributeValidityRecursive <- all(sapply(
+ nodeChildren,
+ function(thisChild){
+ # because of the recursion this checks the attributes of "thisChild"
+ thisChildValidity <- validXML(
+ thisChild,
+ validity=validity,
+ children=FALSE,
+ attributes=TRUE,
+ warn=warn,
+ section=thisChild,
+ caseSens=caseSens
+ )
+ return(thisChildValidity)
+ }
+ ))
+ } else {
+ attributeValidityRecursive <- NULL
+ }
+ } else {
+ attributeValidityRecursive <- NULL
+ }
+ attributeValidity <- all(attributeValidityObj, attributeValidityRecursive)
+ } else {}
+
+ return(all(childValidity, attributeValidity, emptyValidity))
+})
diff --git a/packages/XiMpLe/R/XMLValidity.R b/packages/XiMpLe/R/XMLValidity.R
new file mode 100644
index 0000000..6749346
--- /dev/null
+++ b/packages/XiMpLe/R/XMLValidity.R
@@ -0,0 +1,82 @@
+# Copyright 2015 Meik Michalke <meik.michalke at hhu.de>
+#
+# This file is part of the R package XiMpLe.
+#
+# XiMpLe is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# XiMpLe is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with XiMpLe. If not, see <http://www.gnu.org/licenses/>.
+
+
+#' Constructor function for XiMpLe.validity objects
+#'
+#' Create validity definitions for XiMpLe nodes, to be used by
+#' \code{\link[XiMpLe:validXML]{validXML}}.
+#'
+#' @param children Named list of character vectors, where the element name defines the parent node
+#' name and each character string a valid child node name.
+#' @param attrs Named list of character vectors, where the element name defines the parent node
+#' name and each character string a valid attribute name.
+#' @param allChildren Character vector, names of globally valid child nodes for all nodes, if any.
+#' @param allAttrs Character vector, names of globally valid attributes for all nodes, if any.
+#' @param empty Character vector, names of nodes that must be empty nodes (i.e., no closing tag), if any.
+#' @return An object of class \code{\link[XiMpLe:XiMpLe.validity-class]{XiMpLe.validity}}
+#' @seealso
+#' \code{\link[XiMpLe:validXML]{validXML}}
+#' @export
+#' @rdname XMLValidity
+#' @examples
+#' HTMLish <- XMLValidity(
+#' children=list(
+#' body=c("a", "p", "ol", "ul", "strong"),
+#' head=c("title"),
+#' html=c("head", "body"),
+#' li=c("a", "br", "strong"),
+#' ol=c("li"),
+#' p=c("a", "br", "ol", "ul", "strong"),
+#' ul=c("li")
+#' ),
+#' attrs=list(
+#' a=c("href", "name"),
+#' p=c("align")
+#' ),
+#' allChildren=c("!--"),
+#' allAttrs=c("id", "class"),
+#' empty=c("br")
+#' )
+XMLValidity <- function(children=NULL, attrs=NULL, allChildren=NULL, allAttrs=NULL, empty=NULL){
+
+ if(is.null(children)){
+ children <- list()
+ } else {}
+ if(is.null(attrs)){
+ attrs <- list()
+ } else {}
+ if(is.null(allChildren)){
+ allChildren <- character()
+ } else {}
+ if(is.null(allAttrs)){
+ allAttrs <- character()
+ } else {}
+ if(is.null(empty)){
+ empty <- character()
+ } else {}
+
+ newValidity <- new("XiMpLe.validity",
+ children=children,
+ attrs=attrs,
+ allChildren=allChildren,
+ allAttrs=allAttrs,
+ empty=empty
+ )
+
+ return(newValidity)
+}
\ No newline at end of file
diff --git a/packages/XiMpLe/R/XiMpLe-internal.R b/packages/XiMpLe/R/XiMpLe-internal.R
index b0490b5..3e52a4d 100644
--- a/packages/XiMpLe/R/XiMpLe-internal.R
+++ b/packages/XiMpLe/R/XiMpLe-internal.R
@@ -556,3 +556,94 @@ XML.nodes <- function(single.tags, end.here=NA, start=1){
}
return(list(children=children, tag.no=tag.no))
} ## end function XML.nodes()
+
+
+## function valid.child()
+# - parent: character string, name of the parent node
+# - children: (list of) XiMpLe.node objects, child nodes to check
+# - validity: definitions of valid child nodes, class XiMpLe.validity
+# - warn: warning or stop?
+# - section: an optional name for the section for the warning/error
+# (if it shouldn't be the parent name)
+# - node names: can alternatively be given instead of 'children', as character vector
+# - graceful: allow everything inside "!--" comments?
+valid.child <- function(parent, children, validity, warn=FALSE, section=parent, node.names=NULL,
+ caseSens=TRUE, graceful=TRUE){
+ if(isTRUE(graceful) && identical(parent, "!--")){
+ # skip all checks and return TRUE
+ return(TRUE)
+ } else {}
+ if(is.null(node.names)){
+ # check the node names and allow only valid ones
+ node.names <- unlist(sapply(child.list(children), function(this.child){
+ if(is.XiMpLe.node(this.child)){
+ this.child.name <- XMLName(this.child)
+ if(identical(this.child.name, "")){
+ # special case: empty node name; this is used to combine
+ # comments with the node they belong to, so rather check
+ # the children of this special node
+ return(unlist(sapply(XMLChildren(this.child), XMLName)))
+ } else {
+ return(this.child.name)
+ }
+ } else {
+ stop(simpleError(paste0("Invalid object for <", section, "> node, must be of class XiMpLe.node, but got class ", class(this.child), "!")))
+ }
+ }))
+ } else {}
+
+ validAllChildren <- slot(validity, "allChildren")
+ validChildren <- slot(validity, "children")[[parent]]
+ if(!isTRUE(caseSens)){
+ node.names <- tolower(node.names)
+ validAllChildren <- tolower(validAllChildren)
+ validChildren <- tolower(validChildren)
+ } else {}
+
+ invalid.sets <- !node.names %in% c(validAllChildren, validChildren)
+ if(any(invalid.sets)){
+ return.message <- paste0("Invalid XML nodes for <", section, "> section: ", paste(node.names[invalid.sets], collapse=", "))
+ if(isTRUE(warn)){
+ warning(return.message, call.=FALSE)
+ return(FALSE)
+ } else {
+ stop(simpleError(return.message))
+ }
+ } else {
+ return(TRUE)
+ }
+} ## end function valid.child()
+
+
+## function valid.attribute()
+# similar to valid.child(), but checks the validity of attributes of a given node
+# it's a bit simpler
+# - node: a character string, node name
+# - attrs: a named list of attributes to check
+# - validity: definitions of valid child nodes, class XiMpLe.validity
+valid.attribute <- function(node, attrs, validity, warn=FALSE, caseSens=TRUE){
+ if(length(attrs) > 0){
+ attrsNames <- names(attrs)
+ validAllAttrs <- slot(validity, "allAttrs")
+ validAttrs <- slot(validity, "attrs")[[node]]
+ if(!isTRUE(caseSens)){
+ attrsNames <- tolower(attrsNames)
+ validAllAttrs <- tolower(validAllAttrs)
+ validAttrs <- tolower(validAttrs)
+ } else {}
+ invalid.sets <- !attrsNames %in% c(validAllAttrs, validAttrs)
+ if(any(invalid.sets)){
+ return.message <- paste0("Invalid XML attributes for <", node, "> node: ", paste(attrsNames[invalid.sets], collapse=", "))
+ if(isTRUE(warn)){
+ warning(return.message, call.=FALSE)
+ return(FALSE)
+ } else {
+ stop(simpleError(return.message))
+ }
+ } else {
+ return(TRUE)
+ }
+ } else {
+ return(NULL)
+ }
+}
diff --git a/packages/XiMpLe/R/XiMpLe-package.R b/packages/XiMpLe/R/XiMpLe-package.R
index ff283b0..82fadaa 100644
--- a/packages/XiMpLe/R/XiMpLe-package.R
+++ b/packages/XiMpLe/R/XiMpLe-package.R
@@ -3,8 +3,8 @@
#' \tabular{ll}{
#' Package: \tab XiMpLe\cr
#' Type: \tab Package\cr
-#' Version: \tab 0.03-23\cr
-#' Date: \tab 2015-11-24\cr
+#' Version: \tab 0.03-24\cr
+#' Date: \tab 2015-12-08\cr
#' Depends: \tab R (>= 2.9.0),methods\cr
#' Encoding: \tab UTF-8\cr
#' License: \tab GPL (>= 3)\cr
diff --git a/packages/XiMpLe/R/zzz_is_get_utils.R b/packages/XiMpLe/R/zzz_is_get_utils.R
index c7e8f1d..f8c6211 100644
--- a/packages/XiMpLe/R/zzz_is_get_utils.R
+++ b/packages/XiMpLe/R/zzz_is_get_utils.R
@@ -19,19 +19,25 @@
## the name "zzz_*" is just to ensure roxygen doesn't parse it before XMLNode.R and XMLTree.R
#' @param x An arbitrary \code{R} object.
-#' @rdname XMLNode
+#' @rdname XiMpLe.node-class
#' @export
is.XiMpLe.node <- function(x){
inherits(x, "XiMpLe.node")
}
#' @param x An arbitrary \code{R} object.
-#' @rdname XMLTree
+#' @rdname XiMpLe.doc-class
#' @export
is.XiMpLe.doc <- function(x){
inherits(x, "XiMpLe.doc")
}
+#' @param x An arbitrary \code{R} object.
+#' @rdname XiMpLe.validity-class
+#' @export
+is.XiMpLe.validity <- function(x){
+ inherits(x, "XiMpLe.validity")
+}
#' Getter/setter methods for S4 objects of XiMpLe XML classes
#'
diff --git a/packages/XiMpLe/man/XMLGetters-methods.Rd b/packages/XiMpLe/man/XMLGetters-methods.Rd
index 6801be3..4fe0fcb 100644
--- a/packages/XiMpLe/man/XMLGetters-methods.Rd
+++ b/packages/XiMpLe/man/XMLGetters-methods.Rd
@@ -145,8 +145,7 @@ XMLScanDeep(obj, find = NULL, search = "attributes")
\item{name}{Character, name of nodes to scan for.}
-\item{as.list}{Logical, if \code{TRUE} allways returns a list (or NULL),
- otherwise if exactly one result is found,
+\item{as.list}{Logical, if \code{TRUE} allways returns a list (or NULL), otherwise if exactly one result is found,
it will be returned as as single \code{XiMpLe.node}.}
\item{find}{Character, name of element to scan for.}
@@ -175,21 +174,16 @@ These are convenience methods to get or set slots from XML objects without using
Another special method can scan a node/document tree object for appearances of nodes with a particular name:
\itemize{
- \item{\code{XMLScan(obj, name,
- as.list=FALSE)}: }{get/set the XML nodes by name (recursively searches slot \code{name} of both classes
- \code{XiMpLe.node} and \code{XiMpLe.doc}). If \code{as.list=TRUE} allways returns a list (or NULL),
- otherwise if exactly one result is found,
+ \item{\code{XMLScan(obj, name, as.list=FALSE)}: }{get/set the XML nodes by name (recursively searches slot \code{name} of both classes
+ \code{XiMpLe.node} and \code{XiMpLe.doc}). If \code{as.list=TRUE} allways returns a list (or NULL), otherwise if exactly one result is found,
it will be returned as as single \code{XiMpLe.node}.}
}
-Finally,
- there is a method to scan for certain values in XiMpLe objects and just list them. For instance,
- it can be used to
+Finally, there is a method to scan for certain values in XiMpLe objects and just list them. For instance, it can be used to
list all instances of a certain attribute type in a document tree:
\itemize{
- \item{\code{XMLScanDeep(obj, find,
- search="attributes")}: }{returns all found instances of \code{find} in all slots defined by \code{search}.}
+ \item{\code{XMLScanDeep(obj, find, search="attributes")}: }{returns all found instances of \code{find} in all slots defined by \code{search}.}
}
}
\examples{
diff --git a/packages/XiMpLe/man/XMLNode.Rd b/packages/XiMpLe/man/XMLNode.Rd
index dfa3ce8..c206e5f 100644
--- a/packages/XiMpLe/man/XMLNode.Rd
+++ b/packages/XiMpLe/man/XMLNode.Rd
@@ -1,21 +1,17 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/XMLNode.R, R/zzz_is_get_utils.R
+% Please edit documentation in R/XMLNode.R
\name{XMLNode}
\alias{XMLNode}
-\alias{is.XiMpLe.node}
\title{Constructor function for XiMpLe.node objects}
\usage{
XMLNode(name, ..., attrs = NULL, namespace = "",
namespaceDefinitions = NULL, .children = list(...))
-
-is.XiMpLe.node(x)
}
\arguments{
\item{name}{Character string, the tag name.}
\item{...}{Optional children for the tag. Must be either objects of class XiMpLe.node or character strings,
-which are treated as simple text values. If this is empty,
- the tag will be treated as an empty tag. To
+which are treated as simple text values. If this is empty, the tag will be treated as an empty tag. To
force a closing tag, supply an empty string, i.e. \code{""}.}
\item{attrs}{An optional named list of attributes.}
@@ -24,10 +20,7 @@ force a closing tag, supply an empty string, i.e. \code{""}.}
\item{namespaceDefinitions}{Currently ignored.}
-\item{.children}{Alternative way of specifying children,
- if you have them already as a list.}
-
-\item{x}{An arbitrary \code{R} object.}
+\item{.children}{Alternative way of specifying children, if you have them already as a list.}
}
\value{
An object of class \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}.
@@ -36,8 +29,7 @@ An object of class \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}.
Can be used to create XML nodes.
}
\details{
-To generate a CDATA node, set \code{name="![CDATA["}, to create a comment,
- set \code{name="!--"}.
+To generate a CDATA node, set \code{name="![CDATA["}, to create a comment, set \code{name="!--"}.
}
\examples{
sample.XML.node <- XMLNode("a",
diff --git a/packages/XiMpLe/man/XMLTree.Rd b/packages/XiMpLe/man/XMLTree.Rd
index a9954bc..13b73e4 100644
--- a/packages/XiMpLe/man/XMLTree.Rd
+++ b/packages/XiMpLe/man/XMLTree.Rd
@@ -1,32 +1,23 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/XMLTree.R, R/zzz_is_get_utils.R
+% Please edit documentation in R/XMLTree.R
\name{XMLTree}
\alias{XMLTree}
-\alias{is.XiMpLe.doc}
\title{Constructor function for XiMpLe.doc objects}
\usage{
XMLTree(..., xml = NULL, dtd = NULL, .children = list(...))
-
-is.XiMpLe.doc(x)
}
\arguments{
\item{...}{Optional children for the XML tree. Must be either objects of class
\code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}} or character strings,
which are treated as simple text values.}
-\item{xml}{A named list, XML declaration of the XML tree. Currently just pasted,
- no checking is done.}
+\item{xml}{A named list, XML declaration of the XML tree. Currently just pasted, no checking is done.}
-\item{dtd}{A named list,
- doctype definition of the XML tree. Valid elements are \code{doctype} (root element),
- \code{decl}
+\item{dtd}{A named list, doctype definition of the XML tree. Valid elements are \code{doctype} (root element), \code{decl}
("PUBLIC" or "SYSTEM"), \code{id} (the identifier) and \code{refer} (URI to .dtd).
Currently just pasted, no checking is done.}
-\item{.children}{Alternative way of specifying children,
- if you have them already as a list.}
-
-\item{x}{An arbitrary \code{R} object.}
+\item{.children}{Alternative way of specifying children, if you have them already as a list.}
}
\value{
An object of class \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
diff --git a/packages/XiMpLe/man/XMLValidity.Rd b/packages/XiMpLe/man/XMLValidity.Rd
new file mode 100644
index 0000000..ad5f9d5
--- /dev/null
+++ b/packages/XiMpLe/man/XMLValidity.Rd
@@ -0,0 +1,53 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/XMLValidity.R
+\name{XMLValidity}
+\alias{XMLValidity}
+\title{Constructor function for XiMpLe.validity objects}
+\usage{
+XMLValidity(children = NULL, attrs = NULL, allChildren = NULL,
+ allAttrs = NULL, empty = NULL)
+}
+\arguments{
+\item{children}{Named list of character vectors, where the element name defines the parent node
+name and each character string a valid child node name.}
+
+\item{attrs}{Named list of character vectors, where the element name defines the parent node
+name and each character string a valid attribute name.}
+
+\item{allChildren}{Character vector, names of globally valid child nodes for all nodes, if any.}
+
+\item{allAttrs}{Character vector, names of globally valid attributes for all nodes, if any.}
+
+\item{empty}{Character vector, names of nodes that must be empty nodes (i.e., no closing tag), if any.}
+}
+\value{
+An object of class \code{\link[XiMpLe:XiMpLe.validity-class]{XiMpLe.validity}}
+}
+\description{
+Create validity definitions for XiMpLe nodes, to be used by
+\code{\link[XiMpLe:validXML]{validXML}}.
+}
+\examples{
+HTMLish <- XMLValidity(
+ children=list(
+ body=c("a", "p", "ol", "ul", "strong"),
+ head=c("title"),
+ html=c("head", "body"),
+ li=c("a", "br", "strong"),
+ ol=c("li"),
+ p=c("a", "br", "ol", "ul", "strong"),
+ ul=c("li")
+ ),
+ attrs=list(
+ a=c("href", "name"),
+ p=c("align")
+ ),
+ allChildren=c("!--"),
+ allAttrs=c("id", "class"),
+ empty=c("br")
+)
+}
+\seealso{
+\code{\link[XiMpLe:validXML]{validXML}}
+}
+
diff --git a/packages/XiMpLe/man/XiMpLe-package.Rd b/packages/XiMpLe/man/XiMpLe-package.Rd
index 02ba7e1..067c0d6 100644
--- a/packages/XiMpLe/man/XiMpLe-package.Rd
+++ b/packages/XiMpLe/man/XiMpLe-package.Rd
@@ -12,7 +12,7 @@ A Simple XML Tree Parser and Generator.
Package: \tab XiMpLe\cr
Type: \tab Package\cr
Version: \tab 0.03-24\cr
-Date: \tab 2015-11-24\cr
+Date: \tab 2015-12-08\cr
Depends: \tab R (>= 2.9.0),methods\cr
Encoding: \tab UTF-8\cr
License: \tab GPL (>= 3)\cr
@@ -22,10 +22,8 @@ URL: \tab http://reaktanz.de/?c=hacking&s=XiMpLe\cr
Provides a simple XML tree parser/generator. It includes functions to read XML files into R objects,
get information out of and into nodes, and write R objects back to XML code.
-It's not as powerful as the 'XML' package and doesn't aim to be,
- but for simple XML handling
-it could be useful. It was originally developed for the R GUI and IDE RKWard (https://rkward.kde.org),
- to make plugin
+It's not as powerful as the 'XML' package and doesn't aim to be, but for simple XML handling
+it could be useful. It was originally developed for the R GUI and IDE RKWard (https://rkward.kde.org), to make plugin
development easier.
}
\author{
diff --git a/packages/XiMpLe/man/XiMpLe.doc-class.Rd b/packages/XiMpLe/man/XiMpLe.doc-class.Rd
index 5cd63c8..480993e 100644
--- a/packages/XiMpLe/man/XiMpLe.doc-class.Rd
+++ b/packages/XiMpLe/man/XiMpLe.doc-class.Rd
@@ -1,10 +1,30 @@
-\name{XiMpLe.doc-class}
-\title{S4 class XiMpLe.doc}
-\description{Class XiMpLe.doc}
-\details{This class is used for objects that are returned by \code{\link[XiMpLe:parseXMLTree]{parseXMLTree}}.}
-\alias{XiMpLe.doc-class}
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/00_class_02_XiMpLe.doc.R, R/zzz_is_get_utils.R
+\docType{class}
+\name{XiMpLe.doc,-class}
\alias{XiMpLe.doc,-class}
+\alias{XiMpLe.doc-class}
+\alias{is.XiMpLe.doc}
+\title{Class XiMpLe.doc}
+\usage{
+is.XiMpLe.doc(x)
+}
+\arguments{
+\item{x}{An arbitrary \code{R} object.}
+}
+\description{
+This class is used for objects that are returned by \code{\link[XiMpLe:parseXMLTree]{parseXMLTree}}.
+}
+\section{Slots}{
+
+\describe{
+\item{\code{file}}{Character string, Name of the file.}
+
+\item{\code{xml}}{A named list, XML declaration of the file.}
+
+\item{\code{dtd}}{A named list, Doctype definition of the file.}
+
+\item{\code{children}}{A list of objects of class XiMpLe.node, representing the DOM structure of the XML document.}
+}}
\keyword{classes}
-\section{Slots}{\describe{\item{\code{file}:}{(\code{\link{character}}) Name of the file.}\item{\code{xml}:}{(\code{\link{list}}) XML declaration of the file.}\item{\code{dtd}:}{(\code{\link{list}}) Doctype definition of the file.}\item{\code{children}:}{(\code{\link{list}}) A list of objects of class XiMpLe.node,
- representing the DOM structure of the XML document.}}}
diff --git a/packages/XiMpLe/man/XiMpLe.node-class.Rd b/packages/XiMpLe/man/XiMpLe.node-class.Rd
index 3ebb473..cd084d0 100644
--- a/packages/XiMpLe/man/XiMpLe.node-class.Rd
+++ b/packages/XiMpLe/man/XiMpLe.node-class.Rd
@@ -1,24 +1,43 @@
-\name{XiMpLe.node-class}
-\title{S4 class XiMpLe.node}
-\description{Class XiMpLe.node}
-\details{This class is used to create DOM trees of XML documents,
- like objects that are returned
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/00_class_01_XiMpLe.node.R, R/zzz_is_get_utils.R
+\docType{class}
+\name{XiMpLe.node,-class}
+\alias{XiMpLe.node,-class}
+\alias{XiMpLe.node-class}
+\alias{is.XiMpLe.node}
+\title{Class XiMpLe.node}
+\usage{
+is.XiMpLe.node(x)
+}
+\arguments{
+\item{x}{An arbitrary \code{R} object.}
+}
+\description{
+This class is used to create DOM trees of XML documents, like objects that are returned
by \code{\link[XiMpLe:parseXMLTree]{parseXMLTree}}.
-
+}
+\details{
There are certain special values predefined for the \code{name} slot to easily create special XML elements:
\describe{
-\item{\code{name=""}}{If the name is an empty character string, a pseudo node is created,
-\code{\link[XiMpLe:pasteXMLNode]{pasteXMLNode}} will paste its \code{value} as plain text.}
-\item{\code{name="!--"}}{Creates a comment tag, i.e.,
- this will comment out all its \code{children}.}
-\item{\code{name="![CDATA["}}{Creates a CDATA section and places all its \code{children} in it.}
+ \item{\code{name=""}}{If the name is an empty character string, a pseudo node is created,
+ \code{\link[XiMpLe:pasteXMLNode]{pasteXMLNode}} will paste its \code{value} as plain text.}
+ \item{\code{name="!--"}}{Creates a comment tag, i.e., this will comment out all its \code{children}.}
+ \item{\code{name="![CDATA["}}{Creates a CDATA section and places all its \code{children} in it.}
+ \item{\code{name="*![CDATA["}}{Creates a CDATA section and places all its \code{children} in it, where the CDATA markers are
+ commented out by \code{/* */}, as is used for JavaScript in XHTML.}
+}
+}
+\section{Slots}{
+
+\describe{
+\item{\code{name}}{Name of the node (i.e., the XML tag identifier). For special names see details.}
+
+\item{\code{attributes}}{A list of named character values, representing the attributes of this node.}
+
+\item{\code{children}}{A list of further objects of class XiMpLe.node, representing child nodes of this node.}
+
+\item{\code{value}}{Plain text to be used as the enclosed value of this node. Set to \code{value=""} if you
+want a childless node to be forced into an non-empty pair of start and end tags by \code{\link[XiMpLe:pasteXMLNode]{pasteXMLNode}}.}
}}
-\alias{XiMpLe.node-class}
-\alias{XiMpLe.node,-class}
\keyword{classes}
-\section{Slots}{\describe{\item{\code{name}:}{(\code{\link{character}}) Name of the node (i.e.,
- the XML tag identifier). For special names see details.}\item{\code{attributes}:}{(\code{\link{list}}) A list of named character values,
- representing the attributes of this node.}\item{\code{children}:}{(\code{\link{list}}) A list of further objects of class XiMpLe.node,
- representing child nodes of this node.}\item{\code{value}:}{(\code{\link{character}}) Plain text to be used as the enclosed value of this node. Set to \code{value=""} if you
-want a childless node to be forced into an non-empty pair of start and end tags by \code{\link[XiMpLe:pasteXMLNode]{pasteXMLNode}}.}}}
diff --git a/packages/XiMpLe/man/XiMpLe.validity-class.Rd b/packages/XiMpLe/man/XiMpLe.validity-class.Rd
new file mode 100644
index 0000000..fc41f1c
--- /dev/null
+++ b/packages/XiMpLe/man/XiMpLe.validity-class.Rd
@@ -0,0 +1,41 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/00_class_03_XiMpLe.validity.R, R/zzz_is_get_utils.R
+\docType{class}
+\name{XiMpLe.validity,-class}
+\alias{XiMpLe.validity,-class}
+\alias{XiMpLe.validity-class}
+\alias{is.XiMpLe.validity}
+\title{Class XiMpLe.validity}
+\usage{
+is.XiMpLe.validity(x)
+}
+\arguments{
+\item{x}{An arbitrary \code{R} object.}
+}
+\description{
+Used for objects that describe valid child nodes and attributes of XiMpLe.nodes.
+}
+\details{
+You should use \code{\link[XiMpLe:XMLValidity]{XMLValidity}} to create objects of this class.
+}
+\section{Slots}{
+
+\describe{
+\item{\code{children}}{Named list of character vectors, where the element name defines the parent node
+name and each character string a valid child node name.}
+
+\item{\code{attrs}}{Named list of character vectors, where the element name defines the parent node
+name and each character string a valid attribute name.}
+
+\item{\code{allChildren}}{Character vector, names of globally valid child nodes for all nodes, if any.}
+
+\item{\code{allAttrs}}{Character vector, names of globally valid attributes for all nodes, if any.}
+
+\item{\code{empty}}{Character vector, names of nodes that must be empty nodes (i.e., no closing tag), if any.}
+}}
+\seealso{
+\code{\link[XiMpLe:XMLValidity]{XMLValidity}},
+ \code{\link[XiMpLe:validXML]{validXML}}
+}
+\keyword{classes}
+
diff --git a/packages/XiMpLe/man/node.Rd b/packages/XiMpLe/man/node.Rd
index b3137c3..dfc0c8e 100644
--- a/packages/XiMpLe/man/node.Rd
+++ b/packages/XiMpLe/man/node.Rd
@@ -33,14 +33,10 @@ node(obj, node = list(), what = NULL, cond.attr = NULL,
\item{node}{A list of node names (or their numeric values), where each element is
the child of its previous element. duplicate matches will be returned as a list.}
-\item{what}{A character string,
- must be a valid slot name of class \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}},
- like
-\code{"attributes"} or \code{"value"}. If not \code{NULL},
- only that part of a node will be returned.
+\item{what}{A character string, must be a valid slot name of class \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}, like
+\code{"attributes"} or \code{"value"}. If not \code{NULL}, only that part of a node will be returned.
There's also two special properties for this option: \code{what="@path"} will not return the
-node or it's contents,
- but a character string with the "path" to it in the object; \code{what="obj at path"}
+node or it's contents, but a character string with the "path" to it in the object; \code{what="obj at path"}
is the same but won't have \code{obj} substituted with the object's name.}
\item{cond.attr}{A named character string, to further filter the returned results.
@@ -49,15 +45,13 @@ If not \code{NULL}, only nodes with fully matching attributes will be considered
\item{cond.value}{A character string, similar to \code{cond.attr}, but is matched
against the value between a pair of tags.}
-\item{element}{A character string naming one list element of the node slot. If \code{NULL},
- all
+\item{element}{A character string naming one list element of the node slot. If \code{NULL}, all
elements will be returned.}
\item{value}{The value to set.}
}
\description{
-This method can be used to get parts of a parsed XML tree object,
- or to fill it with new values.
+This method can be used to get parts of a parsed XML tree object, or to fill it with new values.
}
\examples{
\dontrun{
diff --git a/packages/XiMpLe/man/parseXMLTree.Rd b/packages/XiMpLe/man/parseXMLTree.Rd
index 11fb967..b064de3 100644
--- a/packages/XiMpLe/man/parseXMLTree.Rd
+++ b/packages/XiMpLe/man/parseXMLTree.Rd
@@ -13,19 +13,16 @@ parseXMLTree(file, drop = NULL, object = FALSE)
\code{"declarations"} and \code{"doctype"}, defining element classes to be dropped
from the resulting object.}
-\item{object}{Logical, if \code{TRUE},
- \code{file} will not be treated as a path name but as a
+\item{object}{Logical, if \code{TRUE}, \code{file} will not be treated as a path name but as a
character vector to be parsed as XML directly.}
}
\value{
An object of class \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}} with four slots:
\describe{
- \item{\code{file}:}{Full path to the parsed file,
- or \code{"object"} if \code{object=TRUE}.}
+ \item{\code{file}:}{Full path to the parsed file, or \code{"object"} if \code{object=TRUE}.}
\item{\code{xml}:}{XML declaration, if found.}
\item{\code{dtd}:}{Doctype definition, if found.}
- \item{\code{children}:}{A list of objects of class \code{XiMpLe.node},
- with the elements
+ \item{\code{children}:}{A list of objects of class \code{XiMpLe.node}, with the elements
\code{"name"} (the node name), \code{"attributes"} (list of attributes, if found),
\code{"children"} (list of \code{XiMpLe.node} object, if found) and \code{"value"}
(text value between a pair of start/end tags, if found).}
diff --git a/packages/XiMpLe/man/pasteXML-methods.Rd b/packages/XiMpLe/man/pasteXML-methods.Rd
index bb0b331..8bc0f3c 100644
--- a/packages/XiMpLe/man/pasteXML-methods.Rd
+++ b/packages/XiMpLe/man/pasteXML-methods.Rd
@@ -21,13 +21,11 @@ pasteXML(obj, ...)
\arguments{
\item{obj}{An object of class \code{XiMpLe.node} or \code{XiMpLe.doc}.}
-\item{...}{Additional options for the generic method, see options for a specific method,
- respectively.}
+\item{...}{Additional options for the generic method, see options for a specific method, respectively.}
\item{level}{Indentation level.}
-\item{shine}{Integer,
- controlling if the output should be formatted for better readability. Possible values:
+\item{shine}{Integer, controlling if the output should be formatted for better readability. Possible values:
\describe{
\item{0}{No formatting.}
\item{1}{Nodes will be indented.}
@@ -36,8 +34,7 @@ pasteXML(obj, ...)
\item{indent.by}{A charachter string defining how indentation should be done. Defaults to tab.}
-\item{tidy}{Logical,
- if \code{TRUE} the special characters "<" and ">" will be replaced with the entities
+\item{tidy}{Logical, if \code{TRUE} the special characters "<" and ">" will be replaced with the entities
"<" and "gt;" in attributes and text values.}
}
\description{
diff --git a/packages/XiMpLe/man/pasteXMLTag.Rd b/packages/XiMpLe/man/pasteXMLTag.Rd
index bbce218..dbe16fe 100644
--- a/packages/XiMpLe/man/pasteXMLTag.Rd
+++ b/packages/XiMpLe/man/pasteXMLTag.Rd
@@ -13,23 +13,19 @@ pasteXMLTag(tag, attr = NULL, child = NULL, empty = TRUE, level = 1,
\item{attr}{A list of attributes for the tag.}
-\item{child}{If \code{empty=FALSE},
- a character string to be pasted as a child node between start and end tag.}
+\item{child}{If \code{empty=FALSE}, a character string to be pasted as a child node between start and end tag.}
\item{empty}{Logical, <true /> or <false></false>}
\item{level}{Indentation level.}
-\item{allow.empty}{Logical, if \code{FALSE},
- tags without attributes will not be returned.}
+\item{allow.empty}{Logical, if \code{FALSE}, tags without attributes will not be returned.}
\item{rename}{An optional named list if the attributes in XML need to be renamed from their list names in \code{attr}.
-This list must in turn have a list element named after \code{tag},
- containing named character elements, where the
+This list must in turn have a list element named after \code{tag}, containing named character elements, where the
names represent the element names in \code{attr} and their values the names the XML attribute should get.}
-\item{shine}{Integer,
- controlling if the output should be formatted for better readability. Possible values:
+\item{shine}{Integer, controlling if the output should be formatted for better readability. Possible values:
\describe{
\item{0}{No formatting.}
\item{1}{Nodes will be indented.}
@@ -38,10 +34,8 @@ names represent the element names in \code{attr} and their values the names the
\item{indent.by}{A charachter string defining how indentation should be done. Defaults to tab.}
-\item{tidy}{Logical, if \code{TRUE} the special characters "<",
- ">" and "&" will be replaced with the entities
-"<", ">" and "&" in attribute values. For comment or CDATA tags,
- if the text includes newline characters
+\item{tidy}{Logical, if \code{TRUE} the special characters "<", ">" and "&" will be replaced with the entities
+"<", ">" and "&" in attribute values. For comment or CDATA tags, if the text includes newline characters
they will also be indented.}
}
\value{
@@ -55,8 +49,7 @@ with this one function.
\note{
However, you will probably not want to use this function at all, as it is much more
comfortable to create XML nodes or even nested trees with \code{\link[XiMpLe:XMLNode]{XMLNode}} and
- \code{\link[XiMpLe:XMLTree]{XMLTree}},
- and then feed the result to \code{\link[XiMpLe:pasteXML]{pasteXML}}.
+ \code{\link[XiMpLe:XMLTree]{XMLTree}}, and then feed the result to \code{\link[XiMpLe:pasteXML]{pasteXML}}.
}
\examples{
sample.XML.tag <- pasteXMLTag("a",
diff --git a/packages/XiMpLe/man/validXML.Rd b/packages/XiMpLe/man/validXML.Rd
new file mode 100644
index 0000000..6930699
--- /dev/null
+++ b/packages/XiMpLe/man/validXML.Rd
@@ -0,0 +1,119 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/01_method_04_validXML.R
+\docType{methods}
+\name{validXML}
+\alias{validXML}
+\alias{validXML,-methods}
+\alias{validXML,XiMpLe.XML-method}
+\alias{validXML,XiMpLe.doc-method}
+\alias{validXML,XiMpLe.node-method}
+\title{Validate S4 objects of XiMpLe XML classes}
+\usage{
+validXML(obj, validity = XMLValidity(), parent = NULL, children = TRUE,
+ attributes = TRUE, warn = FALSE, section = parent, caseSens = TRUE)
+
+\S4method{validXML}{XiMpLe.XML}(obj, validity = XMLValidity(),
+ parent = NULL, children = TRUE, attributes = TRUE, warn = FALSE,
+ section = parent, caseSens = TRUE)
+}
+\arguments{
+\item{obj}{An object of class \code{XiMpLe.doc} or \code{XiMpLe.node}. If \code{parent=NULL}, this object
+will be checked for validity, including its child nodes. If \code{parent} is either a character string
+or another XiMpLe node, it will be checked whether \code{obj} is a valid child node of \code{parent}.}
+
+\item{validity}{An object of class \code{\link[XiMpLe:XiMpLe.validity-class]{XiMpLe.validity}},
+see \code{\link[XiMpLe:XMLValidity]{XMLValidity}}.}
+
+\item{parent}{Either a character string (name of the parent node) or a XiMpLe node, whose name will be used
+as name of the parent node.}
+
+\item{children}{Logical, whether child node names should be checked for validity.}
+
+\item{attributes}{Logical, whether attributes should be checked for validity.}
+
+\item{warn}{Logical, whether invalid objects should cause a warning or stop with an error.}
+
+\item{section}{Either a character string (name of the section) or a XiMpLe node, whose name will be used
+as name of the XML section this check refers to. This is only relevant for warnings and error messages,
+in case you want to use something different than the actual parent node name.}
+
+\item{caseSens}{Logical, whether checks should be case sensitive or not.}
+}
+\value{
+Returns \code{TRUE} if tests pass, and depending on the setting of \code{warn} either \code{FALSE} or
+ an error if a test fails.
+}
+\description{
+Check whether objects of class \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
+or \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}} have valid child nodes.
+}
+\details{
+XiMpLe can't handle DOM specifications yet, but this method can be used to construct
+validation schemes.
+}
+\note{
+: If no \code{parent} is specified, \code{obj} will be checked recursively. If
+}
+\examples{
+HTMLish <- XMLValidity(
+ children=list(
+ body=c("a", "p", "ol", "ul", "strong"),
+ head=c("title"),
+ html=c("head", "body"),
+ li=c("a", "br", "strong"),
+ ol=c("li"),
+ p=c("a", "br", "ol", "ul", "strong"),
+ ul=c("li")
+ ),
+ attrs=list(
+ a=c("href", "name"),
+ p=c("align")
+ ),
+ allChildren=c("!--"),
+ allAttrs=c("id", "class"),
+ empty=c("br")
+)
+# make XML object
+validChildNodes <- XMLNode("html",
+ XMLNode("head",
+ XMLNode("!--", "comment always passes"),
+ XMLNode("title", "test")
+ ),
+ XMLNode("body",
+ XMLNode("p",
+ XMLNode("a", "my link"),
+ XMLNode("br"),
+ "text goes on"
+ )
+ )
+)
+invalidChildNodes <- XMLNode("html",
+ XMLNode("head",
+ XMLNode("title",
+ XMLNode("body", "test")
+ )
+ )
+)
+
+# do validity checks
+# the first should pass
+validXML(
+ validChildNodes,
+ validity=HTMLish
+)
+
+# now this one should cause a warning and return FALSE
+validXML(
+ invalidChildNodes,
+ validity=HTMLish,
+ warn=TRUE
+)
+}
+\seealso{
+\code{\link[XiMpLe:validXML]{validXML}},
+ \code{\link[XiMpLe:XMLValidity]{XMLValidity}},
+ \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}, and
+ \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}
+}
+\keyword{methods}
+
diff --git a/packages/XiMpLe/tests/testthat/sample_XML_validity.RData b/packages/XiMpLe/tests/testthat/sample_XML_validity.RData
new file mode 100644
index 0000000..32a3b7f
Binary files /dev/null and b/packages/XiMpLe/tests/testthat/sample_XML_validity.RData differ
diff --git a/packages/XiMpLe/tests/testthat/tests.R b/packages/XiMpLe/tests/testthat/tests.R
index c36879d..bada695 100644
--- a/packages/XiMpLe/tests/testthat/tests.R
+++ b/packages/XiMpLe/tests/testthat/tests.R
@@ -1,251 +1,445 @@
context("XML generation")
test_that("generate empty XML node", {
- sampleXMLStandard <- dget("sample_XML_node_empty_dput.txt")
- expect_that(
- XMLNode("empty"),
- equals(sampleXMLStandard)
- )
+ sampleXMLStandard <- dget("sample_XML_node_empty_dput.txt")
+ expect_that(
+ XMLNode("empty"),
+ equals(sampleXMLStandard)
+ )
})
test_that("generate closed XML node", {
- sampleXMLStandard <- dget("sample_XML_node_closed_dput.txt")
- expect_that(
- XMLNode("empty", ""),
- equals(sampleXMLStandard)
- )
+ sampleXMLStandard <- dget("sample_XML_node_closed_dput.txt")
+ expect_that(
+ XMLNode("empty", ""),
+ equals(sampleXMLStandard)
+ )
})
test_that("generate closed XML node with attributes", {
- # re-create object sampleXMLnode.attrs
- load("sample_XML_node_attrs.RData")
- expect_that(
- XMLNode("empty", "test", attrs=list(foo="bar")),
- equals(sampleXMLnode.attrs)
- )
+ # re-create object sampleXMLnode.attrs
+ load("sample_XML_node_attrs.RData")
+ expect_that(
+ XMLNode("empty", "test", attrs=list(foo="bar")),
+ equals(sampleXMLnode.attrs)
+ )
})
test_that("generate nested XML tag tree", {
- # re-create object sampleXMLTree
- load("sample_XML_tree.RData")
-
- sampleXMLnode.empty <- XMLNode("empty")
- sampleXMLnode.closed <- XMLNode("empty", "")
- sampleXMLnode.attrs <- XMLNode("empty", "test", attrs=list(foo="bar"))
- sampleXMLTree.test <- XMLTree(
- XMLNode("tree",
- sampleXMLnode.empty,
- sampleXMLnode.closed,
- sampleXMLnode.attrs
- )
- )
-
- expect_that(
- sampleXMLTree.test,
- equals(sampleXMLTree)
- )
+ # re-create object sampleXMLTree
+ load("sample_XML_tree.RData")
+
+ sampleXMLnode.empty <- XMLNode("empty")
+ sampleXMLnode.closed <- XMLNode("empty", "")
+ sampleXMLnode.attrs <- XMLNode("empty", "test", attrs=list(foo="bar"))
+ sampleXMLTree.test <- XMLTree(
+ XMLNode("tree",
+ sampleXMLnode.empty,
+ sampleXMLnode.closed,
+ sampleXMLnode.attrs
+ )
+ )
+
+ expect_that(
+ sampleXMLTree.test,
+ equals(sampleXMLTree)
+ )
})
context("XML parsing")
test_that("parse XML file", {
- # re-create object sampleXMLparsed
- load("sample_RSS_parsed.RData")
+ # re-create object sampleXMLparsed
+ load("sample_RSS_parsed.RData")
- sampleXMLFile <- normalizePath("koRpus_RSS_sample.xml")
- XMLtoParse <- file(sampleXMLFile, encoding="UTF-8")
- sampleXMLparsed.test <- parseXMLTree(XMLtoParse)
- close(XMLtoParse)
+ sampleXMLFile <- normalizePath("koRpus_RSS_sample.xml")
+ XMLtoParse <- file(sampleXMLFile, encoding="UTF-8")
+ sampleXMLparsed.test <- parseXMLTree(XMLtoParse)
+ close(XMLtoParse)
- expect_that(
- sampleXMLparsed.test,
- equals(sampleXMLparsed))
+ expect_that(
+ sampleXMLparsed.test,
+ equals(sampleXMLparsed))
})
context("extracting nodes")
test_that("extract node from parsed XML tree", {
- # re-create object sampleXMLparsed
- load("sample_RSS_parsed.RData")
- # re-create object sampleXMLnode.extracted
- load("sample_XML_node_extracted.RData")
+ # re-create object sampleXMLparsed
+ load("sample_RSS_parsed.RData")
+ # re-create object sampleXMLnode.extracted
+ load("sample_XML_node_extracted.RData")
- sampleXMLnode.test <- node(sampleXMLparsed, node=list("rss","channel","atom:link"))
+ sampleXMLnode.test <- node(sampleXMLparsed, node=list("rss","channel","atom:link"))
- expect_that(
- sampleXMLnode.test,
- equals(sampleXMLnode.extracted))
+ expect_that(
+ sampleXMLnode.test,
+ equals(sampleXMLnode.extracted))
})
context("changing node values")
test_that("change attribute values in XML node", {
- # re-create object sampleXMLparsed
- load("sample_RSS_parsed.RData")
- # re-create object sampleXMLnode.extracted
- load("sample_XML_tree_changed.RData")
-
- # replace URL
- node(sampleXMLparsed,
- node=list("rss","channel","atom:link"),
- what="attributes", element="href") <- "http://example.com"
-
- # remove "rel" attribute
- node(sampleXMLparsed,
- node=list("rss","channel","atom:link"),
- what="attributes", element="rel") <- NULL
-
- expect_that(
- sampleXMLparsed,
- equals(sampleXMLparsed.changed))
+ # re-create object sampleXMLparsed
+ load("sample_RSS_parsed.RData")
+ # re-create object sampleXMLnode.extracted
+ load("sample_XML_tree_changed.RData")
+
+ # replace URL
+ node(sampleXMLparsed,
+ node=list("rss","channel","atom:link"),
+ what="attributes", element="href") <- "http://example.com"
+
+ # remove "rel" attribute
+ node(sampleXMLparsed,
+ node=list("rss","channel","atom:link"),
+ what="attributes", element="rel") <- NULL
+
+ expect_that(
+ sampleXMLparsed,
+ equals(sampleXMLparsed.changed))
})
test_that("change nested text value in XML node", {
- # re-create object sampleXMLparsed
- load("sample_RSS_parsed.RData")
- # re-create object sampleXMLnode.extracted
- load("sample_XML_tree_changed_value.RData")
-
- # change text
- node(sampleXMLparsed,
- node=list("rss","channel","item","title"),
- what="value",
- cond.value="Changes in koRpus version 0.04-30") <- "this value was changed!"
-
- expect_that(
- sampleXMLparsed,
- equals(sampleXMLparsed.changed.value))
+ # re-create object sampleXMLparsed
+ load("sample_RSS_parsed.RData")
+ # re-create object sampleXMLnode.extracted
+ load("sample_XML_tree_changed_value.RData")
+
+ # change text
+ node(sampleXMLparsed,
+ node=list("rss","channel","item","title"),
+ what="value",
+ cond.value="Changes in koRpus version 0.04-30") <- "this value was changed!"
+
+ expect_that(
+ sampleXMLparsed,
+ equals(sampleXMLparsed.changed.value))
})
context("getter/setter methods")
test_that("set and get XML node name", {
- sampleXMLnode <- XMLNode("name", attrs=list(atr="test"))
- # set node name
- XMLName(sampleXMLnode) <- "changed"
- sampleXMLnode.name <- XMLName(sampleXMLnode)
-
- expect_that(
- sampleXMLnode.name,
- equals("changed"))
+ sampleXMLnode <- XMLNode("name", attrs=list(atr="test"))
+ # set node name
+ XMLName(sampleXMLnode) <- "changed"
+ sampleXMLnode.name <- XMLName(sampleXMLnode)
+
+ expect_that(
+ sampleXMLnode.name,
+ equals("changed"))
})
test_that("set and get XML node attributes", {
- sampleXMLnode <- XMLNode("name", attrs=list(atr="test"))
- # set node attributes
- XMLAttrs(sampleXMLnode) <- list()
- sampleXMLnode.attrs <- XMLAttrs(sampleXMLnode)
-
- expect_that(
- sampleXMLnode.attrs,
- equals(list()))
+ sampleXMLnode <- XMLNode("name", attrs=list(atr="test"))
+ # set node attributes
+ XMLAttrs(sampleXMLnode) <- list()
+ sampleXMLnode.attrs <- XMLAttrs(sampleXMLnode)
+
+ expect_that(
+ sampleXMLnode.attrs,
+ equals(list()))
})
test_that("set and get XML node text value", {
- sampleXMLnode <- XMLNode("name", attrs=list(atr="test"))
- # set node name
- XMLValue(sampleXMLnode) <- "added value"
- sampleXMLnode.value <- XMLValue(sampleXMLnode)
-
- expect_that(
- sampleXMLnode.value,
- equals("added value"))
+ sampleXMLnode <- XMLNode("name", attrs=list(atr="test"))
+ # set node name
+ XMLValue(sampleXMLnode) <- "added value"
+ sampleXMLnode.value <- XMLValue(sampleXMLnode)
+
+ expect_that(
+ sampleXMLnode.value,
+ equals("added value"))
})
test_that("set and get XML node children", {
- sampleXMLnode <- XMLNode("name", attrs=list(atr="test"))
- # children will be returned as a list
- sampleXMLChild <- list(XMLNode("child", attrs=list(atr="test")))
- # set node children
- XMLChildren(sampleXMLnode) <- sampleXMLChild
- sampleXMLnode.children <- XMLChildren(sampleXMLnode)
-
- expect_that(
- sampleXMLnode.children,
- equals(sampleXMLChild))
+ sampleXMLnode <- XMLNode("name", attrs=list(atr="test"))
+ # children will be returned as a list
+ sampleXMLChild <- list(XMLNode("child", attrs=list(atr="test")))
+ # set node children
+ XMLChildren(sampleXMLnode) <- sampleXMLChild
+ sampleXMLnode.children <- XMLChildren(sampleXMLnode)
+
+ expect_that(
+ sampleXMLnode.children,
+ equals(sampleXMLChild))
})
test_that("set and get XML tree children", {
- load("sample_XML_tree.RData")
- # children will be returned as a list
- sampleXMLChild <- list(XMLNode("child", attrs=list(atr="test")))
- # set node children
- XMLChildren(sampleXMLTree) <- sampleXMLChild
- sampleXMLTree.children <- XMLChildren(sampleXMLTree)
-
- expect_that(
- sampleXMLTree.children,
- equals(sampleXMLChild))
+ load("sample_XML_tree.RData")
+ # children will be returned as a list
+ sampleXMLChild <- list(XMLNode("child", attrs=list(atr="test")))
+ # set node children
+ XMLChildren(sampleXMLTree) <- sampleXMLChild
+ sampleXMLTree.children <- XMLChildren(sampleXMLTree)
+
+ expect_that(
+ sampleXMLTree.children,
+ equals(sampleXMLChild))
})
test_that("set and get XML tree DTD info", {
- load("sample_XML_tree.RData")
- sampleDTD <- list(doctype="html", decl="PUBLIC",
- id="-//W3C//DTD XHTML 1.0 Transitional//EN",
- refer="http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
- # set missing values
- XMLDTD(sampleXMLTree) <- sampleDTD
- # try to get them back
- sampleXMLTree.DTD <- XMLDTD(sampleXMLTree)
-
- expect_that(
- sampleXMLTree.DTD,
- equals(sampleDTD))
+ load("sample_XML_tree.RData")
+ sampleDTD <- list(doctype="html", decl="PUBLIC",
+ id="-//W3C//DTD XHTML 1.0 Transitional//EN",
+ refer="http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
+ # set missing values
+ XMLDTD(sampleXMLTree) <- sampleDTD
+ # try to get them back
+ sampleXMLTree.DTD <- XMLDTD(sampleXMLTree)
+
+ expect_that(
+ sampleXMLTree.DTD,
+ equals(sampleDTD))
})
test_that("set and get XML tree decl info", {
- load("sample_XML_tree.RData")
- sampleDecl <- list(version="1.0", encoding="UTF-8")
- # set missing values
- XMLDecl(sampleXMLTree) <- sampleDecl
- # try to get them back
- sampleXMLTree.decl <- XMLDecl(sampleXMLTree)
-
- expect_that(
- sampleXMLTree.decl,
- equals(sampleDecl))
+ load("sample_XML_tree.RData")
+ sampleDecl <- list(version="1.0", encoding="UTF-8")
+ # set missing values
+ XMLDecl(sampleXMLTree) <- sampleDecl
+ # try to get them back
+ sampleXMLTree.decl <- XMLDecl(sampleXMLTree)
+
+ expect_that(
+ sampleXMLTree.decl,
+ equals(sampleDecl))
})
test_that("set and get XML tree file info", {
- load("sample_XML_tree.RData")
- # set missing values
- XMLFile(sampleXMLTree) <- "somefile.xml"
- # try to get them back
- sampleXMLTree.file <- XMLFile(sampleXMLTree)
-
- expect_that(
- sampleXMLTree.file,
- equals("somefile.xml"))
+ load("sample_XML_tree.RData")
+ # set missing values
+ XMLFile(sampleXMLTree) <- "somefile.xml"
+ # try to get them back
+ sampleXMLTree.file <- XMLFile(sampleXMLTree)
+
+ expect_that(
+ sampleXMLTree.file,
+ equals("somefile.xml"))
})
context("getter/setter methods: XMLScan")
test_that("scan XML tree for node names", {
- load("sample_XML_tree.RData")
+ load("sample_XML_tree.RData")
- # this should return a list of 3
- sampleXMLTree.nodes <- XMLScan(sampleXMLTree, "empty")
+ # this should return a list of 3
+ sampleXMLTree.nodes <- XMLScan(sampleXMLTree, "empty")
- expect_is(
- sampleXMLTree.nodes,
- "list")
- expect_that(
- length(sampleXMLTree.nodes),
- equals(3))
+ 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")
+ load("sample_XML_tree.RData")
+
+ # this should remove all nodes,
+ # exept the parent "tree" node
+ XMLScan(sampleXMLTree, "empty") <- NULL
- # this should remove all nodes,
- # exept the parent "tree" node
- XMLScan(sampleXMLTree, "empty") <- NULL
+ expect_identical(
+ sampleXMLTree,
+ XMLTree(XMLNode("tree")))
+})
+
+context("XML validation")
+
+test_that("define XML validation scheme", {
+ load("sample_XML_validity.RData")
+
+ # should generate an object of class XiMpLe.validity
+ # try something HTMLish
+ sample_XML_validity.generated <- XMLValidity(
+ children=list(
+ body=c("a", "p", "ol", "ul", "strong"),
+ head=c("title"),
+ html=c("head", "body"),
+ li=c("a", "br", "strong"),
+ ol=c("li"),
+ p=c("a", "br", "ol", "ul", "strong"),
+ ul=c("li")
+ ),
+ attrs=list(
+ a=c("href", "name"),
+ p=c("align")
+ ),
+ allChildren=c("!--"),
+ allAttrs=c("id", "class"),
+ empty=c("br")
+ )
+
+ expect_that(
+ sample_XML_validity.generated,
+ equals(sample_XML_validity))
+})
+
+test_that("validate XML objects: child nodes", {
+ load("sample_XML_validity.RData")
+
+ validChildNodes <- XMLNode("html",
+ XMLNode("head",
+ XMLNode("!--", "comment always passes"),
+ XMLNode("title", "test")
+ ),
+ XMLNode("!--", "comment always passes"),
+ XMLNode("body",
+ XMLNode("!--", "comment always passes"),
+ XMLNode("p",
+ XMLNode("!--", "comment always passes"),
+ XMLNode("a", "my link"),
+ XMLNode("br"),
+ "text goes on"
+ ),
+ XMLNode("p",
+ XMLNode("ol",
+ XMLNode("!--",
+ XMLNode("undefined", "should be OK because of 'graceful' default mode")
+ ),
+ XMLNode("li",
+ "firstly this"
+ ),
+ XMLNode("!--", "comment always passes"),
+ XMLNode("li",
+ "secondly this"
+ )
+ )
+ )
+ )
+ )
+ invalidChildNodes <- XMLNode("html",
+ XMLNode("head",
+ XMLNode("title",
+ XMLNode("body", "test")
+ )
+ )
+ )
+ undefinedChildNodes <- XMLNode("html",
+ XMLNode("head",
+ XMLNode("meta", "test")
+ )
+ )
+ invalidEmptyNode <- XMLNode("p",
+ XMLNode("br", "test")
+ )
+ validityResultT <- validXML(
+ validChildNodes,
+ validity=sample_XML_validity,
+ attributes=FALSE
+ )
+ # the object "validityResultF" should be available after this call
+ expect_warning(
+ validityResultF <- validXML(
+ invalidChildNodes,
+ validity=sample_XML_validity,
+ attributes=FALSE,
+ warn=TRUE
+ ),
+ regexp="Invalid XML nodes for <title> section: body"
+ )
+ expect_true(validityResultT)
+ expect_false(validityResultF)
+ expect_error(
+ validXML(
+ invalidChildNodes,
+ validity=sample_XML_validity,
+ attributes=FALSE
+ ),
+ regexp="Invalid XML nodes for <title> section: body"
+ )
+ expect_error(
+ validXML(
+ undefinedChildNodes,
+ validity=sample_XML_validity,
+ attributes=FALSE
+ ),
+ regexp="Invalid XML nodes for <head> section: meta"
+ )
+ expect_error(
+ validXML(
+ invalidEmptyNode,
+ validity=sample_XML_validity,
+ attributes=FALSE
+ ),
+ regexp="Invalid XML node <br />: Should be empty, but it isn't!"
+ )
+})
- expect_identical(
- sampleXMLTree,
- XMLTree(XMLNode("tree")))
+test_that("validate XML objects: attributes", {
+ load("sample_XML_validity.RData")
+
+ validAttributes <- XMLNode("html",
+ XMLNode("head",
+ XMLNode("title", "test", attrs=list(id="title"))
+ ),
+ XMLNode("body",
+ XMLNode("p",
+ XMLNode("a", "my link", attrs=list(href="link.html", class="underline"))
+ ),
+ XMLNode("p",
+ XMLNode("ol",
+ XMLNode("li",
+ "firstly this"
+ ),
+ XMLNode("li",
+ "secondly this",
+ attrs=list(id="li2")
+ )
+ ),
+ attrs=list(class="ordered")
+ ),
+ attrs=list(id="body")
+ )
+ )
+ invalidAttributes <- XMLNode("html",
+ XMLNode("head",
+ XMLNode("title", "test", attrs=list(href="title.html"))
+ )
+ )
+ undefinedAttributes <- XMLNode("body",
+ XMLNode("p",
+ XMLNode("strong", "test"),
+ attrs=list(style="text-align: right;")
+ )
+ )
+ validityResultT <- validXML(
+ validAttributes,
+ validity=sample_XML_validity,
+ children=FALSE
+ )
+ # the object "validityResultF" should be available after this call
+ expect_warning(
+ validityResultF <- validXML(
+ invalidAttributes,
+ validity=sample_XML_validity,
+ children=FALSE,
+ warn=TRUE
+ ),
+ regexp="Invalid XML attributes for <title> node: href"
+ )
+ expect_true(validityResultT)
+ expect_false(validityResultF)
+ expect_error(
+ validXML(
+ invalidAttributes,
+ validity=sample_XML_validity,
+ children=FALSE
+ ),
+ regexp="Invalid XML attributes for <title> node: href"
+ )
+ expect_error(
+ validXML(
+ undefinedAttributes,
+ validity=sample_XML_validity,
+ children=FALSE
+ ),
+ regexp="Invalid XML attributes for <p> node: style"
+ )
})
More information about the rkward-tracker
mailing list