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

diff --git a/trunk/R/license.R b/trunk/R/license.R
index 113b99e30d1d567cc7de04f1a9d4d4a02435d9c2..977d84baa2f8be7eb7eb8be0061926d703d4eac8 100644 (file)
--- 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'])