Skip to content

Commit 48ab979

Browse files
mgirlichmgirlich
committed
Migrate xml2_url.cpp 
1 parent 1fd06ac commit 48ab979

File tree

4 files changed

+95
-106
lines changed

4 files changed

+95
-106
lines changed

‎src/cpp11.cpp

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -405,38 +405,38 @@ extern "C" SEXP _xml2_doc_validate(SEXP doc_sxp, SEXP schema_sxp) {
405405
END_CPP11
406406
}
407407
// xml2_url.cpp
408-
extern "C" SEXP url_absolute_(SEXP x_sxp, SEXP base_sxp);
408+
cpp11::strings url_absolute_(cpp11::strings x_sxp, cpp11::strings base_sxp);
409409
extern "C" SEXP _xml2_url_absolute_(SEXP x_sxp, SEXP base_sxp) {
410410
BEGIN_CPP11
411-
return cpp11::as_sexp(url_absolute_(cpp11::as_cpp<cpp11::decay_t<SEXP>>(x_sxp), cpp11::as_cpp<cpp11::decay_t<SEXP>>(base_sxp)));
411+
return cpp11::as_sexp(url_absolute_(cpp11::as_cpp<cpp11::decay_t<cpp11::strings>>(x_sxp), cpp11::as_cpp<cpp11::decay_t<cpp11::strings>>(base_sxp)));
412412
END_CPP11
413413
}
414414
// xml2_url.cpp
415-
extern "C" SEXP url_relative_(SEXP x_sxp, SEXP base_sxp);
415+
cpp11::strings url_relative_(cpp11::strings x_sxp, cpp11::strings base_sxp);
416416
extern "C" SEXP _xml2_url_relative_(SEXP x_sxp, SEXP base_sxp) {
417417
BEGIN_CPP11
418-
return cpp11::as_sexp(url_relative_(cpp11::as_cpp<cpp11::decay_t<SEXP>>(x_sxp), cpp11::as_cpp<cpp11::decay_t<SEXP>>(base_sxp)));
418+
return cpp11::as_sexp(url_relative_(cpp11::as_cpp<cpp11::decay_t<cpp11::strings>>(x_sxp), cpp11::as_cpp<cpp11::decay_t<cpp11::strings>>(base_sxp)));
419419
END_CPP11
420420
}
421421
// xml2_url.cpp
422-
extern "C" SEXP url_parse_(SEXP x_sxp);
422+
cpp11::data_frame url_parse_(cpp11::strings x_sxp);
423423
extern "C" SEXP _xml2_url_parse_(SEXP x_sxp) {
424424
BEGIN_CPP11
425-
return cpp11::as_sexp(url_parse_(cpp11::as_cpp<cpp11::decay_t<SEXP>>(x_sxp)));
425+
return cpp11::as_sexp(url_parse_(cpp11::as_cpp<cpp11::decay_t<cpp11::strings>>(x_sxp)));
426426
END_CPP11
427427
}
428428
// xml2_url.cpp
429-
extern "C" SEXP url_escape_(SEXP x_sxp, SEXP reserved_sxp);
429+
cpp11::strings url_escape_(cpp11::strings x_sxp, cpp11::strings reserved_sxp);
430430
extern "C" SEXP _xml2_url_escape_(SEXP x_sxp, SEXP reserved_sxp) {
431431
BEGIN_CPP11
432-
return cpp11::as_sexp(url_escape_(cpp11::as_cpp<cpp11::decay_t<SEXP>>(x_sxp), cpp11::as_cpp<cpp11::decay_t<SEXP>>(reserved_sxp)));
432+
return cpp11::as_sexp(url_escape_(cpp11::as_cpp<cpp11::decay_t<cpp11::strings>>(x_sxp), cpp11::as_cpp<cpp11::decay_t<cpp11::strings>>(reserved_sxp)));
433433
END_CPP11
434434
}
435435
// xml2_url.cpp
436-
extern "C" SEXP url_unescape_(SEXP x_sxp);
436+
cpp11::strings url_unescape_(cpp11::strings x_sxp);
437437
extern "C" SEXP _xml2_url_unescape_(SEXP x_sxp) {
438438
BEGIN_CPP11
439-
return cpp11::as_sexp(url_unescape_(cpp11::as_cpp<cpp11::decay_t<SEXP>>(x_sxp)));
439+
return cpp11::as_sexp(url_unescape_(cpp11::as_cpp<cpp11::decay_t<cpp11::strings>>(x_sxp)));
440440
END_CPP11
441441
}
442442
// xml2_xpath.cpp

‎src/xml2_url.cpp

Lines changed: 59 additions & 84 deletions
Original file line numberDiff line numberDiff line change
@@ -7,152 +7,127 @@
77
#include <libxml/uri.h>
88
#include "xml2_utils.h"
99

