add function to get service url

ialyabiev · Oct 4, 2013 · 4705425 · 4705425
1 parent e4f32b6
commit 4705425
Showing 1 changed file with 20 additions and 0 deletions.
diff --git a/R/http.R b/R/http.R
@@ -4,6 +4,26 @@ userAgent <- function() {
   paste("shinyapps", packageVersion("shinyapps"), sep="/")
 }
 
+serviceUrl <- function() {
+  parseHttpUrl(getOption("shinyapps.service_url", 
+                         "https://api.shinyapps.io/v1"))
+}
+
+parseHttpUrl <- function(urlText) {
+
+  matches <- regexec("(http|https)://([^:/#?]+)(?::(\\d+))?(.*)", urlText)
+  components <- regmatches(urlText, matches)[[1]]
+  if (length(components) == 0)
+    stop("Invalid url: ", urlText)
+
+  url <- list()
+  url$protocol <- components[[2]]
+  url$host <- components[[3]]
+  url$port <- components[[4]]
+  url$path <- components[[5]]
+  url
+}
+
 parseHttpHeader <- function(header) {
   split <- strsplit(header, ": ")[[1]]
   if (length(split) == 2)