Extract functions for getting URLs from DESCRIPTION fields.

git-svn-id: https://svn.r-project.org/R/trunk@86599 00db46b3-68df-0310-9c12-caf00c1e9a41

src/library/tools/R/urltools.R

@@ -188,35 +188,52 @@ function(meta)
     fields <- c("URL", "BugReports")
     for(v in meta[fields]) {
         if(is.na(v)) next
-        pattern <-
-            "<(URL: *)?((https?|ftp)://[^[:space:],]*)[[:space:]]*>"
-        m <- gregexpr(pattern, v)
-        urls <- c(urls, .gregexec_at_pos(pattern, v, m, 3L))
-        regmatches(v, m) <- ""
-        pattern <- "(^|[^>\"])((https?|ftp)://[^[:space:],]*)"
-        m <- gregexpr(pattern, v)
-        urls <- c(urls, .gregexec_at_pos(pattern, v, m, 3L))
+        urls <- c(urls, .get_urls_from_DESCRIPTION_URL_field(v))
     }
     if(!is.na(v <- meta["Description"])) {
-        pattern <-
-            "<(URL: *)?((https?|ftp)://[^[:space:]]+)[[:space:]]*>"
-        m <- gregexpr(pattern, v)
-        urls <- c(urls, .gregexec_at_pos(pattern, v, m, 3L))
-        regmatches(v, m) <- ""
-        pattern <-
-            "([^>\"])((https?|ftp)://[[:alnum:]/.:@+\\_~%#?=&;,-]+[[:alnum:]/])"
-        m <- gregexpr(pattern, v)
-        urls <- c(urls, .gregexec_at_pos(pattern, v, m, 3L))
-        regmatches(v, m) <- ""
-        pattern <- "<([A-Za-z][A-Za-z0-9.+-]*:[^>]+)>"
-        ##   scheme      = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." )
-        m <- gregexpr(pattern, v)
-        urls <- c(urls, .gregexec_at_pos(pattern, v, m, 2L))
+        urls <- c(urls, .get_urls_from_DESCRIPTION_Description_field(v))
     }
-
     url_db(urls, rep.int("DESCRIPTION", length(urls)))
 }
 
+.get_urls_from_DESCRIPTION_URL_field <-
+function(v)
+{
+    urls <- character()
+    if(is.na(v)) return(urls)
+    pattern <-
+        "<(URL: *)?((https?|ftp)://[^[:space:],]*)[[:space:]]*>"
+    m <- gregexpr(pattern, v)
+    urls <- c(urls, .gregexec_at_pos(pattern, v, m, 3L))
+    regmatches(v, m) <- ""
+    pattern <- "(^|[^>\"])((https?|ftp)://[^[:space:],]*)"
+    m <- gregexpr(pattern, v)
+    urls <- c(urls, .gregexec_at_pos(pattern, v, m, 3L))
+    urls
+}
+
+.get_urls_from_DESCRIPTION_Description_field <-
+function(v)
+{
+    urls <- character()
+    if(is.na(v)) return(urls)    
+    pattern <-
+        "<(URL: *)?((https?|ftp)://[^[:space:]]+)[[:space:]]*>"
+    m <- gregexpr(pattern, v)
+    urls <- c(urls, .gregexec_at_pos(pattern, v, m, 3L))
+    regmatches(v, m) <- ""
+    pattern <-
+        "([^>\"])((https?|ftp)://[[:alnum:]/.:@+\\_~%#?=&;,-]+[[:alnum:]/])"
+    m <- gregexpr(pattern, v)
+    urls <- c(urls, .gregexec_at_pos(pattern, v, m, 3L))
+    regmatches(v, m) <- ""
+    pattern <- "<([A-Za-z][A-Za-z0-9.+-]*:[^>]+)>"
+    ##   scheme      = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." )
+    m <- gregexpr(pattern, v)
+    urls <- c(urls, .gregexec_at_pos(pattern, v, m, 2L))
+    urls
+}
+
 url_db_from_package_citation <-
 function(dir, meta, installed = FALSE)
 {