From e8214de2fadb350ba87c262754991046448f622e Mon Sep 17 00:00:00 2001 From: moeller Date: Tue, 8 Feb 2011 13:39:03 +0000 Subject: [PATCH] Many debug statements were added (not shown by default). They are likely to be removed soon. That area is currently been scrutinised for a better interaction with the human operator for the manual inspection of licenses the feeding back of such "editorial decisions" (Dirk). git-svn-id: svn://svn.r-forge.r-project.org/svnroot/cran2deb@334 edb9625f-4e0d-4859-8d74-9fd3b1da38cb --- trunk/R/license.R | 67 +++++++++++++++++++++++++++++++++++------------ 1 file changed, 50 insertions(+), 17 deletions(-) diff --git a/trunk/R/license.R b/trunk/R/license.R index 113b99e..977d84b 100644 --- a/trunk/R/license.R +++ b/trunk/R/license.R @@ -1,32 +1,47 @@ -is_acceptable_license <- function(license) { +is_acceptable_license <- function(license,verbose=FALSE,debug=FALSE) { + if (verbose) cat("is_acceptable_license: license:",license,"\n",sep="") # determine if license text is acceptable if (length(grep('^file ',license))) { # skip file licenses + notice("The package has a file license. This needs individual checking and settings in the respective table.") return(FALSE) } license <- license_text_reduce(license) + if (debug) cat("**** a ****\n") action = db_license_override_name(license) + if (verbose) { + cat("**** action: ****\n") + print(action) + } if (!is.null(action)) { - return(action) + if (debug) cat("**** c1 ****\n") + #return(isTRUE(action)) + return(TRUE) } + if (debug) cat("**** c ****\n") license <- license_text_further_reduce(license) + if (debug) cat("**** d ****\n") action = db_license_override_name(license) + if (debug) cat("**** e ****\n") if (!is.null(action)) { warn('Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!') return(action) } license <- license_text_extreme_reduce(license) + if (debug) cat("**** f ****\n") action = db_license_override_name(license) + if (debug) cat("**** g ****\n") if (!is.null(action)) { warn('Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!') return(action) } - error('Wild license',license,'did not match classic rules; rejecting') + error('is_acceptable_license: Wild license',license,'did not match classic rules; rejecting.') return(F) } -license_text_reduce <- function(license) { +license_text_reduce <- function(license,verbose=FALSE,debug=FALSE) { + if (verbose) cat("license_text_reduce license:",license,"\n",sep="") # these reduction steps are sound for all conformant R license # specifications. @@ -42,10 +57,12 @@ license_text_reduce <- function(license) { ,sub('-[0-9.-]+','',license))) # remove any extra space introduced license = chomp(gsub('[[:space:]]+',' ',license)) + if (debug) cat("license_text_reduce: ",license,"\n",sep="") return(license) } -license_text_further_reduce <- function(license) { +license_text_further_reduce <- function(license,verbose=TRUE) { + if (verbose) cat("license_text_further_reduce license:",license,"\n",sep="") # these reduction steps are heuristic and may lead to # in correct acceptances, if care is not taken. @@ -69,7 +86,8 @@ license_text_further_reduce <- function(license) { return(license) } -license_text_extreme_reduce <- function(license) { +license_text_extreme_reduce <- function(license,verbose=TRUE) { + if (verbose) cat("license_text_extreme_reduce license:",license,"\n",sep="") # remove everything that may or may not be a version specification license = gsub('(ver?sion|v)? *[0-9.-]+ *(or *(higher|later|newer|greater|above))?','' ,license) @@ -78,7 +96,8 @@ license_text_extreme_reduce <- function(license) { return(license) } -license_text_hash_reduce <- function(text) { +license_text_hash_reduce <- function(text,verbose=TRUE) { + if (verbose) cat("license_text_hash_reduce text:",text,"\n",sep="") # reduction of license text, suitable for hashing. return(chomp(tolower(gsub('[[:space:]]+',' ',text)))) } @@ -119,14 +138,22 @@ get_license_hash <- function(pkg,license) { return(digest(get_license(pkg,license),algo='sha1',serialize=FALSE)) } -is_acceptable_hash_license <- function(pkg,license) { +is_acceptable_hash_license <- function(pkg,license,verbose=TRUE) { license_sha1 <- get_license_hash(pkg,license) if (is.null(license_sha1)) { + if (verbose) cat("is_acceptable_hash_license: get_license_hash(pkg,license) returned NULL, returning FALSE.\n") return(FALSE) } action = db_license_override_hash(license_sha1) if (is.null(action)) { + if (verbose) cat("is_acceptable_hash_license: get_license_override_hash(license_sha1) returned NULL, returning FALSE.\n") action = FALSE + } else if (0 == length(action)) { + notice("An error occurred, 0==length(action), ignoring package.\n") + action = FALSE + } else if (is.na(action)) { + notice("An error occurred, is.na(action), ignoring package.\n") + action = FALSE } if (action) { warn('Wild license',license,'accepted via hash',license_sha1) @@ -135,22 +162,28 @@ is_acceptable_hash_license <- function(pkg,license) { } -accept_license <- function(pkg) { +accept_license <- function(pkg,verbose=FALSE) { # check the license if (!('License' %in% names(pkg$description[1,]))) { fail('package has no License: field in description!') + return(NULL) } accept=NULL - for (license in strsplit(chomp(pkg$description[1,'License']) - ,'[[:space:]]*\\|[[:space:]]*')[[1]]) { - if (is_acceptable_license(license)) { - accept=license + if (verbose) { cat("accept_license: pkg:\n"); print(pkg$srcname) } + license<-pkg$description[1,'License'] + if (verbose) { cat(" license:\n"); print(license) } + + for (l in strsplit(chomp(license),'[[:space:]]*\\|[[:space:]]*')[[1]]) { + if (verbose) cat("Investigating: '",l,"'\n",sep="") + if (is_acceptable_license(l)) { + accept=l break - } - if (is_acceptable_hash_license(pkg,license)) { - accept=license + } else if (is_acceptable_hash_license(pkg,l)) { + accept=l break - } + } else { + notice(paste("Could not accept license ",l," for package ",pkg,"\n",sep="")) + } } if (is.null(accept)) { fail('No acceptable license:',pkg$description[1,'License']) -- 2.39.2