1 2chk <- function(msg, check) { 3 if (check) TRUE else msg 4} 5 6chks <- function(..., x, warn) { 7 results <- list(...) 8 results <- unlist(setdiff(results, TRUE)) 9 results <- if (length(results) == 0) TRUE else results 10 11 if (! identical(results, TRUE) && warn) { 12 warning( 13 call. = FALSE, 14 "'", x$key, "'", 15 paste0( 16 if (length(results) == 1) " " else "\n * ", 17 strwrap(results, indent = 0, exdent = 6) 18 ) 19 ) 20 } 21 22 results 23} 24 25 26#' Syntactical check of a DESCRIPTION field 27#' 28#' @param x The field. 29#' @param warn Whether to generate a warning if the syntax check fails. 30#' @param ... Additional arguments, they might be used in the future. 31#' @return \code{TRUE} if the field is syntactically correct, 32#' otherwise a character vector, containing one or multiple 33#' error messages. 34#' 35#' @export 36 37check_field <- function(x, warn = FALSE, ...) 38 UseMethod("check_field") 39 40#' @export 41#' @method check_field DescriptionField 42 43check_field.DescriptionField <- function(x, warn = FALSE, ...) TRUE 44 45##' @export 46##' @method check_field DescriptionPackage 47 48check_field.DescriptionPackage <- function(x, warn = FALSE, R = FALSE, ...) { 49 50 ## In Depends, we can depend on certain 'R' versions 51 if (R && x$value == "R") return(TRUE) 52 53 chks( 54 x = x, warn = warn, 55 chk("must only contain ASCII letters, numbers, dots", 56 grepl("^[a-zA-Z0-9\\.]*$", x$value)), 57 chk("must be at least two characters long", 58 nchar(x$value) >= 2), 59 chk("must start with a letter", 60 grepl("^[a-zA-Z]", x$value)), 61 chk("must not end with a dot", 62 !grepl("\\.$", x$value)) 63 ) 64} 65 66valid_packagename_regexp <- "[[:alpha:]][[:alnum:].]*[[:alnum:]]" 67valid_version_regexp <- "[0-9]+[-\\.][0-9]+([-\\.][0-9]+)*" 68valid_package_archive_name <- paste0( 69 "^", 70 valid_packagename_regexp, 71 "_", 72 valid_version_regexp, 73 "(.*)?", 74 "(\\.tar\\.gz|\\.tgz|\\.zip)", 75 "$" 76) 77 78##' @export 79##' @method check_field DescriptionVersion 80 81check_field.DescriptionVersion <- function(x, warn = FALSE, ...) { 82 83 chks( 84 x = x, warn = warn, 85 chk(paste("must be a sequence of at least two (usually three)", 86 " non-negative integers separated by a single dot or dash", 87 " character"), 88 grepl(paste0("^", valid_version_regexp, "$"), x$value)) 89 ) 90} 91 92## TODO: It also must be a license R CMD check recognizes 93## 94##' @export 95##' @method check_field DescriptionLicense 96 97check_field.DescriptionLicense <- function(x, warn = FALSE, ...) { 98 99 chks( 100 x = x, warn = warn, 101 chk("must contain only ASCII characters", 102 is_ascii(x$value)), 103 chk("must not be empty", 104 str_trim(x$value) != "") 105 ) 106} 107 108##' @export 109##' @method check_field DescriptionDescription 110 111check_field.DescriptionDescription <- function(x, warn = FALSE, ...) { 112 113 chks( 114 x = x, warn = warn, 115 chk("must not be empty", 116 str_trim(x$value) != ""), 117 chk("must contain one or more complete sentences", 118 grepl("[.!?]['\")]?$", str_trim(x$value))), 119 chk("must not start with 'The package', 'This Package, 'A package'", 120 !grepl("^(The|This|A|In this|In the) package", x$value)), 121 chk("must start with a capital letter", 122 grepl("^['\"]?[[:upper:]]", x$value)) 123 ) 124} 125 126##' @export 127##' @method check_field DescriptionTitle 128 129check_field.DescriptionTitle <- function(x, warn = FALSE, ...) { 130 131 chks( 132 x = x, warn = warn, 133 chk("must not be empty", 134 str_trim(x$value) != ""), 135 chk("must not end with a period", 136 !grepl("[.]$", str_trim(x$value)) || 137 grepl("[[:space:]][.][.][.]|et[[:space:]]al[.]", str_trim(x$value))) 138 ) 139} 140 141##' @export 142##' @method check_field DescriptionMaintainer 143 144check_field.DescriptionMaintainer <- function(x, warn = FALSE, ...) { 145 146 re_maint <- paste0( 147 "^[[:space:]]*(.*<", 148 RFC_2822_email_regexp, 149 ">|ORPHANED)[[:space:]]*$" 150 ) 151 152 chks( 153 x = x, warn = warn, 154 chk("must not be empty", 155 str_trim(x$value) != ""), 156 chk("must contain an email address", 157 grepl(re_maint, x$value)) 158 ) 159} 160 161## TODO 162##' @export 163##' @method check_field DescriptionAuthorsAtR 164 165check_field.DescriptionAuthorsAtR <- function(x, warn = FALSE, ...) { 166 TRUE 167} 168 169##' @export 170##' @method check_field DescriptionDependencyList 171 172check_field.DescriptionDependencyList <- function(x, warn = FALSE, ...) { 173 174 deps <- parse_deps(x$key, x$value) 175 176 is_package_list <- function(xx) { 177 p <- lapply(xx, function(pc) 178 check_field.DescriptionPackage( 179 list(key = "Package", value = pc), 180 R = x$key[1] == "Depends" 181 ) 182 ) 183 all_true(p) 184 } 185 186 is_version_req <- function(x) { 187 188 x <- str_trim(x) 189 if (x == "*") return(TRUE) 190 191 re <- paste0( 192 "^(<=|>=|<|>|==|!=)\\s*", 193 valid_version_regexp, 194 "$" 195 ) 196 grepl(re, x) 197 } 198 199 is_version_req_list <- function(x) { 200 all_true(vapply(x, is_version_req, TRUE)) 201 } 202 203 chks( 204 x = x, warn = warn, 205 chk("must contain valid package names", 206 is_package_list(deps$package)), 207 chk("must contain valid version requirements", 208 is_version_req_list(deps$version)) 209 ) 210} 211 212##' @export 213##' @method check_field DescriptionRemotes 214 215check_field.DescriptionRemotes <- function(x, warn = FALSE, ...) { 216 217 is_remote <- function(x) { 218 xx <- str_trim(strsplit(x, ",", fixed = TRUE)[[1]]) 219 p <- grepl("^[^[:space:]]+$", xx) 220 all_true(p) 221 } 222 223 chks( 224 x = x, warn = warn, 225 chk("must be a comma separated list of remotes", 226 is_remote(x$value)) 227 ) 228} 229 230##' @export 231##' @method check_field DescriptionPackageList 232 233check_field.DescriptionPackageList <- function(x, warn = FALSE, ...) { 234 235 is_package_list <- function(x) { 236 xx <- str_trim(strsplit(x, ",", fixed = TRUE)[[1]]) 237 p <- lapply(xx, function(pc) 238 check_field.DescriptionPackage(list(key = "Package", value = pc))) 239 all_true(p) 240 } 241 242 chks( 243 x = x, warn = warn, 244 chk("must be a comma separated list of package names", 245 is_package_list(x$value)) 246 ) 247} 248 249##' @export 250##' @method check_field DescriptionRepoList 251 252check_field.DescriptionRepoList <- function(x, warn = FALSE, ...) { 253 254 chks( 255 x = x, warn = warn, 256 chk("must be a comma separated list repository URLs", 257 is_url_list(x$value)) 258 ) 259} 260 261##' @export 262##' @method check_field DescriptionURL 263 264check_field.DescriptionURL <- function(x, warn = FALSE, ...) { 265 266 chks( 267 x = x, warn = warn, 268 chk("must be a http, https or ftp URL", 269 is_url(x$value)) 270 ) 271} 272 273##' @export 274##' @method check_field DescriptionURLList 275 276check_field.DescriptionURLList <- function(x, warn = FALSE, ...) { 277 278 chks( 279 x = x, warn = warn, 280 chk("must be a comma separated list of http, https or ftp URLs", 281 is_url_list(x$value)) 282 ) 283} 284 285##' @export 286##' @method check_field DescriptionPriority 287 288check_field.DescriptionPriority <- function(x, warn = FALSE, ...) { 289 290 chks( 291 x = x, warn = warn, 292 chk("must be one of 'base', 'recommended' or 'defunct-base'", 293 str_trim(x$value) %in% c("base", "recommended", "defunct-base")) 294 ) 295} 296 297##' @export 298##' @method check_field DescriptionCollate 299 300check_field.DescriptionCollate <- function(x, warn = FALSE, ...) { 301 302 coll <- tolower(parse_collate(x$value)) 303 304 chks( 305 x = x, warn = warn, 306 chk("must contain a list of .R files", 307 all(grepl("[.]r$", coll))) 308 ) 309} 310 311##' @export 312##' @method check_field DescriptionLogical 313 314check_field.DescriptionLogical <- function(x, warn = FALSE, ...) { 315 316 chks( 317 x = x, warn = warn, 318 chk("must be one of 'true', 'false', 'yes' or 'no' (case insensitive)", 319 str_trim(tolower(x$value)) %in% c("true", "false", "yes", "no")) 320 ) 321} 322 323##' @export 324##' @method check_field DescriptionEncoding 325 326check_field.DescriptionEncoding <- function(x, warn = FALSE, ...) { 327 328 chks( 329 x = x, warn = warn, 330 chk("must be one of 'latin1', 'latin2' and 'UTF-8'", 331 x$value %in% c("latin1", "latin2", "UTF-8")) 332 ) 333} 334 335##' @export 336##' @method check_field DescriptionOSType 337 338check_field.DescriptionOSType <- function(x, warn = FALSE, ...) { 339 340 chks( 341 x = x, warn = warn, 342 chk("must be one of 'unix' and 'windows'", 343 x$value %in% c("unix", "windows")) 344 ) 345} 346 347##' @export 348##' @method check_field DescriptionType 349 350check_field.DescriptionType <- function(x, warn = FALSE, ...) { 351 352 chks( 353 x = x, warn = warn, 354 chk("must be either 'Package' or 'Translation'", 355 x$value %in% c("Package", "Translation")) 356 ) 357} 358 359##' @export 360##' @method check_field DescriptionClassification 361 362check_field.DescriptionClassification <- function(x, warn = FALSE, ...) { 363 TRUE 364} 365 366##' @export 367##' @method check_field DescriptionLanguage 368 369check_field.DescriptionLanguage <- function(x, warn = FALSE, ...) { 370 371 is_language_list <- function(x) { 372 x <- str_trim(strsplit(x, ",", fixed = TRUE)[[1]]) 373 all(grepl("^[a-z][a-z][a-z]?(-[A-Z]+)?$", x)) 374 } 375 376 chks( 377 x = x, warn = warn, 378 chk("must be a list of IETF language codes defined by RFC 5646", 379 is_language_list(x$value)) 380 ) 381} 382 383##' @export 384##' @method check_field DescriptionDate 385 386check_field.DescriptionDate <- function(x, warn = FALSE, ...) { 387 388 chks( 389 x = x, warn = warn, 390 chk( 391 paste0( 392 "must be an ISO date: yyyy-mm-dd, but it is actually better\n", 393 "to leave this field out completely. It is not required."), 394 grepl("^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]$", x$value) 395 ) 396 ) 397} 398 399##' @export 400##' @method check_field DescriptionCompression 401 402check_field.DescriptionCompression <- function(x, warn = FALSE, ...) { 403 404 chks( 405 x = x, warn = warn, 406 chk("must be one of 'bzip2', 'xz', 'gzip'", 407 x$value %in% c("bzip2", "xz", "gzip")) 408 ) 409} 410 411##' @export 412##' @method check_field DescriptionRepository 413 414check_field.DescriptionRepository <- function(x, warn = FALSE, ...) { 415 TRUE 416} 417 418##' @export 419##' @method check_field DescriptionFreeForm 420 421check_field.DescriptionFreeForm <- function(x, warn = FALSE, ...) { 422 TRUE 423} 424 425##' @export 426##' @method check_field DescriptionAddedByRCMD 427 428check_field.DescriptionAddedByRCMD <- function(x, warn = FALSE, ...) { 429 TRUE 430} 431