From cd378795bba881fbba5a00dd6f592fed4842d2ab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Thu, 12 Apr 2018 17:58:54 +0200 Subject: [PATCH 1/2] checks URLs in DESCRIPTION cf #68 --- DESCRIPTION | 4 ++-- R/codemeta_description.R | 3 ++- R/give_opinions.R | 16 ++++++++++++-- R/utils.R | 34 +++++++++++++++++++++++++++++ codemeta.json | 24 ++++++++++---------- inst/examples/DESCRIPTION_wrongURLS | 33 ++++++++++++++++++++++++++++ tests/testthat/test-give_opinions.R | 6 +++++ 7 files changed, 103 insertions(+), 17 deletions(-) create mode 100644 inst/examples/DESCRIPTION_wrongURLS diff --git a/DESCRIPTION b/DESCRIPTION index 0b533d01..83dbfcfc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -42,14 +42,14 @@ Imports: desc, usethis, whisker, - tibble + tibble, + crul Suggests: testthat, jsonvalidate, covr, knitr, rmarkdown, - crul, magrittr, xml2, dplyr (>= 0.7.0), diff --git a/R/codemeta_description.R b/R/codemeta_description.R index 3e4e81d7..16ccd2b2 100644 --- a/R/codemeta_description.R +++ b/R/codemeta_description.R @@ -38,9 +38,10 @@ codemeta_description <- descr$get("Title")) - ## Enforce good practice + ## Get URLs code_repo <- descr$get_urls() if (!is.na(code_repo[1])){ + if(length(code_repo) == 1){ codemeta$codeRepository <- code_repo }else{ diff --git a/R/give_opinions.R b/R/give_opinions.R index 20045f47..eef92fa1 100644 --- a/R/give_opinions.R +++ b/R/give_opinions.R @@ -38,14 +38,26 @@ give_opinions_desc <- function(descr_path){ if(is.na(descr$get("URL"))){ url_fixme <- "URL field. Indicate the URL to your code repository." }else{ - url_fixme <- NULL + checkurls <- check_urls(descr$get("URL")) + if(checkurls != ""){ + url_fixme <- checkurls + }else{ + url_fixme <- NULL + } + } # BugReports if(is.na(descr$get("BugReports"))){ bugreports_fixme <- "BugReports field. Indicate where to report bugs, e.g. GitHub issue tracker." }else{ - bugreports_fixme <- NULL + checkurls <- check_urls(descr$get("BugReports")) + if(checkurls != ""){ + bugreports_fixme <- checkurls + }else{ + bugreports_fixme <- NULL + } + } fixmes <- c(authors_fixme, url_fixme, bugreports_fixme) diff --git a/R/utils.R b/R/utils.R index f2eeeec3..275da1ff 100644 --- a/R/utils.R +++ b/R/utils.R @@ -65,3 +65,37 @@ find_template <- function(template_name, package = "usethis") { } path } + +get_url_status_code <- function(url){ + if(!is.null(url)){ + if(!is.na(url)){ + result <- try(crul::HttpClient$new(url)$get(), silent = TRUE) + if (!inherits(result,'try-error')){ + code <- result$status_code + if(code == 200){ + message <- "All good" + }else{ + message <- paste("Error code:", code) + } + }else{ + message <- "No connection was possible" + } + return(data.frame(message = message, url = url)) + }else{ + return(NULL) + } + }else{ + return(NULL) + } + +} + +check_urls <- function(urls){ + messages <- do.call(rbind, lapply(urls, get_url_status_code)) + if(any(messages$message != "All good")){ + paste("Problematic URLs\n", apply(messages[messages$message != "All good",], + 1, toString)) + }else{ + "" + } +} diff --git a/codemeta.json b/codemeta.json index 4d433b0d..95599860 100644 --- a/codemeta.json +++ b/codemeta.json @@ -119,17 +119,6 @@ "url": "https://cran.r-project.org" } }, - { - "@type": "SoftwareApplication", - "identifier": "crul", - "name": "crul", - "provider": { - "@id": "https://cran.r-project.org", - "@type": "Organization", - "name": "Central R Archive Network (CRAN)", - "url": "https://cran.r-project.org" - } - }, { "@type": "SoftwareApplication", "identifier": "magrittr", @@ -314,11 +303,22 @@ "name": "Central R Archive Network (CRAN)", "url": "https://cran.r-project.org" } + }, + { + "@type": "SoftwareApplication", + "identifier": "crul", + "name": "crul", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Central R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + } } ], "contIntegration": "https://travis-ci.org/ropensci/codemetar", "developmentStatus": "active", "releaseNotes": "https://github.com/ropensci/codemetar/blob/master/NEWS.md", "readme": "https://github.com/ropensci/codemetar/blob/master/README.md", - "fileSize": "270.002KB" + "fileSize": "270.648KB" } diff --git a/inst/examples/DESCRIPTION_wrongURLS b/inst/examples/DESCRIPTION_wrongURLS new file mode 100644 index 00000000..e65cf711 --- /dev/null +++ b/inst/examples/DESCRIPTION_wrongURLS @@ -0,0 +1,33 @@ +Package: jsonlite +Version: 1.5.9000 +Title: A Robust, High Performance JSON Parser and Generator for R +License: MIT + file LICENSE +NeedsCompilation: yes +Depends: + methods +Author: Jeroen Ooms, Duncan Temple Lang, Lloyd Hilaiel +URL: https://httpbin.org/status/429, + https://www.opencpu.org/posts/jsonlite-a-smarter-json-encoder +BugReports: https://httpbin.org/status/404 +Maintainer: Jeroen Ooms +VignetteBuilder: knitr, R.rsp +Description: A fast JSON parser and generator optimized for statistical data + and the web. Started out as a fork of 'RJSONIO', but has been completely + rewritten in recent versions. The package offers flexible, robust, high + performance tools for working with JSON in R and is particularly powerful + for building pipelines and interacting with a web API. The implementation is + based on the mapping described in the vignette (Ooms, 2014). In addition to + converting JSON data from/to R objects, 'jsonlite' contains functions to + stream, validate, and prettify JSON data. The unit tests included with the + package verify that all edge cases are encoded and decoded consistently for + use with dynamic data in systems and applications. +Suggests: + httr, + curl, + plyr, + testthat, + knitr, + rmarkdown, + R.rsp, + sp +RoxygenNote: 6.0.1.9000 diff --git a/tests/testthat/test-give_opinions.R b/tests/testthat/test-give_opinions.R index b226b943..85ece2e0 100644 --- a/tests/testthat/test-give_opinions.R +++ b/tests/testthat/test-give_opinions.R @@ -20,3 +20,9 @@ testthat::test_that("No message if ok description",{ f <- system.file("examples/DESCRIPTION_Rforge", package = "codemetar") expect_null(give_opinions_desc(f)) }) + +test_that("Message if bad URLS", { + f <- system.file("examples/DESCRIPTION_wrongURLS", package = "codemetar") + desc_fixmes <- give_opinions_desc(f) + expect_true(any(grepl("Problematic URLs", desc_fixmes$fixme))) +}) From 48ce1de7f5499fc9bac9cc57b2392c7f26efaa0a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Thu, 12 Apr 2018 18:02:57 +0200 Subject: [PATCH 2/2] oops fixes test --- tests/testthat/test-give_opinions.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-give_opinions.R b/tests/testthat/test-give_opinions.R index 85ece2e0..fa78e830 100644 --- a/tests/testthat/test-give_opinions.R +++ b/tests/testthat/test-give_opinions.R @@ -12,7 +12,7 @@ testthat::test_that("Message if no BugReports", { f <- system.file("examples/DESCRIPTION_no_bugreports", package = "codemetar") desc_fixmes <- give_opinions_desc(f) expect_is(desc_fixmes, "data.frame") - expect_equal(desc_fixmes$where, "DESCRIPTION") + expect_equal(desc_fixmes$where[1], "DESCRIPTION") expect_true(any(grepl("BugReports", desc_fixmes$fixme))) })