1getRelativeURL =
2  #
3  #  takes the name of a file/URL and a baseURL and
4  # figures out the URL for the new file given by u.
5  # This handles the case where the file/URL is relative to the
6  # the baseURL or if it is a fully qualified file or URL.
7
8  #
9  #  getRelativeURL("/foo", "http://www.omegahat.net")
10  #  getRelativeURL("/foo", "http://www.omegahat.net/")
11  #  getRelativeURL("foo", "http://www.omegahat.net/")
12  #  getRelativeURL("http://www.foo.org", "http://www.omegahat.net/")
13  #
14  # XXX test - baseURL with /path/ and u as /other/path. Looks okay. See
15  # ParsingStrategies example for kaggle.
16  #   getRelativeURL("../foo/xyz/bar.html", "http://www.omegahat.net/a/b.html")
17  # getRelativeURL("./foo/xyz/bar.html", "http://www.omegahat.net/a/b.html")
18  #  getRelativeURL("../foo/xyz/bar.html", "http://www.omegahat.net/a/b.html")
19  #
20  #
21  #  BROKEN
22  #   getRelativeURL("foo", ".")   yields :///foo
23  #
24  #
25  # [Fixed] not working for ../...
26  #  fails
27  #    getRelativeURL("../foo", "http://www.omegahat.net/a/b.html")
28  # should be http://www.omegahat.net/foo
29  # or at least http://www.omegahat.net/a/../foo
30function(u, baseURL, sep = "/", addBase = TRUE, simplify = TRUE, escapeQuery = FALSE)
31{
32   if(length(u) > 1)
33     return(sapply(u, getRelativeURL, baseURL, sep))
34
35   pu = parseURI(u)
36   #XXX Need to strip the path in baseURL if pu$path starts with /
37   if(pu$scheme == "" && addBase) {
38      b = parseURI(baseURL)
39      b$query = ""
40      if(grepl("^/", pu$path)) {
41        b$path = u
42        return(as(b, "character"))
43      }
44
45
46      endsWithSlash = grepl("/$", b$path)
47
48      if(endsWithSlash && grepl("^\\./", u))
49          u = substring(u, 3)
50
51      b$path = sprintf("%s%s%s", if(endsWithSlash) b$path else dirname(b$path), if(endsWithSlash) "" else sep, u)
52        # handle .. in the path and try to collapse these.
53      if(simplify && grepl("..", b$path, fixed = TRUE))
54        b$path = simplifyPath(b$path)
55
56      return(as(b, "character"))
57#      b = as(b, "character")
58#      sprintf("%s%s%s", b, "" else sep, u)
59   } else
60      u
61}
62
63