10-
[[cpp11::register]]
11-
extern "C" SEXP url_absolute_(SEXP x_sxp, SEXP base_sxp) {
12-
R_xlen_t n = Rf_xlength(x_sxp);
13-
SEXP out = PROTECT(Rf_allocVector(STRSXP, n));
14-
15-
if (Rf_xlength(base_sxp) > 1) {
16-
Rf_error("Base URL must be length 1");
10+
const xmlChar* to_xml_chr(cpp11::strings x, const char* arg) {
11+
if (x.size() > 1) {
12+
cpp11::stop("%s must be a character vector of length 1", arg);
1713
}
1814

19-
const xmlChar* base_uri = (xmlChar*) Rf_translateCharUTF8(STRING_ELT(base_sxp, 0));
15+
return (xmlChar*) cpp11::as_cpp<const char*>(x);
16+
}
17+
18+
[[cpp11::register]]
19+
cpp11::strings url_absolute_(cpp11::strings x_sxp, cpp11::strings base_sxp) {
20+
int n = x_sxp.size();
21+
cpp11::writable::strings out(n);
22+
23+
const xmlChar* base_uri = to_xml_chr(base_sxp, "Base URL");
2024

2125
for (int i = 0; i < n; ++i) {
22-
const xmlChar* uri = (xmlChar*) Rf_translateCharUTF8(STRING_ELT(x_sxp, i));
23-
SET_STRING_ELT(out, i, Xml2String(xmlBuildURI(uri, base_uri)).asRString());
26+
const xmlChar* uri = (xmlChar*) Rf_translateCharUTF8(x_sxp[i]);
27+
out[i] = Xml2String(xmlBuildURI(uri, base_uri)).asRString();
2428
}
2529

26-
UNPROTECT(1);
2730
return out;
2831
}
2932

3033
[[cpp11::register]]
31-
extern "C" SEXP url_relative_(SEXP x_sxp, SEXP base_sxp) {
32-
R_xlen_t n = Rf_xlength(x_sxp);
33-
SEXP out = PROTECT(Rf_allocVector(STRSXP, n));
34-
35-
if (Rf_xlength(base_sxp) > 1) {
36-
Rf_error("Base URL must be length 1");
37-
}
34+
cpp11::strings url_relative_(cpp11::strings x_sxp, cpp11::strings base_sxp) {
35+
int n = x_sxp.size();
36+
cpp11::writable::strings out(n);
3837

39-
const xmlChar* base_uri = (xmlChar*) Rf_translateCharUTF8(STRING_ELT(base_sxp, 0));
38+
const xmlChar* base_uri = to_xml_chr(base_sxp, "Base URL");
4039

4140
for (int i = 0; i < n; ++i) {
42-
const xmlChar* uri = (xmlChar*) Rf_translateCharUTF8(STRING_ELT(x_sxp, i));
43-
SET_STRING_ELT(out, i, Xml2String(xmlBuildRelativeURI(uri, base_uri)).asRString());
41+
const xmlChar* uri = (xmlChar*) Rf_translateCharUTF8(x_sxp[i]);
42+
out[i] = Xml2String(xmlBuildRelativeURI(uri, base_uri)).asRString();
4443
}
4544

46-
UNPROTECT(1);
4745
return out;
4846
}
4947

5048
[[cpp11::register]]
51-
extern "C" SEXP url_parse_(SEXP x_sxp) {
52-
R_xlen_t n = Rf_xlength(x_sxp);
49+
cpp11::data_frame url_parse_(cpp11::strings x_sxp) {
50+
int n = x_sxp.size();
5351

54-
SEXP scheme = PROTECT(Rf_allocVector(STRSXP, n));
55-
SEXP server = PROTECT(Rf_allocVector(STRSXP, n));
56-
SEXP user = PROTECT(Rf_allocVector(STRSXP, n));
57-
SEXP path = PROTECT(Rf_allocVector(STRSXP, n));
58-
SEXP query = PROTECT(Rf_allocVector(STRSXP, n));
59-
SEXP fragment = PROTECT(Rf_allocVector(STRSXP, n));
52+
cpp11::writable::strings scheme(n);
53+
cpp11::writable::strings server(n);
54+
cpp11::writable::strings user(n);
55+
cpp11::writable::strings path(n);
56+
cpp11::writable::strings query(n);
57+
cpp11::writable::strings fragment(n);
6058

61-
SEXP port = PROTECT(Rf_allocVector(INTSXP, n));
59+
cpp11::writable::integers port(n);
6260

6361
for (int i = 0; i < n; ++i) {
64-
const char* raw = Rf_translateCharUTF8(STRING_ELT(x_sxp, i));
62+
const char* raw = Rf_translateCharUTF8(x_sxp[i]);
6563
xmlURI* uri = xmlParseURI(raw);
6664
if (uri == NULL) {
6765
continue;
6866
}
6967

70-
SET_STRING_ELT(scheme, i, Rf_mkChar(uri->scheme == NULL ? "" : uri->scheme));
71-
SET_STRING_ELT(server, i, Rf_mkChar(uri->server == NULL ? "" : uri->server));
72-
INTEGER(port)[i] = uri->port == 0 ? NA_INTEGER : uri->port;
73-
SET_STRING_ELT(user, i, Rf_mkChar(uri->user == NULL ? "" : uri->user));
74-
SET_STRING_ELT(path, i, Rf_mkChar(uri->path == NULL ? "" : uri->path));
75-
SET_STRING_ELT(fragment, i, Rf_mkChar(uri->fragment == NULL ? "" : uri->fragment));
68+
scheme[i] = uri->scheme == NULL ? "" : uri->scheme;
69+
server[i] = uri->server == NULL ? "" : uri->server;
70+
port[i] = uri->port == 0 ? NA_INTEGER : uri->port;
71+
user[i] = uri->user == NULL ? "" : uri->user;
72+
path[i] = uri->path == NULL ? "" : uri->path;
73+
fragment[i] = uri->fragment == NULL ? "" : uri->fragment;
7674

7775
/* * *
7876
* Thu Apr 26 10:36:26 CEST 2007 Daniel Veillard
7977
* svn path=/trunk/; revision=3607
8078
* https://github.com/GNOME/libxml2/commit/a1413b84f7163d57c6251d5f4251186368efd859
8179
*/
8280
#if defined(LIBXML_VERSION) && (LIBXML_VERSION >= 20629)
83-
SET_STRING_ELT(query, i, Rf_mkChar(uri->query_raw == NULL ? "" : uri->query_raw));
81+
query[i] = uri->query_raw == NULL ? "" : uri->query_raw;
8482
#else
85-
SET_STRING_ELT(query, i, Rf_mkChar(uri->query == NULL ? "" : uri->query));
83+
query[i] = uri->query == NULL ? "" : uri->query;
8684
#endif
8785

8886
xmlFreeURI(uri);
8987
}
9088

91-
SEXP out = PROTECT(Rf_allocVector(VECSXP, 7));
92-
SET_VECTOR_ELT(out, 0, scheme);
93-
SET_VECTOR_ELT(out, 1, server);
94-
SET_VECTOR_ELT(out, 2, port);
95-
SET_VECTOR_ELT(out, 3, user);
96-
SET_VECTOR_ELT(out, 4, path);
97-
SET_VECTOR_ELT(out, 5, query);
98-
SET_VECTOR_ELT(out, 6, fragment);
99-
100-
SEXP names = PROTECT(Rf_allocVector(STRSXP, 7));
101-
102-
SET_STRING_ELT(names, 0, Rf_mkChar("scheme"));
103-
SET_STRING_ELT(names, 1, Rf_mkChar("server"));
104-
SET_STRING_ELT(names, 2, Rf_mkChar("port"));
105-
SET_STRING_ELT(names, 3, Rf_mkChar("user"));
106-
SET_STRING_ELT(names, 4, Rf_mkChar("path"));
107-
SET_STRING_ELT(names, 5, Rf_mkChar("query"));
108-
SET_STRING_ELT(names, 6, Rf_mkChar("fragment"));
109-
110-
Rf_setAttrib(out, R_ClassSymbol, Rf_mkString("data.frame"));
111-
Rf_setAttrib(out, R_NamesSymbol, names);
89+
using namespace cpp11::literals;
11290

113-
SEXP row_names = PROTECT(Rf_allocVector(INTSXP, 2));
114-
INTEGER(row_names)[0] = NA_INTEGER;
115-
INTEGER(row_names)[1] = -n;
116-
Rf_setAttrib(out, R_RowNamesSymbol, row_names);
117-
118-
UNPROTECT(10);
91+
cpp11::writable::data_frame out({
92+
"scheme"_nm = scheme,
93+
"server"_nm = server,
94+
"port"_nm = port,
95+
"user"_nm = user,
96+
"path"_nm = path,
97+
"query"_nm = query,
98+
"fragment"_nm = fragment,
99+
});
119100

120101
return out;
121102
}
122103

123104
[[cpp11::register]]
124-
extern "C" SEXP url_escape_(SEXP x_sxp, SEXP reserved_sxp) {
125-
R_xlen_t n = Rf_xlength(x_sxp);
126-
SEXP out = PROTECT(Rf_allocVector(STRSXP, n));
127-
128-
if (Rf_xlength(reserved_sxp) != 1) {
129-
Rf_error("`reserved` must be character vector of length 1");
130-
}
105+
cpp11::strings url_escape_(cpp11::strings x_sxp, cpp11::strings reserved_sxp) {
106+
int n = x_sxp.size();
107+
cpp11::writable::strings out(n);
131108

132-
xmlChar* xReserved = (xmlChar*) Rf_translateCharUTF8(STRING_ELT(reserved_sxp, 0));
109+
const xmlChar* xReserved = to_xml_chr(reserved_sxp, "`reserved`");
133110

134111
for (int i = 0; i < n; ++i) {
135-
const xmlChar* xx = (xmlChar*) Rf_translateCharUTF8(STRING_ELT(x_sxp, i));
136-
SET_STRING_ELT(out, i, Xml2String(xmlURIEscapeStr(xx, xReserved)).asRString());
112+
const xmlChar* xx = (xmlChar*) Rf_translateCharUTF8(x_sxp[i]);
113+
out[i] = Xml2String(xmlURIEscapeStr(xx, xReserved)).asRString();
137114
}
138115

139-
UNPROTECT(1);
140116
return out;
141117
}
142118

143119
[[cpp11::register]]
144-
extern "C" SEXP url_unescape_(SEXP x_sxp) {
145-
R_xlen_t n = Rf_xlength(x_sxp);
146-
SEXP out = PROTECT(Rf_allocVector(STRSXP, n));
120+
cpp11::strings url_unescape_(cpp11::strings x_sxp) {
121+
int n = x_sxp.size();
122+
cpp11::writable::strings out(n);
147123

148124
for (int i = 0; i < n; ++i) {
149-
const char* xx = Rf_translateCharUTF8(STRING_ELT(x_sxp, i));
125+
const char* xx = Rf_translateCharUTF8(x_sxp[i]);
150126

151127
char* unescaped = xmlURIUnescapeString(xx, 0, NULL);
152-
SET_STRING_ELT(out, i, (unescaped == NULL) ? NA_STRING : Rf_mkCharCE(unescaped, CE_UTF8));
128+
out[i] = (unescaped == NULL) ? cpp11::na<cpp11::r_string>() : cpp11::r_string(unescaped);
153129
xmlFree(unescaped);
154130
}
155131

156-
UNPROTECT(1);
157132
return out;
158133
}

‎tests/testthat/_snaps/xml_url.md

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
# url_absolute
2+
3+
Code
4+
url_absolute(c(".", "..", "/", "/x"), c("http://hadley.nz/a/b/c/d",
5+
"http://foo.bar"))
6+
Condition
7+
Error:
8+
! Base URL must be a character vector of length 1
9+
10+
# url_escape
11+
12+
Code
13+
url_escape("a b c", reserved = c("a", "b"))
14+
Condition
15+
Error:
16+
! `reserved` must be a character vector of length 1
17+

‎tests/testthat/test-xml_url.R

Lines changed: 9 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -4,10 +4,9 @@ test_that("url_absolute", {
44
c("http://hadley.nz/a/b/c/", "http://hadley.nz/a/b/", "http://hadley.nz/", "http://hadley.nz/x")
55
)
66

7-
expect_error(
8-
url_absolute(c(".", "..", "/", "/x"), c("http://hadley.nz/a/b/c/d", "http://foo.bar")),
9-
"Base URL must be length 1"
10-
)
7+
expect_snapshot(error = TRUE, {
8+
url_absolute(c(".", "..", "/", "/x"), c("http://hadley.nz/a/b/c/d", "http://foo.bar"))
9+
})
1110
})
1211

1312
test_that("url_relative", {
@@ -34,10 +33,9 @@ test_that("url_relative", {
3433
"../c"
3534
)
3635

37-
expect_error(
38-
url_relative("http://hadley.nz/a/c", c("http://hadley.nz/a/b/c/d", "http://foo.bar")),
39-
"Base URL must be length 1"
40-
)
36+
expect_snapshot(error = TRUE, {
37+
url_relative("http://hadley.nz/a/c", c("http://hadley.nz/a/b/c/d", "http://foo.bar"))
38+
})
4139
})
4240

4341
test_that("url_parse", {
@@ -75,10 +73,9 @@ test_that("url_parse", {
7573
})
7674

7775
test_that("url_escape", {
78-
expect_error(
79-
url_escape("a b c", reserved = c("a", "b")),
80-
"`reserved` must be character vector of length 1"
81-
)
76+
expect_snapshot(error = TRUE, {
77+
url_escape("a b c", reserved = c("a", "b"))
78+
})
8279

8380
expect_equal(
8481
url_escape("a b c"),

0 commit comments

Comments
 (0)