xml2/0000755000175100001440000000000013034142145011147 5ustar hornikusersxml2/inst/0000755000175100001440000000000013024532225012125 5ustar hornikusersxml2/inst/extdata/0000755000175100001440000000000013024532225013557 5ustar hornikusersxml2/inst/extdata/order-schema.xml0000644000175100001440000000461613024532225016661 0ustar hornikusers Purchase order schema for Example.com. Copyright 2000 Example.com. All rights reserved. Purchase order schema for Example.Microsoft.com. Copyright 2001 Example.Microsoft.com. All rights reserved. Application info. xml2/inst/extdata/r-project.html0000644000175100001440000001160112616426337016365 0ustar hornikusers R: The R Project for Statistical Computing

The R Project for Statistical Computing

Getting Started

R is a free software environment for statistical computing and graphics. It compiles and runs on a wide variety of UNIX platforms, Windows and MacOS. To download R, please choose your preferred CRAN mirror.

If you have questions about R like how to download and install the software, or what the license terms are, please read our answers to frequently asked questions before you send an email.

News

  • R 3.2.0 (Full of Ingredients) prerelease versions will appear starting March 19. Final release is scheduled for 2015-04-16.

  • R version 3.1.3 (Smooth Sidewalk) has been released on 2015-03-09.

  • The R Journal Volume 6/2 is available.

  • R version 3.1.2 (Pumpkin Helmet) has been released on 2014-10-31.

  • useR! 2015, will take place at the University of Aalborg, Denmark, June 30 - July 3, 2015.

  • useR! 2014, took place at the University of California, Los Angeles, USA June 30 - July 3, 2014.

© The R Foundation.
xml2/inst/extdata/order-doc.xml0000644000175100001440000000200013024532225016147 0ustar hornikusers Alice Smith 123 Maple Street Mill Valley CA 90952 Robert Smith 8 Oak Avenue Old Town PA 95819 Hurry, my lawn is going wild! Lawnmower 1 148.95 Confirm this is electric Baby Monitor 1 39.98 1999-05-21 xml2/inst/doc/0000755000175100001440000000000013033722447012701 5ustar hornikusersxml2/inst/doc/modification.html0000644000175100001440000005541013033722447016241 0ustar hornikusers Node Modification

Node Modification

Jim Hester

2017-01-06

Modifying Existing XML

Modifying existing XML can be done in xml2 by using the replacement functions of the accessors. They all have methods for both individual xml_node objects as well as xml_nodeset objects. If a vector of values is provided it is applied piecewise over the nodeset, otherwise the value is recycled.

Text Modification

Text modification only happens on text nodes. If a given node has more than one text node only the first will be affected. If you want to modify additional text nodes you need to select them explicitly with /text().

x <- read_xml("<p>This is some <b>text</b>. This is more.</p>")
xml_text(x)
#> [1] "This is some text. This is more."

xml_text(x) <- "This is some other text."
xml_text(x)
#> [1] "This is some other text.text. This is more."

# You can avoid this by explicitly selecting the text node.
x <- read_xml("<p>This is some text. This is <b>bold!</b></p>")
text_only <- xml_find_all(x, "//text()")

xml_text(text_only) <- c("This is some other text. ", "Still bold!")
xml_text(x)
#> [1] "This is some other text. Still bold!"
xml_structure(x)
#> <p>
#>   {text}
#>   <b>
#>     {text}

Attribute and Namespace Definition Modification

Attributes and namespace definitions are modified one at a time with xml_attr() or all at once with xml_attrs(). In both cases using NULL as the value will remove the attribute completely.

x <- read_xml("<a href='invalid!'>xml2</a>")
xml_attr(x, "href")
#> [1] "invalid!"

xml_attr(x, "href") <- "https://github.com/hadley/xml2"
xml_attr(x, "href")
#> [1] "https://github.com/hadley/xml2"

xml_attrs(x) <- c(id = "xml2", href = "https://github.com/hadley/xml2")
xml_attrs(x)
#>                             href                               id 
#> "https://github.com/hadley/xml2"                           "xml2"
x
#> {xml_document}
#> <a href="https://github.com/hadley/xml2" id="xml2">

xml_attrs(x) <- NULL
x
#> {xml_document}
#> <a>

# Namespaces are added with as a xmlns or xmlns:prefix attribute
xml_attr(x, "xmlns") <- "http://foo"
x
#> {xml_document}
#> <a xmlns="http://foo">

xml_attr(x, "xmlns:bar") <- "http://bar"
x
#> {xml_document}
#> <a xmlns="http://foo" xmlns:bar="http://bar">

Name Modification

Node names are modified with xml_name().

x <- read_xml("<a><b/></a>")
x
#> {xml_document}
#> <a>
#> [1] <b/>
xml_name(x)
#> [1] "a"
xml_name(x) <- "c"
x
#> {xml_document}
#> <c>
#> [1] <b/>

Node modification

All of these functions have a .copy argument. If this is set to FALSE they will remove the new node from its location before inserting it into the new location. Otherwise they make a copy of the node before insertion.

Replacing existing nodes

x <- read_xml("<parent><child>1</child><child>2<child>3</child></child></parent>")
children <- xml_children(x)
t1 <- children[[1]]
t2 <- children[[2]]
t3 <- xml_children(children[[2]])[[1]]

xml_replace(t1, t3)
#> {xml_node}
#> <child>
x
#> {xml_document}
#> <parent>
#> [1] <child>3</child>
#> [2] <child>2<child>3</child></child>

Add a sibling

x <- read_xml("<parent><child>1</child><child>2<child>3</child></child></parent>")
children <- xml_children(x)
t1 <- children[[1]]
t2 <- children[[2]]
t3 <- xml_children(children[[2]])[[1]]

xml_add_sibling(t1, t3)
x
#> {xml_document}
#> <parent>
#> [1] <child>1</child>
#> [2] <child>3</child>
#> [3] <child>2<child>3</child></child>

xml_add_sibling(t3, t1, where = "before")
x
#> {xml_document}
#> <parent>
#> [1] <child>1</child>
#> [2] <child>3</child>
#> [3] <child>2<child>3</child><child>1</child></child>

Add a child

x <- read_xml("<parent><child>1</child><child>2<child>3</child></child></parent>")
children <- xml_children(x)
t1 <- children[[1]]
t2 <- children[[2]]
t3 <- xml_children(children[[2]])[[1]]

xml_add_child(t1, t3)
x
#> {xml_document}
#> <parent>
#> [1] <child>1<child>3</child></child>
#> [2] <child>2<child>3</child></child>

xml_add_child(t1, read_xml("<test/>"))
x
#> {xml_document}
#> <parent>
#> [1] <child>1<child>3</child><test/></child>
#> [2] <child>2<child>3</child></child>

Removing nodes

The xml_remove() can be used to remove a node (and it’s children) from a tree. The default behavior is to unlink the node from the tree, but does not free the memory for the node, so R objects pointing to the node are still valid.

This allows code like the following to work without crashing R

x <- read_xml("<foo><bar><baz/><bar></foo>")
x1 <- x %>% xml_children() %>% .[[1]]
x2 <- x1 %>% xml_children() %>% .[[1]]

xml_remove(x1)
rm(x1)
gc()

x2

If you are not planning on referencing these nodes again this memory is wasted. Calling xml_remove(free = TRUE) will remove the nodes and free the memory used to store them. Note In this case any node which previously pointed to the node or it’s children will instead be pointing to free memory and may cause R to crash. xml2 can’t figure this out for you, so it’s your responsibility to remove any objects which are no longer valid.

In particular xml_find_*() results are easy to overlook, for example

x <- read_xml("<a><b /><b><b /></b></a>")
bees <- xml_find_all(x, "//b")
xml_remove(xml_child(x), free = TRUE)
# bees[[1]] is no longer valid!!!
rm(bees)

Namespaces

We want to construct a document with the following namespace layout. (From http://stackoverflow.com/questions/32939229/creating-xml-in-r-with-namespaces/32941524#32941524).

<?xml version = "1.0" encoding="UTF-8"?>
<sld xmlns="http://www.o.net/sld"
     xmlns:ogc="http://www.o.net/ogc"
     xmlns:se="http://www.o.net/se"
     version="1.1.0" >
<layer>
<se:Name>My Layer</se:Name>
</layer>
</sld>
library(magrittr)
d <- xml_new_root("sld",
    xmlns = "http://www.o.net/sld",
    "xmlns:ogc" = "http://www.o.net/ogc",
    "xmlns:se" = "http://www.o.net/se",
    version = "1.1.0") %>%
  xml_add_child("layer") %>%
  xml_add_child("se:Name", "My Layer") %>%
  xml_root()

d
#> {xml_document}
#> <sld version="1.1.0" xmlns="http://www.o.net/sld" xmlns:ogc="http://www.o.net/ogc" xmlns:se="http://www.o.net/se">
#> [1] <layer>\n  <se:Name>My Layer</se:Name>\n</layer>
xml2/inst/doc/modification.R0000644000175100001440000000477413033722447015505 0ustar hornikusers## ---- echo = FALSE, message = FALSE-------------------------------------- knitr::opts_chunk$set(collapse = TRUE, comment = "#>") library(xml2) ## ------------------------------------------------------------------------ x <- read_xml("

This is some text. This is more.

") xml_text(x) xml_text(x) <- "This is some other text." xml_text(x) # You can avoid this by explicitly selecting the text node. x <- read_xml("

This is some text. This is bold!

") text_only <- xml_find_all(x, "//text()") xml_text(text_only) <- c("This is some other text. ", "Still bold!") xml_text(x) xml_structure(x) ## ------------------------------------------------------------------------ x <- read_xml("xml2") xml_attr(x, "href") xml_attr(x, "href") <- "https://github.com/hadley/xml2" xml_attr(x, "href") xml_attrs(x) <- c(id = "xml2", href = "https://github.com/hadley/xml2") xml_attrs(x) x xml_attrs(x) <- NULL x # Namespaces are added with as a xmlns or xmlns:prefix attribute xml_attr(x, "xmlns") <- "http://foo" x xml_attr(x, "xmlns:bar") <- "http://bar" x ## ------------------------------------------------------------------------ x <- read_xml("") x xml_name(x) xml_name(x) <- "c" x ## ------------------------------------------------------------------------ x <- read_xml("123") children <- xml_children(x) t1 <- children[[1]] t2 <- children[[2]] t3 <- xml_children(children[[2]])[[1]] xml_replace(t1, t3) x ## ------------------------------------------------------------------------ x <- read_xml("123") children <- xml_children(x) t1 <- children[[1]] t2 <- children[[2]] t3 <- xml_children(children[[2]])[[1]] xml_add_sibling(t1, t3) x xml_add_sibling(t3, t1, where = "before") x ## ------------------------------------------------------------------------ x <- read_xml("123") children <- xml_children(x) t1 <- children[[1]] t2 <- children[[2]] t3 <- xml_children(children[[2]])[[1]] xml_add_child(t1, t3) x xml_add_child(t1, read_xml("")) x ## ------------------------------------------------------------------------ library(magrittr) d <- xml_new_root("sld", xmlns = "http://www.o.net/sld", "xmlns:ogc" = "http://www.o.net/ogc", "xmlns:se" = "http://www.o.net/se", version = "1.1.0") %>% xml_add_child("layer") %>% xml_add_child("se:Name", "My Layer") %>% xml_root() d xml2/inst/doc/modification.Rmd0000644000175100001440000001175013025003773016011 0ustar hornikusers--- title: "Node Modification" author: "Jim Hester" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Node Modification} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, echo = FALSE, message = FALSE} knitr::opts_chunk$set(collapse = TRUE, comment = "#>") library(xml2) ``` # Modifying Existing XML Modifying existing XML can be done in xml2 by using the replacement functions of the accessors. They all have methods for both individual `xml_node` objects as well as `xml_nodeset` objects. If a vector of values is provided it is applied piecewise over the nodeset, otherwise the value is recycled. ## Text Modification ## Text modification only happens on text nodes. If a given node has more than one text node only the first will be affected. If you want to modify additional text nodes you need to select them explicitly with `/text()`. ```{r} x <- read_xml("

This is some text. This is more.

") xml_text(x) xml_text(x) <- "This is some other text." xml_text(x) # You can avoid this by explicitly selecting the text node. x <- read_xml("

This is some text. This is bold!

") text_only <- xml_find_all(x, "//text()") xml_text(text_only) <- c("This is some other text. ", "Still bold!") xml_text(x) xml_structure(x) ``` ## Attribute and Namespace Definition Modification ## Attributes and namespace definitions are modified one at a time with `xml_attr()` or all at once with `xml_attrs()`. In both cases using `NULL` as the value will remove the attribute completely. ```{r} x <- read_xml("xml2") xml_attr(x, "href") xml_attr(x, "href") <- "https://github.com/hadley/xml2" xml_attr(x, "href") xml_attrs(x) <- c(id = "xml2", href = "https://github.com/hadley/xml2") xml_attrs(x) x xml_attrs(x) <- NULL x # Namespaces are added with as a xmlns or xmlns:prefix attribute xml_attr(x, "xmlns") <- "http://foo" x xml_attr(x, "xmlns:bar") <- "http://bar" x ``` ## Name Modification ## Node names are modified with `xml_name()`. ```{r} x <- read_xml("") x xml_name(x) xml_name(x) <- "c" x ``` # Node modification # All of these functions have a `.copy` argument. If this is set to `FALSE` they will remove the new node from its location before inserting it into the new location. Otherwise they make a copy of the node before insertion. ## Replacing existing nodes ## ```{r} x <- read_xml("123") children <- xml_children(x) t1 <- children[[1]] t2 <- children[[2]] t3 <- xml_children(children[[2]])[[1]] xml_replace(t1, t3) x ``` ## Add a sibling ## ```{r} x <- read_xml("123") children <- xml_children(x) t1 <- children[[1]] t2 <- children[[2]] t3 <- xml_children(children[[2]])[[1]] xml_add_sibling(t1, t3) x xml_add_sibling(t3, t1, where = "before") x ``` ## Add a child ## ```{r} x <- read_xml("123") children <- xml_children(x) t1 <- children[[1]] t2 <- children[[2]] t3 <- xml_children(children[[2]])[[1]] xml_add_child(t1, t3) x xml_add_child(t1, read_xml("")) x ``` ## Removing nodes ## The `xml_remove()` can be used to remove a node (and it's children) from a tree. The default behavior is to unlink the node from the tree, but does _not_ free the memory for the node, so R objects pointing to the node are still valid. This allows code like the following to work without crashing R ```r x <- read_xml("") x1 <- x %>% xml_children() %>% .[[1]] x2 <- x1 %>% xml_children() %>% .[[1]] xml_remove(x1) rm(x1) gc() x2 ``` If you are not planning on referencing these nodes again this memory is wasted. Calling `xml_remove(free = TRUE)` will remove the nodes _and_ free the memory used to store them. **Note** In this case _any_ node which previously pointed to the node or it's children will instead be pointing to free memory and may cause R to crash. xml2 can't figure this out for you, so it's your responsibility to remove any objects which are no longer valid. In particular `xml_find_*()` results are easy to overlook, for example ```r x <- read_xml("") bees <- xml_find_all(x, "//b") xml_remove(xml_child(x), free = TRUE) # bees[[1]] is no longer valid!!! rm(bees) ``` ## Namespaces ## We want to construct a document with the following namespace layout. (From http://stackoverflow.com/questions/32939229/creating-xml-in-r-with-namespaces/32941524#32941524). ```xml My Layer ``` ```{r} library(magrittr) d <- xml_new_root("sld", xmlns = "http://www.o.net/sld", "xmlns:ogc" = "http://www.o.net/ogc", "xmlns:se" = "http://www.o.net/se", version = "1.1.0") %>% xml_add_child("layer") %>% xml_add_child("se:Name", "My Layer") %>% xml_root() d ``` xml2/inst/include/0000755000175100001440000000000013024532225013550 5ustar hornikusersxml2/inst/include/xml2_types.h0000644000175100001440000000066513024532225016036 0ustar hornikusers#ifndef __XML2_XML2_TYPES__ #define __XML2_XML2_TYPES__ #include #include inline void finaliseNode(xmlNodePtr node) { // do nothing } inline void finaliseNs(xmlNsPtr ns) { // do nothing } typedef Rcpp::XPtr XPtrDoc; typedef Rcpp::XPtr XPtrNode; typedef Rcpp::XPtr XPtrNs; #endif xml2/tests/0000755000175100001440000000000013033461071012312 5ustar hornikusersxml2/tests/testthat.R0000644000175100001440000000006412710744614014305 0ustar hornikuserslibrary(testthat) library(xml2) test_check("xml2") xml2/tests/testthat/0000755000175100001440000000000013034142145014151 5ustar hornikusersxml2/tests/testthat/helper-version.R0000644000175100001440000000007712616426337017257 0ustar hornikuserscat("This is libxml2 version", xml2:::libxml2_version(), "\n") xml2/tests/testthat/test-url.R0000644000175100001440000000424112723346740016067 0ustar hornikuserscontext("url") test_that("url_absolute", { expect_equal( url_absolute(c(".", "..", "/", "/x"), "http://hadley.nz/a/b/c/d"), c("http://hadley.nz/a/b/c/", "http://hadley.nz/a/b/", "http://hadley.nz/", "http://hadley.nz/x")) expect_error(url_absolute(c(".", "..", "/", "/x"), c("http://hadley.nz/a/b/c/d", "http://foo.bar")), "Base URL must be length 1") }) test_that("url_relative", { expect_equal( url_relative("http://hadley.nz/a/c", "http://hadley.nz"), "/a/c") expect_equal( url_relative("http://hadley.nz/a/c", "http://hadley.nz/"), "../a/c") expect_equal( url_relative("http://hadley.nz/a/c", "http://hadley.nz/a/b"), "c") expect_equal( url_relative("http://hadley.nz/a/c", "http://hadley.nz/a/b/"), "../c") expect_error(url_relative("http://hadley.nz/a/c", c("http://hadley.nz/a/b/c/d", "http://foo.bar")), "Base URL must be length 1") }) test_that("url_parse", { expect_equal( url_parse("http://had.co.nz/"), data.frame(scheme = "http", server = "had.co.nz", port = NA_integer_, user = "", path = "/", query = "", fragment = "", stringsAsFactors = FALSE)) expect_equal( url_parse("http://had.co.nz:1234/"), data.frame(scheme = "http", server = "had.co.nz", port = 1234L, user = "", path = "/", query = "", fragment = "", stringsAsFactors = FALSE)) expect_equal( url_parse("http://had.co.nz:1234/?a=1&b=2"), data.frame(scheme = "http", server = "had.co.nz", port = 1234L, user = "", path = "/", query = "a=1&b=2", fragment = "", stringsAsFactors = FALSE)) expect_equal( url_parse("http://had.co.nz:1234/?a=1&b=2#def"), data.frame(scheme = "http", server = "had.co.nz", port = 1234L, user = "", path = "/", query = "a=1&b=2", fragment = "def", stringsAsFactors = FALSE)) }) test_that("url_escape", { expect_error(url_escape("a b c", reserved = c("a", "b")), "`reserved` must be character vector of length 1") expect_equal( url_escape("a b c"), "a%20b%20c") expect_equal( url_escape("a b c", " "), "a b c") expect_equal( url_unescape("a%20b%2fc"), "a b/c") expect_equal( url_unescape("%C2%B5"), "\u00B5") }) xml2/tests/testthat/test-xml_serialize.R0000644000175100001440000000154513027237347020140 0ustar hornikuserscontext("xml_serialize") x <- read_xml(" 123 456 ") test_that("xml_serialize and xml_unserialize work with xml_document input", { out <- xml_unserialize(xml_serialize(x, NULL)) expect_identical(as.character(x), as.character(out)) }) test_that("xml_serialize and xml_unserialize work with xml_node input", { b <- xml_find_first(x, "//b") out <- xml_unserialize(xml_serialize(b, NULL)) expect_identical(as.character(b), as.character(out)) }) test_that("xml_serialize and xml_unserialize work with xml_nodeset input", { b <- xml_find_all(x, "//b") out <- xml_unserialize(xml_serialize(b, NULL)) expect_identical(as.character(b), as.character(out)) }) test_that("xml_unserialize throws an error if given a invalid object", { expect_error(xml_unserialize(serialize(1, NULL)), "Not a serialized xml2 object") }) xml2/tests/testthat/lego.html.bz20000644000175100001440000012323112616426337016500 0ustar hornikusersBZh91AY&SY~7u@@`ymۚ[cEFϽk继hyn rttu [lO(}z:}MʋX^ Z;}7޾޶kΩwoSn.i@zaxnŌjX;mͽwۺ>}j:wvvî*VGUsIK޾u_M 6ק|W};n;u5mlzݵwcr{o9rz۽}<G]SRo]er-{ݺgvͽwzz羺.Vu={ͻU}w{7n=k>9Wݻ۝^ޕNon9mgt=7Qk[\,/M;ת{}4ոy}fq^:gZ};}i=d}/v d@e4G4@&@& 44hBi6Q@ 40<'4c"M#4i&j4hd&B & 4hjzI=OI鉩 @$Dm&M5=SɣFM4ST&hDM hi !%=O)=M445x EQ j?*X#/H ( ̇`B;Jp? K1O8MĀ d*~@*a5Xq55m6eo& l(:ROSB&;0쭄tAME6L{٤5ڐ"X]N/PII}w[kQ 41Ь1(j9!O P7J0 24,:Bk.` Yzl2 D1r.(A=ЗlL}-Z˕MNDL j @(uk˱3SX1ZH1Ciƌl b@;Hw31k8ȲE+mffcid03ޗiQN 2 9_o_X"reE" ?ɻdb$(_X% WYj[DȕiX,•h@_ f>~J iJ + ͸1%0ԁqXjCȶTƚBy`"8S/@@ ֕"e0`((MM&BhNb$Hn12R IBF6*w@Mb^$đPTFRaqT/gH ~@2IdAQ5T" GBKlRB"0uaXUE @IdE"BsR@*Z{%A`!BESyƚ|&j1AUL;"%CxdBhaą..)[1 n?]g?cMa-@z){F4g~!L=Z/tE·7Na$ bgy9<9 \7&<1stqM*B1cEF*DVH"YNu'"_fa8>,Gc՞#^#'k;w[|( a>35+;%޹ɬ U'9%q`xr5o= F=dT@PjVY -L/٦'CCC1W]Ozfq>D.6xfɹ^'肜(pGwP!hN :}!|T5U~ps"u~|M#aw0A3EE*Y 1ߨsbi{sgr,]qLxiD=-o©՜)Ӽ³u>R#٩Ǐf8csZgpZڳ lʣ[JosfrBQp7Fjlcr9q#_[靃d!'^~o/{u%nU:&GAhD!'],.{-7-4^G@:v=Fy/&CeɊeNMJ aϫe*+El0bM= ykUbaT Ik#|ś0*rgmT@+3{ܻ3&zK Z5m$ٸLJ4d{܃Wo cYklvs/΁5Y v;G\ۙŚ/G 7 r26=5̝>Ee\ZK:i;\,sR↮Z!jbOL{rn n /Ui|rɝP;52BJx,ؠ1BJl"'#CH$8B\F f "]Jƛ,vu(AD qG\F A@&ɳd$2BTI ! vǬT?b[*zVJ;ԗZdöjb@F$ZlEXwm TǚꟖ< -F.V3oT3zv!cS5F;{u}-ܻ*vݲE<=ȅ!. "Qh 3n z7B@sStǩT rn@h4_2h&h޸Ӱl+> 'lB=>i9=U!-S\(EY5ĝ*bM\1؏#ffը~1-l+TtI =<;ngn`j\/ִҴ3QV#;_P+ޢ6oHW8 3q"0 Ea|mcѧ`:n:Vbt CT@ ZD^(2yd6LsH*Vi ~`*+rJ_<[bڷ$F$1{>S]֮^^z .i,lu<4ڜG3TJE<JЙ}oWa2iTMW3SH:3=MD &xߛEݻ@hzp3#i_J67fr шwsp@P]G=㝊%=vr[4 <ی:{ۍpP 7{)ަkp_]NOg>|3k3x4vNJknKDavVE0\I<15!*o5۝cNV9/_K(m.:o ɴvzVS5=Ejtu| };̈́6/|f83|z\rErx Xqcԅ7c>|NQ%oGt2f8cW [K0#;33e6~Zd*2$s,? hS~!הюD1ct-N[3%U<28ru~y~pYq@2Q ̴j]mFC=mVw]c1 u߿{2/Q܍%?/Gh(;?`$Yy|jX~^s3ׇ|OQ=P;>-[Jv<㻎;yS7< v$3.TQ;4!Md* !s<\e ` 9#1ԔKB"{a| ^!p0;7pn`IaΣL٫|[rlb4]{!iA"Nwi7M[6As)g磋_z'E{_%Xn\PdY (%Ye6"HRZte‹B_\s Sے b)zR@TݤRc|'ɼ.|d{N˭X4P{C#6M&f+8uW%+GyyT32fLJNG޷E(6"JHl5`A$ rfUuTmkU r&g_.nWvbbmps2 %-HҪV"(d>/x2ol%$7w>YB]0StDডq#Ha7/dtj! *߷b ]ź) apQ4mP *p*7΍6J4 jUMe冞'/MB:Xjıw7sm?dqęLp=6@G鈵6Pm>;zp5a Ir'ʋ4@2J@ K#PCX#\ X 3 Nځ6BB Ba&" 4 1 ^=`K!WfBJa)""VHP"B! $c7Hi% (IA8vWc]9~&b&lwbn{m)h T q-KơPRk pBWp [ʽu5ux( n^|.sH^(6{'[{9wHa`Y\͟_l_ڮ hSx@zq˷]slgbW:ўvPcCfӓef MeM]]'$jOM(y&=#;} &m 7AQ^38 FsZSܛ lAXҺBnscVy~gB t9!"ImM["ş66 1 ;;۞-2Opta/H.y.J2NYb3u K$%-KQ`;]C6`nY<(ow2 V{Rqg\wϥ>V1Xޠt&hgS/.)_U,Cn{兕s3!ÙhЉԮP:1 uF2ALIocr ۻKy^ fV4uqY|so+[%5-uI'oq&wqgJ$| 6&/F_]X|y>߻XLBQcl9ǧLā=\ "͜ߥeg:awbKGݽ! AwR C?.}4V&Ik(qa]pGwLr"0=6 0mV_0z>ܳމ32DU踣'4n7ms&9y3فx n8͈ONNBb'ߌw}=8ah<|/}*B>P`ـ-p>?M;t:ݯ$=xKtoKe ?HTȚ hbM b<|}ym^3+9ƍ㘦PՇ!Lo1B.8~:!<EH'RV I,+Ec+t't`_X:9b9FNlkR1h-#3O& meg 5d3e5MmY 3xE3AUM3oyf$ 8>uHdJ+%(@d9 1a{~bfjUbLP@XudyGemc3 ֙ 3ZAuR kECErk\F_#`qw~G+J{Dzx8u](UG81<|P @m(VVµ~ȝc86`qQӽF%d|a~",yiI0 [\}z {k yIXC:K1g 19ma֮V/.F/4H$ sW?|AXGP1N-y>q( cYc)O3Npa jH-Ԣ<_um)I DWiIVlOa.#:$qAd&E e3B*|t&@qf–,)J _y$dX4#//z|"!V y60t(DeF -h 4rBp1SD #Fu \+}Ԇ|:q7 XGx(S BY5sJP&kNB{eh&`<$L^}~?*$9Ɗi; Z(R'j%eHVO:]׷ S q qMo.wu@k a0p,CTA*@xN3tk؁:vп]dՁ`Hacxv!$5 hK!_wp(GML%ߖl& {{ c!GSd& 殣 @~س 39CaMu4Dbu<#욚wzKɧ6S0g s)@?ѝG`*>|Btv:׳䞲O;-*92nVh$ڮ@ǖ?Dj@(#жwS9/%x55vgnAw}Js+vs\P d&v",ƚW rs_WzP?RD DFC~ͦ6a fWc",!`[q$Ad0"d\‰6ID.7 n޲E)uZIFg.6x~L)ig{Xbmh1L VFqfup7@4 LF­ .l.#g$#TKjO4$e!oA%\:Y5)as.Xu" ӳd]P_u})V,#a\**2ѠH_;a(`ThBe) b+6bz`MVb4.FV!2ߙ1MSOĝNE&̈́ yD!;EU\Gg+G),?۽bs)Fۥ1)ׁIB섩BqڎF\Znb_A%j##ZUyȬوՔOW55A+`):OU!9A]rx-DAi20`FWUP'c7fjK;/o*lNH"|ʞW%5_3ϫU.8Qۈ޳N'b'ۜU tBp;L7xYW>N %mPJ7^s:IIB Ę"f{4HYl/W82=%G.+z{}&U}`1Rj" VhgˆeQ8OcIq+qOܠrٟFYq.qRH҃uoK=Dq;FJgXfN:0UXiɆdJoj=%fF|50ޙz3$d AǏ3A8w^s쬊ۿ ͨZF۩V^KpjfKP Xp ~ódէy=4u{"`d*'n /كyE<`÷Ǎ%Fɠ nh,)+SSJuN̊M0w'ն2_` ĩB&o<a )3-ӵ]Ͽ_AtWn!|_J{<jL =}^u[eჰ}U_E\-o[roL.?ȃ4V8/.CcMC cmI_?@6;liݓԁhթ8k8ufH4Yum#}=XYYJme.1n @Ip4T/'EƫP4$>|(/`ax*{sυ'ǐส1+HR)Yp*Wvp2AiՒ0O=<%Z7lҏ魰"~p@Ŵyaz *6֮>Y|`VA$IX{K z=-.ˬU9Ab+9z>Јw2$Euٴ}=ozOmKye{ .ZT#́l@Ձ!/ dz?CoN'q} ىB i^ &`\4sBh׾;_@~ نnDd؀H0#ΨMAf* ~ɘEy]]ZJ'p8-AX$'Uh+.JOmNȂATBz* ߘ!WgUJ0!17[1ϏB'>;uvSUUA’,꼀VC>#9;~SD8.d"!?dWf^Z&S yi>(גKUu:O%aF 8PC{%My>>#́5~$Gdhu%ѯ%´_.GrI٦| _0K1RAK3TYRA;\ ֒r\ 8rF2kexl/8YE2(88'%MEBjUɡGVv7<\^n&y%90ùs@%z#q ` \-9J:桭ՕJ'Jc;C?${2] 'O~`~E|wA -bO23sϯQ52"vQ W 0^J?~V ~/a';l[;X{ФL_:L3dvgH1/ c ˏL>ϴOM︉Xq0Sw uH/9BʾX4Bz_';{!yN₍$ܦ<黡[H _/"W#1pfޢ).IZO/6&o"r%qpl.Rl GeOk9x[OWL2w[/Sdއ9Ju;̂lUn[`[J Vc!;)džjwɕJ]m-=-8: zZw/|*V2E 束/ea*>Ih%>L|jK䃷y2:3$0h65d3 $?&hoFCMq|wκ>5o<6>7r Ae9KPE@3QV >Kzn6`fJ>U<ŵn˰.;Lh(N[YE~@/"M4(+aFE"=L;*‡$`Sno$8)fVnbk慞>$*L %>F+ƩblJcxefg&r~ (4> zuA6M}4Yn՚!*ZH.6Rr sgY !#Ì07bO+co$Qj9 #2t0t6ɋ$N1/Ev9ޫ U&rOٙ%P-hZ+ȚɾwM59Q@ #xLILU SH$2f_q^ZZ0ѯ}E 54BF`Y"0e`6W:J bM=/[)٫ؕ,Wϫ;Ց8͟7CvI8I| ?W<%؜ >1h͚ iئٙd ƌT~HU q`f:hwd~[@5װ+Y[`7uj^o)`J?z}rkS%`ƻCk6@ϒHqRKrZ8EۢﰨMIᱭd4"$ VPQvN.405i=fUw]0t2 )"Y0[yw{9mQJa723wiLb+sh ?Ȉ4[e\4V5I8^3 J= zazi4L6)j p@X8%pek '5|*Vo9ʅ7  ,)d?e#)%Ci oyځqd0pqvvNEv;"MI~*zMԻ;\qˌQ k&aɳ>sd(T8׷=B \,HO٦;~:*)S$EaNN \D=p5>ʋY??ƀ4czDm+ %o) :g纇SMTsvv DmHd/T'LE(d"AUҩwW8rV\PُfI! ?+h?F_G39'$F!b,7{/3~mš5u,GU;ߣ‹sSb9%Oňi"@N)o;`m:QL$v|YJ^LEٿ]s_(8V` Й Y]y<VpS+sh/vg7ݐq, izAVU=n m@| T dF ˰gY<ˢݙs߿/lFEO[P=sqpb )$;PW~~(Q#j9 )1ºH¡,pΟ5ߕ!H N|qA2I沿@& ІGaUs~/Ơx|@.~%ԃ D1 ʹOli<ͥH!ٍ-{m nhEW]& 1RF. 5^ Uv51 M>y6ҹK0Kim-$FYYNHqKim-rQ&G8̆juhd[a"b Z2tiٛyԜpw(#/>|glHu 7w< `<-]I78 @< 䀴@m pZr, ŝxx,j6żS`XL ۂ@s'mm9kx!{4mSaUj#6G~lL[>rfm30k nۙ]Sf9dz4Mi;l#$RkC]>4 ) 3 &C:)MMnTs,Qc`̍/f)y$K0q2[3PF "_XU#gHpXI 7r(,[J6O)bB!GWKH!Bl轨idVR[ { Bj*'qhy"U`PDR "<,94$i% !t&ٶ, ޛڀl70- 0J:@`2Ld4:2`4B@BR&86D~Vm$[^zkVKl&w03k0fE^6FBa@K c]bmBR%jR2@C9 {`L͈XZDPs(I TN̐#]Bܚzd-$pC r$ YـhpbCۀZx$쭩6d=q rݐttX4Y?%l3Bi\4WIg q=nYSmh`0yN/haHH~+\hQX(R[FՒ$I6DosdX][a ͆"w!h Me/՛O!A3 ?]U0333 /uY]Ŋ}ihVP'd̀|YeC͓bmM3.8(&Μ?:2ѯNSΞ:ǿ{7 ̚n;. Ē ! en3&9j6eyq+yg% @ ¢VY[ϣU۠s8&Q$5^"3hv;^erME|'Vlg"JwtFJs mKLPXT$/s-gK3 1ޱ`0 QSq&~2٨P glLG`uD Pl 9a/T̛ T싻֓'vCe83=a:B̘~,sbCD1BY :62):oC d".49,-med2i8͹r6@lPhzsVa9Y͘v% |H" H(T+Wg-FYڶEYSHg$ rf֧RI٭3OgQU AAdRsû>e|Pa!Ex } ٚjA3磣6'WTLYii,4gQٗz\3Z. G [YΜ^{kQj4c*( q K$”ZnӥbbA6yN>VF=+J'Gn^} {нő 9Be>w:6E"vnt332 ȫlj8Uu Ƕ׻PVʕ"a(YV"w74GdcѢ 2P@9#%v~V{L!t*`)S gRD6:x=]wbL&5>T95C/sl2ñluŜ8FFJ(R@9 k,DbTP~[oZ#FR'~}rO09V[p WAĽMDgOք%}tv>#nyjZʼn,} `B.^yw)upI oalzѢsNp[!X)OPRrjjTjd2}U  I?ԛP˿E><[/\ K k[JdqX- "4))2a.^ᰠ&4M(Ijhu)By kE3s='Z2WVw~{4 Q֠eg4Wp;;# rø_޶^O܏=K? N%Ri} dy_p$FmX̗M*ZjvDn7! IJo@qaa14,{ցV+,gWٯR=Gpq}}=bIDV5^!OG%0`SYFƨPȼ@ RNł!tGoNj&ĺz)p3)4IV7+3/~3uw^w axGi˴Cȃ`x~pDi3 X4GD Gl%* s9 $rB @l"2?>ٯUG4LF> ȄOe3 jLʞ`*0rw@oT?=z6샅oo(`3>'H>)l"V0C8֬,ò+&Q%Cjz<5АmԟI_p krʳ#] 9s_y=e)֣OYn 0pZ5hP<'~ aN|v`[$ ЀDfK>ŋ'``a#İQZ֩)`/=fgҶq8PtK4#l / ;]EG|ɔ!g 0g x?hǢq' Y`{QL)ON=)C+'{*TP)>SKΦ8r7xezh-*o.H%Y}'ŗ2"aNEhHyj* !2`2 ثA- 8+KSj:Bp~' g>zT[N4mN!B-,.Ak9c˱S ^33 &fx"̊W݈UlOu \D^|0B1XdnF^ Lsv^DTp0ڌ/]dS.12\+)#" Q1'cQEFhȕ+vq_,M^{qV"/W!Gc}>=QZktٜed{VwtDl6nav~xO߅&a=o A̟)uŊ̀~"/9Az#Eh\:4m;K RD3oU|Ӧfϥ*P+g*=[oysbȦwmun, }5[n \#-,-<ʁaP0 ۽jeיrՌkϧ#Elvrz0*YgÛGJk,֐VM[ƉA@ A1|^bHUVֲș,x-^xN4H {a-ٝN:ё'zOuP"˪ Ƴ@ # 94n$P<YB=JθýI ޢ>&aie0׵?fU#-Bi OKq,nȖA{swDgn(5ՠ D̾ܨV˼I{j6',Ebê|:"yt9{[|\/Կ[pN>{33lCzŒ:3vf^I1J 7;=pR:\穀)HVivb|wv},W32oEܽEFُz\zqrr2ڔv~t!3opo+iQ?' @0{9a_O G!ҥ0Er>iUp2 .R-l給FnK3}aD8 /76bFpzb@s)JK4>1FFR̤b Q&`*r\**tE5Us\E9}☛C쌟S7kwJ LߙI$k7>6Y1B 7Wc>< b7nʠDv{˖TF4{i;R,VgsՐm 3c&KZ]Ę-}xDQG`'ǥx:dr#Ri0_ L"\pNŇG}BR,X V Pf:Se#\WF8t!hZ!U/]FaPgPI"JD r6ѶE\fcrg#V Cb'&[Mm Nс#x =A/5|g6JD,"ӭ-6Ӵ]< iCњSH|.& *i> dәy55" Q]@k.xJe^'(Ss*WOVG{m"̯6LDS#2r&Ԁ:lwcR jUca"ρa-bB(kI1xyShꪻ@#3) iZOɛ^[9%{Px ,!R?slC'6Բž{T@D isM%T֪܏=csk vctlpҷ h0(C'9$Mr,1dˍ9'vSbLŌa ՙY  R\BAeK\§CT[xV~o`x]% FsMZ`e`h8??y>J{so(G>J m⓰ÁMr@XaԇkO/TKjJVƶ&ѠfԺ7n;_}+'x*FjɕKxYK=crL|;SyZ$=tC0ctLP/;_/{r窨ƝޔN׻:c7*2^;Ǩcz)W QB%V-^Ar6X'ZDJݹnoS >95@ G)wVx:פo V>V?{O0R)$ a5\,`qYVpTvoB= f_R# *SAϼ=\8/kIt]bi; K`b킼`*mgFX.t*K-VKcРq F>ZQӢ:̺""Fìo v4AEʳ]n߀mʵڙ ϴi`4GN(i ۔?R#{ bH3;B ?b/y4$8 ق1O]~P7q!Ghl#m4ڞzCA>{28^faۼ|T|SM* ur(I?XM囄904pkȯ˯!1 6PP0$ 8WP@q p ~/|ހw‚:`ԃ`mJd~gK>(*d!w<=y\zL~S+?5;G9GxWS?q)Ĩ3RsfR(krҦ'WҪąz CLT?1|7"[& ut*m9}xǃ͟};m7Ѷ|gQǃatfۥ !K;6?/t>9]JvQzNB/ $ /LλbXY. ~e@\$& Zs٠īOwy{N~8!?J̰0!]f'dD pt ))wxh[!6"4ϙUPaӠ+>S>;u)ZC4>K ef'ʞ QeEcB8`biĦvGMhH:뙛TdxV8oB,^ǖUsrwH]`*LVߕ7f9ɯ"}L:_* C!]&*e.0WWN> a8 RV߾9!#'LނlGsٲ+b#JX+^U^ɯ@җV$d-+Kv}L0غMX]ԁZ[g9qHح`JPKkmRft ` >~盒 wkbay btM՛StJ St"@yBJI19-c<ng=iS1[Kl%l u25C *QseL Rh4L'6uw>_Ï613PL4 @8H X,0z#.~@!E$887.`QuBDPV1hL7% ' IU#0@0 (`f+? ^DPɷNW!ac;-*֯=n om[/ϔ"[Rw~{F;zw7Ӑn3p/0c}swiW#ɒZ} >s4nĢe8mtdpAHb͜"˂:C&cNUx&N?_!ea9@>N:U }WxNM,r Bd(af3l0w^~=fߗ b)VSuؖJD#fQ r]#wŭ; |p"ȉz~`FeNK01uKvzjd{|E~#_{m[h@ #!HVG9X VmL\V]l6~@t:;l))?z~:HY;IsN@6l.\((k`h0 XIQ^y\!-Ÿޛ ÐHR5z{~ K5*>:yP_%i6 AIE]=#uSE6 X-iKջz>;E>eN 3oۜN|h::MDw?=|~?<dL岓gZn#*ֆ0>T<6K gчB1?Y T@L̕ |\BO!.,AAr(E,^qOs\sE(ٗ'!1Lb<Cy2L{7ӵ1)N3kݡڗp4Nv`>|DI d٭Y[~C*A%F :~4T{=x|2k]X$o [9:RGRZ' > xV5W|l~{vkvH ^RJDm'ڜsN6]E"%DrA0XqG#-!G>q0o#cB cf\OyW~Bq{ OYcL(k2@{#I :AD| zբ})d VLT~xNI]Xxu'v~>al_Ŕ!~Lp *l88b@Y{^Lp$$Uy_DB E~naN|93qCI P'o_Pcu]`G tsL*9>=0%p<ٝ?4]AWMT!揮Wt}z{z e Yn7נ)KPUUWUeSӢ @/G~;6Owޖ=- Jۈ\[O[x~lP?̛΋=ߏQ3BcU3?@&V ` 1%_8>?gw6EQlr MaHy!B6tftL B^Q y_0OOx4' DglBDP7,gU9<qx7۾\F**q%(ѺC澎OgK0a L0  02PTX y*2 2*D? ")9PFT_0P|]#"nIO}>@H U4Jd,x2: &1ݞ`QCe#s&3?neO F{Nyq/fXaڑbxxd  7QLE1?Ur|Y1?~kBD$HmF1@UHɄ9<Q! g8OS ѴT\GbGY~ :yްt$F϶L {ծ.sÚvLDP"dLF'Mf(r~݋p|ϠUoېmpC#pEqn`?\n s,;m,`B,KXnC fNlcP-J;,a.欧N== sz}3IBB X ̧d c6\„O{c`|9Tօ0FElAAaHn~ǹ:Rɻ?Y>Sy)9|,ܱ͒FXq`L>OI-N7 }t= e!0 F{01™ >w*{ A'Gh 9eEL0@M08i>苽o e L;f#<r媁}Sl: Yke(O ftkWTZWd<% wEvCMtн&"trR8т89r^; f!QfV"3l!D. tSq(~#llvI 6H#톐}g&dMN×2ɟVc?8wcΚc>$r/D(G;u8B [fBj%콛5$?Yk.3 m6"iPL K[1~#ɪ{@bХ] pQKN"<*B%Zvv`Rö_fζ>8w0(Xj`Ba$4k"YОؓ2L`JL, 0Ꜷ^59^Ƕ9fa06 f%FL{<U7&lw17s22o—y~OeH;S #|^t\ q7 ]y Bl,B\QQo^~y&`RBk <ʱ|38e)#^*<}(gd 2Br[a?[{1"R: xt`=CotOt,ؙBxoT>> &ȜSy&AlLy#(By$$ mdG 27vS7-3X-} 0ֻWA}1Ш.L_K50#dq3l@eZ]] HC g>(YVazxDw?fÕi;\ NGHqvR4 k$!PPh$ x @ od@1B!M.xx9`bMe"(]28kCr`kxfl/ᶎ]b"_U044md$3nCbjlsroT. BMHd%߫!#}pBMn іZR1-dgyzk ޽;x f,&4&eBveD!" yN'};ZW+f/e1LC/ED)L#g|>2r۹ZrȓEeFXmF%d)0(8fG+hi[1s"FH W qGF}{zz2;Ar2Ϡ;gzC 33LqŊhdrX*(bLB#xWrʼnjӎf@8.`9+Ěi:֡5P&텦9ϊoiMhK ws$I&F.܋pcɡhR% f\v¨0dҡ&%a;ÿ[mN<bkB@&$AY!/9jKߥP4y~:vFʁ*X6ms&8;3" ~s@a{@#cQmD S14^ { n\;ǽ T╳$[TF "@@@+t3.$ND>C;!uəqVwpQ;D&t'}~rfG6 `4c`.=rx!å pfEI6:?=su=og6`Z͉tT}HS`~Q wnov9j~Ϸn0$PuRD/g٣xM 2m)@#"q6yT m$I@Bt87B@X#;} . <"գV(n(f za\L* ڙ8JgY׸#a {J˟d$V!T,pY?I3eg3z0D@zR@P1 H|Eb)>֬5  ^D9BB0ہ.ð|y`oleCtA( }ǖ[2A 젇,^Tۯ3TE($@|OߛO} #{>ۦL3hk5̠ eM3-|uXIVJ"1p=kAѯ? @HȀ=z6.WN@{@4p ^Z fA* eaN[]B@?NB׀7|%yP-XA8r"#)~ȦHI.fT% @#av_ѹSjvi﵏c7ĝ|aܥb/~-EIَguj4tfy2sGB;h0X&<&O]=QzRެ%GgJ$)@h@km(!=jHOf!|jٶz/EU< L/ɐP$sA=y!I-j%)wnTyV0I$chOlH#76l4\ ,$U&0Mw Pr[=BDY^'rȿaCF%G\5@VHFb+p 8!ZYA]:hN ls`eus0Zj pA H+<*wHyLX @:ǯtklPU0x p Gх0Sv8t(r!t7öMTAᶲy}8x爨H2!" @H " H2&oBGg 9 PBBUtK!nFxO1bJĊ"BA䔦H^xѦ>lqO3z}guH{D;@QY$ Jfтr: lѣLAy P3wP v;dc"%w O U۔A0! FFEXđg!vr O_?ԋswܺ(LLƵN  *}VaGA> @?Xe{3/=z{J??O8T+ֳ'h9w1&/JsPuHAh*%h>H9ЯCn,㽦{|hǜJ& `ɉp%W2+|{j_Z{bo$9JgHuVcŏ~\* +39Q-hz~F_X.@s'{ < d|2pJ(#''{KbWzvc"7*@]N i!;1?Whkp>6R˪o褮ЋCʲ, k/I_PUI Pb"n9KrfcG2xU4ڹ=/Xza(G ~u3wH>g;]URI>xնbp^ ]Sip72&'s@;^DN.ܮNA@D#$favsw]{S5'.VerDJh>+٪`&a !MrI&!Ŭ $3,DTy!ɰ% Ȧk r󚔮dMUIEBҎK8,m|0Y@98 f:4ЩcMt Ra p^H;E{6">lP4':P;Zq׵z_|m_GdFة&_<\qrp: h;RxBdx)[aN MΠnb&Hi)~ &;Z f`pYL6F5FM6J&[.ު@@# w@`eһfjVx| ͗(&gF?F'9iV#h^QxAc}z^@PڀqA|/+қ@fГ32n(v!Aa]n! :C+H3S3c[D U]A/&R(rZtZ.dsDz$oM-g ēED[)_e <)g0 f_^&H"n{[},ZH% C@RAxT~T>u ,<^rqD,N0% {;M\UlT|כ:2߶$u_`i}"M+%>3-[ D,ap_O_PՠE7LeX%CϑY3툁g?KIhk=94&D$5ɘ\̆`·S46jH'{]7kT.* A`gh*f I4f9@Hk, Gul9@jam^4B-L 9S\5|~{^j\|ĜѸ}弳$=Ny")jHM0.\ "(^dBi鮿a>{P$@ϟXM7qc׀saB :@$$` FED@$A$;B%vJ>zRlԾI!;::3X!Yƨ"NIh8/l_d&PskWk/ ;"ZT G:ID$BƁ2#߂iDkYA2DR1?r~Jk#2Q,m!@Ӆ#1rmm65h]!.XB?" 6z)8qkP**0uHMv6B֨o8c-b͐(K0wtN!{D:uIoʄp\K5 ySxB!g} `kO(8 ^, Y0H-}8`ʰ׍8{ ]sna>n|.NTyX3WS $!,K8ARr OuxE}lQ{ H ֧]=o*߽dC;*?*jk!$v_e'nT>^tv 춓$m@{, 6H fش~* *#`,X&m;A"!en" T+ @>ʟK6%DDIbna2 11A3E[^`G݈{@s&d7D`}> [\s2U>YFݨn)^^=Y+NJCְ[Tyķ&퍆/v3N# ̛Aqg f;c70y=?1&~n:أhQ^5'}x~l,k[t# % VjqG3.dt HU`xW2_=|>N^(\]weGst ?#-ca7 FA{wWg&8@]fls. oHi8op(<\bۓB& ~>`ú >10 aNġL'| c> Gˈ^!@ 0Oa٥; Y2?QV'aCC6)eYzJ\7=@x.*rlahx   5"@"& ^ +ɎVk3MHs NRw͊ h%5 Ae A],y`0"d G{揟K Zی7xt@C;&#m=4{c<)ɽc^)`v:-R8ʶ:A` 0RIe&hKLaw] s@Jht5 `@>"{t>(}@3 _zBaTr@&ͿmH珎œƙ<NΨ'u؎\ ީ˦tR]=H.؜IV<_2!no=*1!D`#|9!FBހ`1$&ߗ҂f4Z]؀R^*5E9c~ş}喯2<dˊ2*+)mhpz> ^4 ]G@o@gO&g"@r/./ /? v:ofE~<~̄ E xT2IOZA&5 > b1 -^}C_Uץ!|_m k|5IS۠gS͍&[&J ϧF5043f`LۓU7oE5 =|yHc_w73HR1JXP 5: 5H|󾣫gӥ N ܄D2lȬ]@CY0Q |2rnC4j1L \#a D9+8}uCz&*i"X#+ RT`W%,*2-&~?_O4ݝa*!o\pHECBh1)-Zp|19+c$sG`S^'DDoL!^=StDL @˭M<5}z>_' ^EhypYB4% $Z߫y/Wbu0(C-c7)]ՒC^.Pt_o\gf1-:gO#I48.V_ ~'t5e8j$dD{*Oia'pWa5VTr>-vw E7nFhH#j~:ѽ "~^5i*jP50i T"8*sJ55rn+Y)Qo`@0PsF`0J뤮8k |m 2 !ޣ|/'`D_|!O $D"EF2D,"UAA2<9r @JH2?E3$NAJ09?SL\yÒt]:~[dW~BZ1! F9{ݛ&?AAwT061Hs QM@BFGVMy4{cX s@uW46^>zUOM5aݭԧb `! f>@q\\CK&>|,UTx :|-ruʧGQs'{CiA"j-^`ةɲlM$9!?frL%dl@Gk jTm}Kzc7OʀuLӖeD B٢^1Odo6/Km}}_wNsݩW!aex었X`U+-=qyVִٿK0UE@B@cNE`Xʠ}8%-4'27]n-"_$T_H6|y<q;hu?b&,8A)l/zl۝dUk K?L _{䇟x}ӷ^!qt.Ctfo.5d61a%^ֹgOˠ|9#~7̳S?^ k0rv}3ksKB@L*tWJ9Ù1*fЍϚ4rFi]F8Trh,1 qqWnl~V;Λc˫wn!XL~\fFurwOePu:s $f"gUfV;u * 8.Ll]>3hc_xcC臒 0xn-f\maBPzKt=PZ^*M2lS"w]NU=TWHɪrAO7M7{WPYe|`%o Svoggҡ.(@ $P* 1#@~YL6=od|X$"[erceĥ6mLI*<̇0|f 6;m_4EIN3H3>SkLүI)F=^ ӂhE@s5oQF*Yw2q4WbFz2l[ uf\0E^&p]{@ӢH3*MXg-Հ &a"Cُߒc%YOP6}Nv2I蟻" [$E~(s('{{AMM6NVX\"AqӲ39Zw (N3G+4$$X(*jHuX% `ӄp< CΪ-zp{0J HUp9>&D/?>oR絲MuDNXXPBFtN_ɍqAf8]H Y$ bM( 9g(LV%RxD/E 9$-@!^B,3_p|>TĺA"˳Ø6< D1` G4b&H!;/c 3>j1X(@kQ{7b& "hBr Z_Qk(E-..`hqsgѕ E;P"<nr܀&Rv\D{Vsxb*`Cs@1m`\&ɾQMC6taa7a)9AhrĬ{G:sW.4ȱo0 AAF9 #n@Φ9<$C(Wə =@iߋ^+JCevV:L;G,W2U!&>pbpNkܐ( R,mHYBtM` H$2!]yb' BRW} w=qܴM`EX@T'ЅF@ 1AM6#8gQ)y9_@Zy3@}3fyJI$MVW+^2Kfrm8,YI(6˧q %@h H+ /DjXhP n)Ou"v7!~aКCGz8B1&&mF YH 4e@P?d4,xW1vc7/XezkWye|\>: z 0APAOSl  Hp#$"@C- @5.hK[x^}xpgY7@44*2YT=2;N+q c鵺uQM˖Lw|>n@:WT9r@7@`>/n8By>&gBtBw@5RfIG♡n㏫r}WA $; XٿOgKJ_e9xYXy~b١Mq7j\mzoA^vp AavRP#x=ukix2дF>x0:}vȴ[_!J{}wڏ.=ߗn, 9LBo|?1x|W ő 9O}#!L@xwX C^z_x9)l0NT.> {]+0nKeF֋@VwA`p:3f;RFwcgeYܦ VEY Z˞FBQP7";%wLzNp@QWz}!&o~ HT y?<}ӿ*u'gջ. Ђ=@"NK\%L^=?e|̅R)zxځʟWymJ>s]xB)܁N`j;ȆX )z N倫;9LT=TzRaJ v;N(G ։h4:;0Ґ_8Y8?=seP1(DR N hI|&}t5էɃL GYOggaD*@F@9^iP8J@"&R{[^$u1Zu'$%Foϋ}{*.tnP(!##̙0H  ȩ.vt::z5&_V?M8wY HXMZ,S>_每 nn`$}RdF"WYjv4`|GQ$<'Ar*{cd2 Qd|Qc*gD->OlK8 rf8of#ȉ&pBh(B@ۧ?D=,QVP,I뽆7/)lD"2~1 =T `)NBgMFFBB譄@_ ;hП|dIt{{~.t{Eե~|qRsG5PcpohjM菽r3Cuk9Yiy,F8>B[J `em# a> ݀8\E/9'[Gf[9H]-hR%i$[2Zb#X ӽ7~1 0S0`UBneXܘbWP3ABiulygwvz;m8p{ZB!|>hB[B .S;z,꛶lcd^w90$F#a/mN~{<rӆie1x.#'ƒ֢yu> B]-VdQiYH G*\xWc?_8RTr 1 vD)q1_cU~\R9W$$wa$.{g6א(⧺orꂔ c(y/ڊ/&7GM\ e  :0c eml> R. aS5Pp(fV lk6ƃ&9ghByg?g#[`:Э.넡\5`(/I=Oe9{?WcǍDYKbp<]vvjE&})ebqЕ a,z iqP"25335+XgysVeEܼ=|M(af؈CͽrE8P~7xml2/tests/testthat/test-xml_nodeset.R0000644000175100001440000000417213022625753017606 0ustar hornikuserscontext("xml_nodeset") test_that("methods work on empty nodesets", { x <- read_xml("") empty <- xml_find_all(x, "//c") expect_error(empty[[1]], "subscript out of bounds") expect_identical(empty[1], empty) test <- empty xml_attr(test, "test") <- 1 expect_identical(test, empty) xml_attrs(test) <- c("test" = 1) expect_identical(test, empty) xml_name(test) <- "test" expect_identical(test, empty) xml_text(test) <- "test" expect_identical(test, empty) expect_identical(as.character(empty), character(0)) expect_identical(as_list(empty), list()) expect_identical(nodeset_apply(empty, identical), empty) expect_output(print(empty), "\\{xml_nodeset \\(0\\)\\}") expect_output(tree_structure(empty), NA) xml_add_child(test, "test") expect_identical(test, empty) xml_add_sibling(test, "test") expect_identical(test, empty) expect_identical(xml_attr(empty, "test"), character()) expect_identical(xml_attrs(empty), list()) expect_identical(xml_double(empty), numeric()) expect_identical(xml_find_all(empty), empty) expect_identical(xml_find_chr(empty), character()) expect_identical(xml_find_first(empty), empty) expect_identical(xml_find_lgl(empty), logical()) expect_identical(xml_find_num(empty), numeric()) expect_identical(xml_integer(empty), integer()) expect_identical(xml_length(empty), 0L) expect_identical(xml_name(empty), character()) expect_identical(xml_ns(empty), character()) expect_identical(xml_parent(empty), empty) expect_identical(xml_path(empty), character()) xml_remove(test) expect_identical(test, empty) xml_replace(test) expect_identical(test, empty) xml_set_attr(test, "test", 1) expect_identical(test, empty) xml_set_attrs(test, c("test" = 1)) expect_identical(test, empty) xml_set_name(test, "test") expect_identical(test, empty) xml_set_text(test, "test") expect_identical(test, empty) expect_identical(xml_siblings(empty), empty) expect_output(xml_structure(empty), NA) expect_identical(xml_text(empty), character()) expect_identical(xml_type(empty), character()) expect_identical(xml_url(empty), character()) }) xml2/tests/testthat/test-read-xml.R0000644000175100001440000000337713026563216017003 0ustar hornikuserscontext("read_xml") test_that("read_html correctly parses malformed document", { lego <- read_html("lego.html.bz2") expect_equal(length(xml_find_all(lego, ".//p")), 39) }) test_that("parse_options errors when given an invalid option", { expect_error(parse_options("INVALID", xml_parse_options()), "`options` 'INVALID' is not a valid option") expect_error(read_html("lego.html.bz2", options = "INVALID"), "`options` 'INVALID' is not a valid option") # Empty inputs returned as 0 expect_identical(0L, parse_options("", xml_parse_options())) expect_identical(0L, parse_options(NULL, xml_parse_options())) # Numerics returned as integers expect_identical(12L, parse_options(12L, xml_parse_options())) expect_identical(12L, parse_options(12, xml_parse_options())) # Multiple inputs summed expect_identical(3L, parse_options(c("RECOVER", "NOENT"), xml_parse_options())) }) test_that("read_html properly passes parser arguments", { skip_if_not(libxml2_version() >= "2.9.2") blanks <- read_html("cd_catalog.xml.bz2", options = c("RECOVER", "NOERROR")) expect_equal(as_list(blanks)$html$body$catalog$cd[[1]], "\r\n ") no_blanks <- read_html("cd_catalog.xml.bz2", options = c("RECOVER", "NOERROR", "NOBLANKS")) expect_equal(as_list(no_blanks)$html$body$catalog$cd[[1]], list("Empire Burlesque")) }) test_that("read_xml works with httr response objects", { skip_on_cran() x <- read_xml(httr::GET("http://httpbin.org/xml")) expect_is(x, "xml_document") expect_equal(length(xml_find_all(x, "//slide")), 2) }) test_that("read_html works with httr response objects", { skip_on_cran() x <- read_html(httr::GET("http://httpbin.org/xml")) expect_is(x, "xml_document") expect_equal(length(xml_find_all(x, "//slide")), 2) }) xml2/tests/testthat/ns-multiple-aliases.xml0000644000175100001440000000016312723345322020571 0ustar hornikusers xml2/tests/testthat/test-xml_find.R0000644000175100001440000001041013022625753017055 0ustar hornikuserscontext("xml_find") # Find one --------------------------------------------------------------------- test_that("xml_find_first returns a missing object if no match", { x <- read_xml("") expect_equal(xml_find_first(x, ".//z"), xml_missing()) }) test_that("xml_find_first returns the first match if more than one match", { x <- read_xml("") y <- xml_find_first(x, ".//y") expect_is(y, "xml_node") }) # Find all --------------------------------------------------------------------- test_that("unqualified names don't look in default ns", { x <- read_xml("ns-multiple-default.xml") expect_equal(length(xml_find_all(x, "//bar")), 0) }) test_that("qualified names matches to namespace", { x <- read_xml("ns-multiple-default.xml") ns <- xml_ns(x) expect_equal(length(xml_find_all(x, "//d1:bar", ns)), 1) expect_equal(length(xml_find_all(x, "//d2:bar", ns)), 1) }) test_that("warning if unknown namespace", { x <- read_xml("") expect_warning(xml_find_all(x, "//g:bar"), "Undefined namespace prefix") }) test_that("no matches returns empty nodeset", { x <- read_xml("") expect_equal(length(xml_find_all(x, "//baz")), 0) }) # Find num --------------------------------------------------------------------- test_that("xml_find_num errors with non numeric results", { x <- read_xml("") expect_error(xml_find_num(x, "//z"), "result of type:.*xml_missing.*, not numeric") expect_error(xml_find_num(x, "//y"), "result of type:.*list.*, not numeric") expect_error(xml_find_num(x, "1=1"), "result of type:.*logical.*, not numeric") expect_error(xml_find_num(x, "string(5)"), "result of type:.*character.*, not numeric") }) test_that("xml_find_num returns a numeric result", { x <- read_xml("1") expect_equal(xml_find_num(x, "1 div 0"), Inf) expect_equal(xml_find_num(x, "-1 div 0"), -Inf) expect_equal(xml_find_num(x, "0 div 0"), NaN) expect_equal(xml_find_num(x, "1 div floor(-0.1)"), -1) expect_equal(xml_find_num(x, "1 div floor(0)"), Inf) expect_equal(xml_find_num(x, "1 div floor(-0)"), -Inf) }) # Find chr --------------------------------------------------------------------- test_that("xml_find_chr errors with non character results", { x <- read_xml("") expect_error(xml_find_chr(x, "//z"), "result of type:.*xml_missing.*, not character") expect_error(xml_find_chr(x, "//y"), "result of type:.*list.*, not character") expect_error(xml_find_chr(x, "1=1"), "result of type:.*logical.*, not character") expect_error(xml_find_chr(x, "1+1"), "result of type:.*numeric.*, not character") }) test_that("xml_find_chr returns a character result", { x <- read_xml("1") expect_equal(xml_find_chr(x, "string(5)"), "5") expect_equal(xml_find_chr(x, "string(0.5)"), "0.5") expect_equal(xml_find_chr(x, "string(-0.5)"), "-0.5") expect_equal(xml_find_chr(x, "concat(\"titi\", \"toto\")"), "tititoto") expect_equal(xml_find_chr(x, "substring(\"12345\", 2, 3)"), "234") expect_equal(xml_find_chr(x, "substring(\"12345\", 2)"), "2345") expect_equal(xml_find_chr(x, "substring(\"12345\", -4)"), "12345") }) # Find lgl --------------------------------------------------------------------- test_that("xml_find_lgl errors with non logical results", { x <- read_xml("") expect_error(xml_find_lgl(x, "//z"), "result of type:.*xml_missing.*, not logical") expect_error(xml_find_lgl(x, "//y"), "result of type:.*list.*, not logical") expect_error(xml_find_lgl(x, "string(5)"), "result of type:.*character.*, not logical") expect_error(xml_find_lgl(x, "1+1"), "result of type:.*numeric.*, not logical") }) test_that("xml_find_lgl returns a logical result", { x <- read_xml("1") expect_equal(xml_find_lgl(x, "1=1"), TRUE) expect_equal(xml_find_lgl(x, "1!=1"), FALSE) expect_equal(xml_find_lgl(x, "true()=true()"), TRUE) expect_equal(xml_find_lgl(x, "true()=false()"), FALSE) expect_equal(xml_find_lgl(x, "'test'='test'"), TRUE) }) test_that("Searches with empty inputs retain type stability", { empty <- xml_nodeset() expect_equal(xml_find_num(empty, "1 div 0"), integer()) expect_equal(xml_find_chr(empty, "string(0.5)"), character()) expect_equal(xml_find_lgl(empty, "1=1"), logical()) }) xml2/tests/testthat/test-xml_children.R0000644000175100001440000000277713025004626017737 0ustar hornikuserscontext("xml_children") x <- read_xml(" ") test_that("xml_child() returns the proper child", { expect_equal(xml_child(x), xml_children(x)[[1L]]) expect_equal(xml_child(x, 2), xml_children(x)[[2L]]) }) test_that("xml_child() returns child by name", { expect_equal(xml_child(x, "baz"), xml_find_first(x, "./baz")) }) test_that("xml_child() errors if more than one search is given", { expect_error(xml_child(x, 1:2), "`search` must be of length 1") }) test_that("xml_child() errors if search is not numeric or character", { expect_error(xml_child(x, TRUE), "`search` must be `numeric` or `character`") expect_error(xml_child(x, as.factor("test")), "`search` must be `numeric` or `character`") expect_error(xml_child(x, raw(1)), "`search` must be `numeric` or `character`") expect_error(xml_child(x, list(1)), "`search` must be `numeric` or `character`") }) test_that("xml_length", { expect_equal(xml_length(x), 2) all <- xml_find_all(x, "//*") expect_equal(xml_length(all), c(2, 1, 0, 0)) }) test_that("xml_parent", { expect_equal(unclass(xml_parent(xml_child(x))), unclass(x)) }) test_that("xml_parents", { expect_equal( xml_name(xml_parents(xml_find_first(x, "//boo"))), c("bar", "foo")) }) test_that("xml_root", { doc <- xml_new_document() expect_is(xml_root(doc), "xml_missing") a <- xml_add_child(doc, "a") b <- xml_add_child(doc, "b") expect_that(xml_name(xml_root(b)), equals("a")) expect_that(xml_name(xml_root(doc)), equals("a")) }) xml2/tests/testthat/test-write_xml.R0000644000175100001440000000717213031530260017266 0ustar hornikuserscontext("write_xml") test_that("write_xml errors for incorrect directory and with invalid inputs", { x <- read_xml("") filename <- ".../test.xml" expect_error(write_xml(x, filename), "'...' does not exist in current working directory") expect_error(write_xml(x, c("test.xml", "foo")), "`file` must be a non-zero character of length 1") }) test_that("write_xml works with relative file paths", { x <- read_xml("") filename <- "../test.xml" on.exit(unlink(filename)) write_xml(x, filename, options = "no_declaration") expect_identical(readChar(filename, 1000L), "\n") }) test_that("write_xml works with no options", { x <- read_xml("") filename <- "../test.xml" on.exit(unlink(filename)) write_xml(x, filename, options = NULL) expect_identical(readChar(filename, 1000L), "\n\n") }) test_that("write_xml works with an explicit connections", { x <- read_xml("") filename <- "../test.xml" file <- file(filename, "wb") on.exit(unlink(filename)) write_xml(x, file, options = "no_declaration") close(file) expect_identical(readChar(filename, 1000L), "\n") }) test_that("write_xml works with an implicit connections", { x <- read_xml("") filename <- "../test.xml.gz" write_xml(x, filename, options = "no_declaration") file <- gzfile(filename, "rb") on.exit({unlink(filename); close(file)}) expect_identical(readChar(file, 1000L), "\n") }) test_that("write_xml works with nodeset input and files", { x <- read_xml("") y <- xml_find_all(x, "//y") filename <- "../test.xml" on.exit(unlink(filename)) expect_error(write_xml(y, filename, options = "no_declaration"), "Can only save length 1 node sets") write_xml(y[1], filename, options = "no_declaration") expect_identical(readChar(filename, 1000L), "") }) test_that("write_xml works with nodeset input and connections", { x <- read_xml("") y <- xml_find_all(x, "//y") filename <- "../test.xml.gz" expect_error(write_xml(y, filename, options = "no_declaration"), "Can only save length 1 node sets") expect_error(write_xml(y[1], c(filename, "foo")), "`file` must be a non-zero character of length 1") write_xml(y[1], filename, options = "no_declaration") file <- gzfile(filename, "rb") on.exit({unlink(filename); close(file)}) expect_identical(readChar(file, 1000L), "") }) test_that("write_xml works with node input and files", { x <- read_xml("") y <- xml_find_first(x, "//y") filename <- "../test.xml" expect_error(write_xml(y, c(filename, "foo")), "`file` must be a non-zero character of length 1") write_xml(y, filename, options = "no_declaration") on.exit(unlink(filename)) expect_identical(readChar(filename, 1000L), "") }) test_that("write_xml works with node input and connections", { x <- read_xml("") y <- xml_find_first(x, "//y") filename <- "../test.xml.gz" write_xml(y, filename, options = "no_declaration") file <- gzfile(filename, "rb") on.exit({unlink(filename); close(file)}) expect_identical(readChar(file, 1000L), "") }) test_that("write_html work with html input", { x <- read_html("Foo") filename <- "../test.html.gz" write_html(x, filename) file <- gzfile(filename, "rb") on.exit({unlink(filename); close(file)}) expect_identical(readChar(file, 1000L), "\n\n\nFoo\n\n") }) xml2/tests/testthat/test-null.R0000644000175100001440000000506313022625753016237 0ustar hornikuserscontext("Null XPtr") data <- read_xml("ns-multiple.xml") tf <- tempfile() on.exit(unlink(tf)) saveRDS(data, file = tf) x <- readRDS(tf) test_that("accessors all fail rather than crash with NULL Xptrs", { expect_error(as_list(x), "external pointer is not valid") expect_error(html_structure(x), "external pointer is not valid") expect_error(xml_add_child(x, x), "external pointer is not valid") expect_error(xml_add_sibling(x, x), "external pointer is not valid") expect_error(xml_attr(x, "foo"), "external pointer is not valid") expect_error(xml_attr(x, "foo") <- "bar", "external pointer is not valid") expect_error(xml_attrs(x), "external pointer is not valid") expect_error(xml_attrs(x) <- list(), "external pointer is not valid") expect_error(xml_child(x), "external pointer is not valid") expect_error(xml_children(x), "external pointer is not valid") expect_error(xml_contents(x), "external pointer is not valid") expect_error(xml_double(x), "external pointer is not valid") expect_error(xml_find_all(x, ""), "external pointer is not valid") expect_error(xml_find_chr(x, ""), "external pointer is not valid") expect_error(xml_find_first(x, ""), "external pointer is not valid") expect_error(xml_find_lgl(x, ""), "external pointer is not valid") expect_error(xml_find_num(x, ""), "external pointer is not valid") expect_error(xml_has_attr(x, ""), "external pointer is not valid") expect_error(xml_integer(x), "external pointer is not valid") expect_error(xml_length(x), "external pointer is not valid") expect_error(xml_name(x), "external pointer is not valid") expect_error(xml_name(x) <- "foo", "external pointer is not valid") expect_error(xml_ns(x), "external pointer is not valid") expect_error(xml_ns_strip(x), "external pointer is not valid") expect_error(xml_parent(x), "external pointer is not valid") expect_error(xml_parents(x), "external pointer is not valid") expect_error(xml_path(x), "external pointer is not valid") expect_error(xml_remove(x), "external pointer is not valid") expect_error(xml_replace(x, x), "external pointer is not valid") expect_error(xml_set_namespace(x, "foo"), "external pointer is not valid") expect_error(xml_siblings(x), "external pointer is not valid") expect_error(xml_structure(x), "external pointer is not valid") expect_error(xml_text(x), "external pointer is not valid") expect_error(xml_text(x) <- "test", "external pointer is not valid") expect_error(xml_type(x), "external pointer is not valid") expect_error(xml_url(x), "external pointer is not valid") }) xml2/tests/testthat/test-xml_text.R0000644000175100001440000000407513024544315017127 0ustar hornikuserscontext("xml_text") test_that("xml_text returns only text without markup", { x <- read_xml("

This is some text. This is bold!

") expect_identical(xml_text(x), "This is some text. This is bold!") expect_identical(xml_text(xml_children(x)), "bold!") }) test_that("xml_text returns only text without markup", { x <- read_xml("

This is some text. This is bold!

") expect_identical(xml_text(x), "This is some text. This is bold!") expect_identical(xml_text(xml_children(x)), "bold!") }) test_that("xml_text works properly with xml_nodeset objects", { x <- read_xml("This is some text. This is some nested text.") expect_identical(xml_text(x), "This is some text. This is some nested text.") expect_identical(xml_text(xml_find_all(x, "//x")), c("This is some text. This is some nested text.", "This is some nested text.")) }) test_that("xml_text<- and xml_set_text work properly with xml_nodeset objects", { x <- read_xml("This is some text. This is some nested text.") expect_identical(xml_text(x), "This is some text. This is some nested text.") xml_text(x) <- "test" expect_identical(xml_text(x), "testThis is some nested text.") xml_set_text(x, "test2") expect_identical(xml_text(x), "test2This is some nested text.") }) test_that("xml_text trims whitespace if requested, including non-breaking spaces", { x <- read_html("

Some text €  

") expect_identical(xml_text(x), " Some text \u20ac \u00a0") expect_identical(xml_text(x, trim = TRUE), "Some text \u20ac") }) test_that("xml_integer() returns an integer vector", { x <- read_xml("") expect_identical(xml_integer(xml_find_all(x, "//@x")), c(1L, 2L)) }) test_that("xml_double() returns a numeric vector", { x <- read_xml("") expect_identical(xml_double(xml_find_all(x, "//@latitude")), c(42.3466456, -36.8523378)) }) xml2/tests/testthat/test-xml_attrs.R0000644000175100001440000001511513022625753017301 0ustar hornikuserscontext("xml_attrs") test_that("missing attributes returned as NA by default", { x <- read_xml("") expect_equal(xml_attr(x, "id"), NA_character_) }) test_that("missing attributes returned as NA", { x <- read_xml("") expect_equal(xml_attr(x, "id", default = 1), "1") }) test_that("attributes are correctly found", { x <- read_xml("") expect_true(xml_has_attr(x, "id")) expect_false(xml_has_attr(x, "id2")) }) test_that("returning an attribute node prints properly", { x <- read_xml("") t1 <- xml_find_first(x, "//@c") expect_equal(format(t1), "") }) # Namespaces ------------------------------------------------------------------- # Default namespace doesn't apply to attributes test_that("qualified names returned when ns given", { x <- read_xml("ns-multiple.xml") ns <- xml_ns(x) bars <- xml_children(xml_children(x)) attr <- xml_attrs(bars, ns) expect_equal(names(attr[[1]]), "f:id") expect_equal(names(attr[[2]]), "g:id") }) x <- read_xml(' ') doc <- xml_children(x)[[1]] docs <- xml_find_all(x, "//doc") ns <- xml_ns(x) test_that("qualified attributes get own values", { expect_equal(xml_attrs(doc, ns), c("b:id" = "b", "f:id" = "f", "id" = "")) }) test_that("unqualified name gets unnamespace attribute", { expect_equal(xml_attr(doc, "id", ns), "") }) test_that("namespace names gets namespaced attribute", { expect_equal(xml_attr(doc, "b:id", ns), "b") expect_equal(xml_attr(doc, "f:id", ns), "f") }) test_that("xml_attr<- modifies properties", { xml_attr(doc, "id", ns) <- "test" expect_equal(xml_attr(doc, "id", ns), "test") xml_attr(doc, "b:id", ns) <- "b_test" expect_equal(xml_attr(doc, "b:id", ns), "b_test") xml_attr(doc, "f:id", ns) <- "f_test" expect_equal(xml_attr(doc, "f:id", ns), "f_test") xml_attr(docs, "f:id", ns) <- "f_test2" expect_equal(xml_attr(docs, "f:id", ns), c("f_test2", "f_test2")) xml_attr(docs, "f:id", ns) <- NULL expect_equal(xml_attr(docs, "f:id", ns), c(NA_character_, NA_character_)) }) test_that("xml_attrs<- modifies all attributes", { expect_error(xml_attrs(doc) <- 1, "`value` must be a named character vector or `NULL`") expect_error(xml_attrs(doc) <- "test", "`value` must be a named character vector or `NULL`") xml_attrs(doc, ns) <- c("b:id" = "b", "f:id" = "f", "id" = "test") expect_equal(xml_attrs(doc, ns), c("b:id" = "b", "id" = "test", "f:id" = "f")) xml_attrs(doc, ns) <- c("b:id" = "b", "f:id" = "f") expect_equal(xml_attrs(doc, ns), c("b:id" = "b", "f:id" = "f")) xml_attrs(doc, ns) <- c("b:id" = "b", "id" = "test") expect_equal(xml_attrs(doc, ns), c("b:id" = "b", "id" = "test")) expect_error(xml_attrs(docs) <- "test", "`value` must be a list of named character vectors") xml_attrs(docs, ns) <- c("b:id" = "b", "id" = "test") expect_equal(xml_attrs(docs, ns), list( c("b:id" = "b", "id" = "test"), c("b:id" = "b", "id" = "test"))) xml_attrs(docs, ns) <- NULL expect_equivalent(xml_attrs(docs, ns), list(character(0), character(0))) }) test_that("xml_attr<- accepts non-character values", { x <- read_xml('') svg <- xml_root(x) xml_attr(svg, "width") <- 8L expect_that(xml_attr(svg, "width"), equals("8")) xml_attr(svg, "height") <- 12.5 expect_that(xml_attr(svg, "height"), equals("12.5")) expect_that(xml_attrs(svg), equals(c(width = "8", height = "12.5"))) xml_attrs(svg) <- c(width = 14L, height = 23.45) expect_that(xml_attrs(svg), equals(c(width = "14", height = "23.45"))) }) test_that("xml_attr<- removes namespaces if desired", { xml_attr(x, "xmlns:b") <- NULL expect_equal(xml_attrs(x), c("xmlns:f" = "http://foo.com")) }) test_that("xml_attr<- removes namespaces if desired", { x <- read_xml("") # cannot find //b with a default namespace expect_equal(length(xml_find_all(x, "//b")), 0) # unless we specify it explicitly expect_equal(length(xml_find_all(x, "//b")), 0) expect_equal(length(xml_find_all(x, "//d1:b", xml_ns(x))), 1) # but can find it once we remove the namespace xml_attr(x, "xmlns") <- NULL expect_equal(length(xml_find_all(x, "//b")), 1) # and add the old namespace back xml_attr(x, "xmlns") <- "tag:foo" expect_equal(xml_attr(x, "xmlns"), "tag:foo") expect_equal(length(xml_find_all(x, "//b")), 0) expect_equal(length(xml_find_all(x, "//d1:b", xml_ns(x))), 1) expect_equal(xml_attr(x, "xmlns"), "tag:foo") }) test_that("xml_attr<- removes prefixed namespaces if desired", { x <- read_xml("") # cannot find //b with a prefixed namespace expect_equal(length(xml_find_all(x, "//b")), 0) # unless we specify it explicitly expect_equal(length(xml_find_all(x, "//b")), 0) expect_equal(length(xml_find_all(x, "//pre:b", xml_ns(x))), 1) # but can find it once we remove the namespace xml_attr(x, "xmlns:pre") <- NULL expect_equal(length(xml_find_all(x, "//b")), 1) # and add the old namespace back xml_attr(x, "xmlns:pre") <- "tag:foo" xml_set_namespace(xml_children(x)[[1]], "pre") expect_equal(xml_attr(x, "xmlns:pre"), "tag:foo") expect_equal(length(xml_find_all(x, "//b")), 0) expect_equal(length(xml_find_all(x, "//pre:b", xml_ns(x))), 1) expect_equal(xml_attr(x, "xmlns:pre"), "tag:foo") }) test_that("xml_set_attr works identically to xml_attr<-", { content <- "" x <- read_xml(content) y <- read_xml(content) xml_attr(x, "a") <- "test" xml_set_attr(y, "a", "test") expect_equal(as.character(x), as.character(y)) bx <- xml_find_all(x, "//b") by <- xml_find_all(y, "//b") xml_attr(bx, "b") <- "test2" xml_set_attr(by, "b", "test2") expect_equal(as.character(x), as.character(y)) # No errors for xml_missing mss <- xml_find_first(bx, "./c") expect_error(xml_attr(mss[[2]], "b") <- "blah", NA) expect_error(xml_set_attr(mss[[2]], "b", "blah"), NA) }) test_that("xml_set_attrs works identically to xml_attrs<-", { content <- "" x <- read_xml(content) y <- read_xml(content) xml_attrs(x) <- c(a = "test") xml_set_attrs(y, c(a = "test")) expect_equal(as.character(x), as.character(y)) bx <- xml_find_all(x, "//b") by <- xml_find_all(y, "//b") xml_attrs(bx) <- c(b = "test2") xml_set_attrs(by, c(b = "test2")) expect_equal(as.character(x), as.character(y)) # No errors for xml_missing mss <- xml_find_first(bx, "./c") expect_error(xml_attrs(mss[[2]]) <- c("b" = "blah"), NA) expect_error(xml_set_attrs(mss[[2]], c("b" = "blah")), NA) }) xml2/tests/testthat/test-comment.R0000644000175100001440000000040213033457452016720 0ustar hornikuserscontext("comment") test_that("Comment creation works", { x <- xml_new_root("root") xml_add_child(x, xml_comment("Hello!")) expect_identical("\n\n", as.character(x, options = "")) }) xml2/tests/testthat/output/0000755000175100001440000000000013033275002015507 5ustar hornikusersxml2/tests/testthat/output/print-xml_nodeset.txt0000644000175100001440000000137113033457602021735 0ustar hornikusers{xml_nodeset (10)} [1]
\n
\n\n