Commit d5f5a284 authored by m.eik michalke's avatar m.eik michalke
Browse files

began working on validity checks for XML objects

  - doesn't work at all yet
  - valid.child() is borrowed from rkwarddev
  - planning to add a new class to define validity checks
parent 653c3e35
......@@ -3,6 +3,8 @@ 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)
changes in version 0.03-23 (2015-11-24)
changed:
......
# Copyright 2015 Meik Michalke <meik.michalke@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.
#'
#' @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}.
## TODO: validity class objects
#' @param validity A list with validity information.
#' @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 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.
#' @node.names
#' @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:XiMpLe.doc-class]{XiMpLe.doc}}
#' \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, parent=NULL, warn=FALSE, section=parent){standardGeneric("validXML")})
#' @rdname validXML
#' @export
setMethod("validXML", signature(obj="XiMpLe.XML"), function(obj, validity, parent=NULL, warn=FALSE, section=parent){
# see if we're checking the parent node or child node for a given parent
if(is.null(parent)){
parentName <- XMLName(obj)
} else if(is.XiMpLe.node(parent)){
parentName <- XMLName(parent)
} else if(is.character(parent) & length(parent) == 1){
parentName <- parent
} else {
stop(simpleError("'parent' must be a XiMpLe node or single character string!"))
}
## more checks
## call internal when ready valid.child()
})
......@@ -556,3 +556,49 @@ 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
# - 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
valid.child <- function(parent, children, warn=FALSE, section=parent, node.names=NULL){
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 this is a plot options object, by default extract the XML slot
# and discard the rest
this.child <- stripXML(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, " section, must be of class XiMpLe.node, but got class ", class(this.child), "!")))
}
}))
} else {}
invalid.sets <- !node.names %in% all.valid.children[[parent]]
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)
return(FALSE)
} else {
stop(simpleError(return.message))
}
} else {
return(TRUE)
}
} ## end function valid.child()
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment