X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=trunk%2FR%2Fdb.R;h=285b2ce02c09910dc17e44cfb234461680038064;hb=302d4a36be0f3eafa0ddec0d571c56758ae40113;hp=5c9836d87844f361dd3fe7512ba3ed32730e8a66;hpb=7c74d4e371b7ecda2035aa106918b0427818cacf;p=cran2deb.git diff --git a/trunk/R/db.R b/trunk/R/db.R index 5c9836d..285b2ce 100644 --- a/trunk/R/db.R +++ b/trunk/R/db.R @@ -53,16 +53,30 @@ db_start <- function() { if (!dbExistsTable(con,'builds')) { dbGetQuery(con,paste('CREATE TABLE builds (' ,' id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL' + ,',system TEXT NOT NULL' ,',package TEXT NOT NULL' ,',r_version TEXT NOT NULL' ,',deb_epoch INTEGER NOT NULL' ,',deb_revision INTEGER NOT NULL' ,',db_version INTEGER NOT NULL' ,',date_stamp TEXT NOT NULL' - ,',git_revision TEXT NOT NULL' # legacy: really scm_revision + ,',time_stamp TEXT NOT NULL' + ,',scm_revision TEXT NOT NULL' ,',success INTEGER NOT NULL' ,',log TEXT' - ,',UNIQUE(package,r_version,deb_epoch,deb_revision,db_version)' + ,',UNIQUE(package,system,r_version,deb_epoch,deb_revision,db_version)' + ,')')) + } + if (!dbExistsTable(con,'blacklist_packages')) { + dbGetQuery(con,paste('CREATE TABLE blacklist_packages (' + ,' package TEXT PRIMARY KEY NOT NULL ' + ,',nonfree INTEGER NOT NULL DEFAULT 0' + ,',obsolete INTEGER NOT NULL DEFAULT 0' + ,',broken_dependency INTEGER NOT NULL DEFAULT 0' + ,',unsatisfied_dependency INTEGER NOT NULL DEFAULT 0' + ,',breaks_cran2deb INTEGER NOT NULL DEFAULT 0' + ,',other INTEGER NOT NULL DEFAULT 0' + ,',explanation TEXT NOT NULL ' ,')')) } return(con) @@ -140,7 +154,7 @@ db_add_sysreq_override <- function(pattern,depend_alias) { ,' ',db_quote(tolower(depend_alias)) ,',',db_quote(tolower(pattern)) ,')')) - db_stop(con,TRUE) + db_stop(con) } db_sysreq_overrides <- function() { @@ -169,7 +183,7 @@ db_add_depends <- function(depend_alias,debian_pkg,build=F) { ,',',as.integer(build) ,',',db_quote(tolower(debian_pkg)) ,')')) - db_stop(con,TRUE) + db_stop(con) } db_depends <- function() { @@ -198,7 +212,7 @@ db_add_forced_depends <- function(r_name, depend_alias) { dbGetQuery(con, paste('INSERT OR REPLACE INTO forced_depends (r_name, depend_alias)' ,'VALUES (',db_quote(r_name),',',db_quote(depend_alias),')')) - db_stop(con,TRUE) + db_stop(con) } db_forced_depends <- function() { @@ -232,7 +246,7 @@ db_add_license_override <- function(name,accept) { ,' ',db_quote(tolower(name)) ,',',as.integer(accept) ,')')) - db_stop(con,TRUE) + db_stop(con) } db_license_override_hash <- function(license_sha1) { @@ -269,35 +283,67 @@ db_add_license_hash <- function(name,license_sha1) { ,' ',db_quote(tolower(name)) ,',',db_quote(tolower(license_sha1)) ,')')) - db_stop(con,TRUE) + db_stop(con) } db_update_package_versions <- function() { + # seems like the quickest way of doing this: + con <- db_start() + dbGetQuery(con, 'DROP TABLE packages') + db_stop(con) + # db_start re-makes all tables con <- db_start() for (package in available[,'Package']) { dbGetQuery(con, paste('INSERT OR REPLACE INTO packages (package,latest_r_version)' ,'VALUES (',db_quote(package) ,',',db_quote(available[package,'Version']),')')) } + dbGetQuery(con,'DELETE FROM builds WHERE builds.package NOT IN (SELECT package FROM packages)') db_stop(con) } +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(substr(log)) + } con <- db_start() - dbGetQuery(con,paste('INSERT OR REPLACE INTO builds' - ,'(package,r_version,deb_epoch,deb_revision,db_version,success,date_stamp,git_revision,log)' - ,'VALUES' - ,'(',db_quote(package) - ,',',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(),'%a, %d %b %Y %H:%M:%S %z')) - ,',',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) } @@ -306,19 +352,34 @@ db_builds <- function(pkgname) { con <- db_start() build <- dbGetQuery(con, paste('SELECT * FROM builds' ,'WHERE success = 1' + ,'AND system =',db_quote(which_system) ,'AND package =',db_quote(pkgname))) db_stop(con) if (length(build) == 0) { return(NULL) } + return(db_cleanup_builds(build)) +} + +db_cleanup_builds <- function(build) { build$success <- as.logical(build$success) - return(build) + #o <-options(digits.secs = 6) + dt <- as.POSIXct(strptime(paste(as.character(build[,"date_stamp"]), as.character(build[,"time_stamp"])), + paste(db_date_format, db_time_format))) + build$time_stamp <- NULL + build$date_stamp <- NULL + newdf <- data.frame(build, date_stamp=dt) + #print(newdf[, -grep("log", colnames(newdf))]) + #options(o) + #print(newdf[, -grep("log", colnames(newdf))]) + return(newdf) } db_latest_build <- function(pkgname) { con <- db_start() build <- dbGetQuery(con, paste('SELECT * FROM builds' ,'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds' + , 'WHERE system =',db_quote(which_system) , 'GROUP BY package) AS last' ,'WHERE id = max_id' ,'AND builds.package =',db_quote(pkgname))) @@ -326,8 +387,7 @@ db_latest_build <- function(pkgname) { if (length(build) == 0) { return(NULL) } - build$success <- as.logical(build$success) - return(build) + return(db_cleanup_builds(build)) } db_latest_build_version <- function(pkgname) { @@ -353,6 +413,7 @@ db_outdated_packages <- function() { # extract the latest attempt at building each package , 'SELECT * FROM builds' , 'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds' + , 'WHERE system =',db_quote(which_system) , 'GROUP BY package) AS last' , 'WHERE id = max_id) AS build' ,'ON build.package = packages.package' @@ -372,3 +433,54 @@ db_outdated_packages <- function() { return(packages) } +db_blacklist_packages <- function() { + con <- db_start() + packages <- dbGetQuery(con,'SELECT package from blacklist_packages')$package + 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) +}