]> git.donarmstrong.com Git - cran2deb.git/blobdiff - trunk/R/db.R
some debugging statements added and currently commented-out
[cran2deb.git] / trunk / R / db.R
index 9b60d5bb4bbe1de84dd7d04462eb8bcfa2326b3b..578fa711ed1622028544613ce32b46efc8f73a04 100644 (file)
@@ -307,23 +307,42 @@ db_date_format <- '%Y-%m-%d'
 db_time_format <- '%H:%M:%OS %Z'
 
 db_record_build <- function(package, deb_version, log, success=F) {
+    # if the log is more than 1kB, only keep the last 1kB.
+    # this is to work around a problem that seems to have appeared in R 2.10 causing calloc errors.
+    # if the log is not pruned then we get the following error:
+    #
+    # Error in gsub("(['\"])", "\\1\\1", text) :
+    #   Calloc could not allocate (-197080581 of 1) memory
+    # Error in dbGetQuery(con, paste("INSERT OR REPLACE INTO builds", "(package,system,r_version,deb_epoch,deb_revision,db_version,success,date_stamp,time_stamp,scm_revision,log)",  :
+    #   error in evaluating the argument 'statement' in selecting a method for function 'dbGetQuery'
+
+    log <- paste(log,collapse='\n')
+    end <- nchar(log)
+    max_log_len <- 1024
+    if (end > max_log_len) {
+        log <- db_quote(substr(log,end-max_log_len,end))
+    } else {
+        log <- db_quote(log)
+    }
     con <- db_start()
-    o<-options(digits.secs = 6)
-    dbGetQuery(con,paste('INSERT OR REPLACE INTO builds'
-                        ,'(package,system,r_version,deb_epoch,deb_revision,db_version,success,date_stamp,time_stamp,scm_revision,log)'
-                        ,'VALUES'
-                        ,'(',db_quote(package)
-                        ,',',db_quote(which_system)
-                        ,',',db_quote(version_upstream(deb_version))
-                        ,',',db_quote(version_epoch(deb_version))
-                        ,',',db_quote(version_revision(deb_version))
-                        ,',',db_cur_version(con)
-                        ,',',as.integer(success)
-                        ,',',db_quote(format(Sys.time(), db_date_format))
-                        ,',',db_quote(format(Sys.time(), db_time_format))
-                        ,',',db_quote(scm_revision)
-                        ,',',db_quote(paste(log, collapse='\n'))
-                        ,')'))
+    o <- options(digits.secs = 6)
+    sqlcmd <- paste('INSERT OR REPLACE INTO builds'
+                    ,'(package,system,r_version,deb_epoch,deb_revision,db_version,success,date_stamp,time_stamp,scm_revision,log)'
+                    ,'VALUES'
+                    ,'(',db_quote(package)
+                    ,',',db_quote(which_system)
+                    ,',',db_quote(version_upstream(deb_version))
+                    ,',',db_quote(version_epoch(deb_version))
+                    ,',',db_quote(version_revision(deb_version))
+                    ,',',db_cur_version(con)
+                    ,',',as.integer(success)
+                    ,',',db_quote(format(Sys.time(), db_date_format))
+                    ,',',db_quote(format(Sys.time(), db_time_format))
+                    ,',',db_quote(scm_revision)
+                    ,',',log
+                    ,')')
+    ##print(sqlcmd)
+    try(dbGetQuery(con,sqlcmd))
     options(o)
     db_stop(con)
 }
@@ -420,3 +439,48 @@ db_blacklist_packages <- function() {
     db_stop(con)
     return(packages)
 }
+
+db_blacklist_reasons <- function () {
+    con <- db_start()
+    packages <- dbGetQuery(con,'SELECT package,explanation from blacklist_packages')
+    db_stop(con)
+    return(packages)
+}
+
+db_todays_builds <- function() {
+    today <- db_quote(format(Sys.time(), db_date_format))
+    con <- db_start()
+    builds <- dbGetQuery(con,paste('select id,success,system,package,
+                                    r_version as version,deb_epoch as epo,
+                                    deb_revision as rev, scm_revision as svnrev,
+                                    db_version as db,date_stamp,time_stamp
+                                    from builds where date_stamp = ',today))
+    db_stop(con)
+    return(builds)
+}
+
+db_successful_builds <- function() {
+    con <- db_start()
+    builds <- dbGetQuery(con,'select system,package,r_version,date_stamp,time_stamp
+                              from builds natural join (select system,package,max(id) as id
+                                                        from builds
+                                                        where package not in
+                                                                (select package from blacklist_packages)
+                                                        group by package,system)
+                              where success = 1')
+    db_stop(con)
+    return(builds)
+}
+
+db_failed_builds <- function() {
+    con <- db_start()
+    builds <- dbGetQuery(con,'select system,package,r_version,date_stamp,time_stamp
+                              from builds natural join (select system,package,max(id) as id
+                                                        from builds
+                                                        where package not in
+                                                                (select package from blacklist_packages)
+                                                        group by package,system)
+                              where success = 0')
+    db_stop(con)
+    return(builds)
+}