Merge pull request #62 from schochastics/get_basename

added basename (fix #56)

R/get.R

@@ -23,6 +23,7 @@
 #' ada_get_search(url)
 #' ada_get_protocol(url)
 #' ada_get_domain(url)
+#' ada_get_basename(url)
 #' ## these functions are vectorized
 #' urls <- c("http://www.google.com", "http://www.google.com:80", "noturl")
 #' ada_get_port(urls)
@@ -115,3 +116,15 @@ ada_get_domain <- function(url, decode = TRUE) {
     }
     return(res)
 }
+
+#' @rdname ada_get_href
+#' @export
+ada_get_basename <- function(x) {
+    protocol <- ada_get_protocol(x)
+    not_na <- !is.na(protocol)
+    tmp <- protocol[not_na]
+    host <- ada_get_hostname(x[not_na])
+    basename <- rep(NA_character_, length(x))
+    basename[not_na] <- paste0(tmp, "//", host)
+    basename
+}

tests/testthat/test-get.R

@@ -10,11 +10,13 @@ test_that("all get functions work", {
     expect_equal(ada_get_search(url), "?q=1")
     expect_equal(ada_get_hash(url), "#frag")
     expect_equal(ada_get_protocol(url), "https:")
+    expect_equal(ada_get_domain(url), "example.org")
+    expect_equal(ada_get_basename(url), "https://example.org")
 })
 
 get_functions <- c(
     ada_get_href, ada_get_username, ada_get_password, ada_get_host, ada_get_hostname, ada_get_port, ada_get_pathname,
-    ada_get_search, ada_get_hash, ada_get_protocol
+    ada_get_search, ada_get_hash, ada_get_protocol, ada_get_domain, ada_get_basename
 )
 
 test_that("invalid urls should return NA, #26", {