1
###########################################################################/**
2
# @RdocDefault splitUrl
3
#
4
# @title "Decomposes a URL into its components"
5
#
6
# \description{
7
#  @get "title".
8
# }
9
#
10
# @synopsis
11
#
12
# \arguments{
13
#   \item{url}{A @character string.}
14
#   \item{...}{Not used.}
15
# }
16
#
17
# \value{
18
#  Returns a named @list of URL components.
19
# }
20
#
21
# @author
22
#
23
# \references{
24
#  [1] \url{https://www.wikipedia.org/wiki/URI_scheme}
25
# }
26
#
27
# @keyword IO
28
# @keyword programming
29
# @keyword internal
30
#*/###########################################################################
31
setMethodS3("splitUrl", "default", function(url, ...) {
32
  # Argument 'url':
33 0
  url <- Arguments$getCharacter(url, asGString=FALSE)
34 0
  if (length(url) == 0L) {
35 0
    return(NULL)
36
  }
37

38 0
  if (!hasUrlProtocol(url)) {
39 0
    throw("Can not split URL. Not a valid URL: ", url)
40
  }
41

42
  # Get the protocol
43 0
  pattern <- "^([abcdefghijklmnopqrstuvwxyz]+)(://)(.*)"
44 0
  protocol <- gsub(pattern, "\\1", url, ignore.case=TRUE)
45 0
  tail <- gsub(pattern, "\\3", url, ignore.case=TRUE)
46

47 0
  host <- NULL
48 0
  path <- NULL
49 0
  query <- NULL
50 0
  fragment <- NULL
51 0
  parameters <- NULL
52

53
  # Get the host
54 0
  parts <- strsplit(tail, split="/", fixed=TRUE)[[1L]]
55 0
  if (length(parts) > 0L) {
56 0
    host <- parts[1L]
57 0
    tail <- paste(parts[-1L], collapse="/")
58

59
    # Get the path
60 0
    parts <- strsplit(tail, split="?", fixed=TRUE)[[1L]]
61 0
    if (length(parts) > 0L) {
62 0
      path <- parts[1L]
63 0
      tail <- paste(parts[-1L], collapse="/")
64

65
      # Get the query and fragment
66 0
      parts <- strsplit(tail, split="#", fixed=TRUE)[[1L]]
67 0
      query <- parts[1L]
68 0
      fragment <- paste(parts[-1L], collapse="#")
69

70
      # Get the parameters
71 0
      parts <- strsplit(query, split="&", fixed=TRUE)[[1L]]
72 0
      if (length(parts) > 0L) {
73 0
        parts <- strsplit(parts, split="=", fixed=TRUE)
74 0
        if (length(parts) > 0L) {
75 0
          names <- unlist(lapply(parts, FUN=function(x) x[1L]), use.names=FALSE)
76 0
          parameters <- lapply(parts, FUN=function(x) paste(x[-1L], collapse="="))
77 0
          names(parameters) <- names
78
        }
79
      }
80
    }
81
  }
82

83 0
  list(protocol=protocol, host=host, path=path,
84 0
       query=query, fragment=fragment, parameters=parameters)
85
})

Read our documentation on viewing source code .

Loading