set perl parameter to TRUE

Author: Larefly

paws.common/DESCRIPTION

@@ -17,6 +17,7 @@ License: Apache License (>= 2.0)
 Encoding: UTF-8
 Imports:
     base64enc,
+    curl,
     digest,
     httr,
     jsonlite,

paws.common/NAMESPACE

@@ -24,3 +24,4 @@ export(tag_get)
 export(tag_get_all)
 export(tag_has)
 export(type)
+importFrom(curl,curl_unescape)

paws.common/R/handlers_rest.R

@@ -1,3 +1,5 @@
+#' @include url.R
+
 # Build a request for the REST protocol.
 rest_build <- function(request) {
   if (params_filled(request)) {
@@ -227,10 +229,10 @@ clean_path <- function(url) {
 
 # Return a string with special characters escaped, e.g. " " -> "%20".
 escape_path <- function(string, encode_sep) {
-  path <- utils::URLencode(string, TRUE)
-  if (!encode_sep) {
-    path <- gsub("%2F", "/", path)
+  if(!encode_sep){
+    base_url_encode <- paste0("/", base_url_encode)
   }
+  path <- paws_url_encoder(string, paste0("[^", base_url_encode, "]"))
   return(path)
 }
 

paws.common/R/url.R

@@ -1,6 +1,8 @@
 #' @include struct.R
 NULL
 
+#' @importFrom curl curl_unescape
+
 # A Url object stores a parse URL.
 Url <- struct(
   scheme = "",
@@ -109,7 +111,6 @@ query_escape <- function(string) {
 # Escape strings so they can be safely included in a URL.
 escape <- function(string, mode){
   # base characters that won't be encoded
-  base_url_encode <- "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789._~-"
   if (mode == "encodeHost" || mode == "encodeZone") {
     # host and zone characters that won't be encoded
     host_zone_pattern = "][!$&'()*+,;=:<>\""
@@ -140,71 +141,49 @@ escape <- function(string, mode){
     escape_string <- paws_url_encoder(string, paste0("[^", base_url_encode, "]"))
 
     # replace whitespace encoding from %20 to +
-    return(gsub("%20", "+", escape_string, fixed =T))
+    return(gsub("%20", "+", escape_string, fixed = TRUE))
   }
   if (mode == "encodeFragment") {
     return(paws_url_encoder(string, paste0("[^", pattern, "]")))
   }
-  return(utils::URLencode(string, reserved = TRUE))
+  return(paws_url_encoder(string, paste0("[^", base_url_encode, "]")))
+}
+
+base_url_encode <- "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789._~-"
+
+is.ascii <- function(string){
+  return(string == iconv(string, "latin1", "ASCII", sub=""))
 }
 
 # Escape characters given a pattern
 paws_url_encoder <- function(string, pattern){
   vapply(string, function(string){
     # split string out into individual characters
-    chars <- strsplit(string, "")[[1L]]
+    chars <- strsplit(string, "", perl = TRUE)[[1L]]
     # find characters that match pattern
-    found <- grep(pattern, chars)
+    found <- grep(pattern, chars, perl = TRUE)
     if (length(found)) {
-      # encode found characters only
-      chars[found] <- toupper(paste0("%", charToRaw(string)[found]))
+      # check if string is ascii
+      if(is.ascii(string)){
+        # encode found characters only
+        chars[found] <- toupper(paste0("%", charToRaw(string)[found]))
+      } else {
+        # group encoded part of non-ascii character:
+        # e.g. "界" -> "%E7%95%8C"
+        chars[found] <- vapply(chars[found], function(char) {
+            toupper(paste0("%", charToRaw(char), collapse = ""))
+          }, character(1))
+      }
     }
     # rebuild string with encoded characters
     paste(chars, collapse = "")
   }, character(1), USE.NAMES = FALSE)
 }
 
-# decode encoded url strings
-paws_url_decoder <- function(URL) {
-  vapply(URL, function(url){
-    # split string into separate characters
-    chars <- strsplit(url, "")[[1]]
-
-    # locate % position
-    found <- grep("%", chars, fixed = TRUE)
-
-    if (length(found)) {
-      start <- found + 1
-      end <- found + 2
-
-      # get raw vector of encoded parts (character form)
-      # for example: "%20" -> "20"
-      encoded <- vapply(seq_along(start), function(i) {
-          paste0(chars[start[i]:end[i]], collapse = "")
-        }, FUN.VALUE = character(1)
-      )
-      # remove encoded parts from chars
-      rm <- c(start, end)
-
-      # update character % position
-      found <- grep("%", chars[-rm], fixed = TRUE)
-
-      # convert split url to raw
-      char_raw <- charToRaw(paste(chars[-rm], collapse=""))
-
-      # replace character % with decoded parts
-      char_raw[found] <- as.raw(as.hexmode(encoded))
-
-      return(rawToChar(char_raw))
-    }
-    return(url)
-  }, character(1),  USE.NAMES = FALSE)
-}
-
 # Un-escape a string.
 # TODO: Complete.
 unescape <- function(string) {
-  return(paws_url_decoder(string))
+  return(curl_unescape(string))
 }
 
 # The inverse of query_escape: convert the encoded string back to the original,

paws.common/tests/testthat/test_escape.R

@@ -18,13 +18,23 @@ test_that("check all escape modes", {
   }
 })
 
+test_that("check if non-ascci characters are correctly encoded", {
+  string <- "なでçãкатынü"
+  pattern <- paste0("[^", base_url_encode, "]")
+  actual = paws_url_encoder(string, pattern)
+  expect_equal(
+    actual,
+    "%E3%81%AA%E3%81%A7%C3%A7%C3%A3%D0%BA%D0%B0%D1%82%D1%8B%D0%BD%C3%BC"
+  )
+})
+
 test_that("check if encoded url is correctly decoded", {
   string <- "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-._~`!@#$%^&*()=+[{]}\\|;:'\",<>/? "
   pattern <- "[^ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789._~-]"
 
   url = paste(sample(strsplit(string, "")[[1]], 1e6, replace = T), collapse = "")
   url_encode = paws_url_encoder(url, pattern)
-  actual = paws_url_decoder(url_encode)
+  actual = unescape(url_encode)
 
   expect_equal(actual, url)
 })
@@ -35,7 +45,7 @@ test_that("check if non-encoded url is correctly decoded", {
 
   url = paste(sample(strsplit(string, "")[[1]], 1e6, replace = T), collapse = "")
   url_encode = paws_url_encoder(url, pattern)
-  actual = paws_url_decoder(url_encode)
+  actual = unescape(url_encode)
 
   expect_equal(actual, url)
 })