[rkward-cvs] SF.net SVN: rkward:[4414] trunk/rkward/packages/XiMpLe

m-eik at users.sourceforge.net m-eik at users.sourceforge.net
Tue Nov 6 17:09:09 UTC 2012


Revision: 4414
          http://rkward.svn.sourceforge.net/rkward/?rev=4414&view=rev
Author:   m-eik
Date:     2012-11-06 17:09:09 +0000 (Tue, 06 Nov 2012)
Log Message:
-----------
XiMpLe: further fixes and new tests regarding node() and node()<-

Modified Paths:
--------------
    trunk/rkward/packages/XiMpLe/ChangeLog
    trunk/rkward/packages/XiMpLe/R/node.R
    trunk/rkward/packages/XiMpLe/inst/doc/XiMpLe_vignette.Rnw
    trunk/rkward/packages/XiMpLe/inst/tests/tests.R

Added Paths:
-----------
    trunk/rkward/packages/XiMpLe/inst/tests/sample_XML_tree_changed.RData
    trunk/rkward/packages/XiMpLe/inst/tests/sample_XML_tree_changed_value.RData

Modified: trunk/rkward/packages/XiMpLe/ChangeLog
===================================================================
--- trunk/rkward/packages/XiMpLe/ChangeLog	2012-11-06 12:52:05 UTC (rev 4413)
+++ trunk/rkward/packages/XiMpLe/ChangeLog	2012-11-06 17:09:09 UTC (rev 4414)
@@ -4,6 +4,7 @@
 added:
   - added examples to all functions
   - added a vignette
+  - additional tests for node()<-
 fixed:
   - fixed dropping of last tag/text value if XML was incomplete, e.g., just
     an excerpt of a full tree
@@ -11,6 +12,12 @@
     instead of "<br />"
   - parsing error for DOCTYPE nodes mixed up elements and previously ignored
     the "decl" value
+  - node()<- now replaces both text values and pseudo tags with a new value.
+    this can still be problematic for child nodes which contain a mix of
+    pseudo and actual tags, so a warning will be given until this is resolved
+changed:
+  - node() now reports text values of nodes which have "value" and a pseudo
+    tag at the same time as one character string, like pasteXML does
 
 changes in version 0.03-15 (2012-10-26)
 fixed:

Modified: trunk/rkward/packages/XiMpLe/R/node.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/node.R	2012-11-06 12:52:05 UTC (rev 4413)
+++ trunk/rkward/packages/XiMpLe/R/node.R	2012-11-06 17:09:09 UTC (rev 4414)
@@ -129,7 +129,7 @@
 					if(identical(what, "value")){
 						for (this.child in slot(this.node, "children")){
 								if(identical(slot(this.child, "name"), "") & isTRUE(nchar(slot(this.child, "value")) > 0))
-									results <- c(results, slot(this.child, "value"))
+									results <- paste(slot(this.child, "value"), results, sep=" ")
 							}
 					} else {}
 					if(!is.null(element)){
@@ -179,7 +179,37 @@
 	} else {}
 	for (this.node in obj.paths){
 		if(!is.null(what)){
-			this.node <- paste(this.node, "@", what, sep="")
+			# special case: text values can either be directly in the value slot of a node,
+			# or in a pseudo tag as a child node, so we check both and remove all
+			if(identical(what, "value")){
+				eval(parse(text=paste(this.node, "@value <- character()", sep="")))
+				all.node.children <- slot(eval(parse(text=this.node)), "children")
+				child.is.value <- sapply(all.node.children, function(this.child){
+						if(identical(slot(this.child, "name"), "") & isTRUE(nchar(slot(this.child, "value")) > 0)){
+							return(TRUE)
+						} else {
+							return(FALSE)
+						}
+					})
+				# if we have a mix of pseudo and actual tags, we probably messed up the markup
+				if(length(all.node.children) != length(child.is.value)){
+					warning("a child node contained text values and other nodes, we probably messed up the markup!")
+				} else {}
+				remove.nodes <- paste(this.node, "@children[child.is.value] <- NULL", sep="")
+				eval(parse(text=remove.nodes))
+
+				# paste new value into a single pseudo node
+				pseudo.node <- paste(this.node, "@children <- append(", this.node, "@children, ",
+					"new(\"XiMpLe.node\", name=\"\", value=\"", value, "\"), after=0)",
+					sep="")
+				eval(parse(text=pseudo.node))
+
+				# now return the object
+				return(obj)
+			} else {
+				this.node <- paste(this.node, "@", what, sep="")
+			}
+
 			if(!is.null(element)){
 				this.node <- paste(this.node, "[[\"",element,"\"]]", sep="")
 			} else {}

Modified: trunk/rkward/packages/XiMpLe/inst/doc/XiMpLe_vignette.Rnw
===================================================================
--- trunk/rkward/packages/XiMpLe/inst/doc/XiMpLe_vignette.Rnw	2012-11-06 12:52:05 UTC (rev 4413)
+++ trunk/rkward/packages/XiMpLe/inst/doc/XiMpLe_vignette.Rnw	2012-11-06 17:09:09 UTC (rev 4414)
@@ -237,9 +237,9 @@
 \begin{Schunk}
 	\begin{Sinput}
 > node(sample.XML.tree, node=list("html","body","a"),
-+ what="attributes")$href <- "http://example.com/foobar"
++ what="attributes", element="href") <- "http://example.com/foobar"
 > node(sample.XML.tree, node=list("html","body","a"),
-+ what="attributes")$target <- NULL
++ what="attributes", element="target") <- NULL
 > sample.XML.tree
 	\end{Sinput}
 	\begin{Soutput}

Added: trunk/rkward/packages/XiMpLe/inst/tests/sample_XML_tree_changed.RData
===================================================================
(Binary files differ)


Property changes on: trunk/rkward/packages/XiMpLe/inst/tests/sample_XML_tree_changed.RData
___________________________________________________________________
Added: svn:mime-type
   + application/octet-stream

Added: trunk/rkward/packages/XiMpLe/inst/tests/sample_XML_tree_changed_value.RData
===================================================================
(Binary files differ)


Property changes on: trunk/rkward/packages/XiMpLe/inst/tests/sample_XML_tree_changed_value.RData
___________________________________________________________________
Added: svn:mime-type
   + application/octet-stream

Modified: trunk/rkward/packages/XiMpLe/inst/tests/tests.R
===================================================================
--- trunk/rkward/packages/XiMpLe/inst/tests/tests.R	2012-11-06 12:52:05 UTC (rev 4413)
+++ trunk/rkward/packages/XiMpLe/inst/tests/tests.R	2012-11-06 17:09:09 UTC (rev 4414)
@@ -63,6 +63,9 @@
  		equals(sampleXMLparsed))
 })
 
+
+context("extracting nodes")
+
 test_that("extract node from parsed XML tree", {
 	# re-create object sampleXMLparsed
 	load("sample_RSS_parsed.RData")
@@ -75,3 +78,44 @@
 		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))
+})
+
+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))
+})

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.





More information about the rkward-tracker mailing list