db_start <- function() {
drv <- dbDriver('SQLite')
+ if (is.null(drv)) stop("db_start: Could not access driver for SQLite.\n")
con <- dbConnect(drv, dbname=file.path(cache_root,'cran2deb.db'))
+ if (is.null(con)) stop("db_start: Could open connection to file 'cran2deb.db' in directory",cache_root,".\n")
if (!dbExistsTable(con,'sysreq_override')) {
dbGetQuery(con,paste('CREATE TABLE sysreq_override ('
,' depend_alias TEXT NOT NULL'
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'
+ ,',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)
return(as.integer(dbGetQuery(con, 'SELECT max(version) FROM database_versions')[[1]]))
}
+## this is just wrong. It should never return anything greater than 0.
db_base_epoch <- function(con) {
- return(as.integer(dbGetQuery(con,
- paste('SELECT max(base_epoch) FROM database_versions'
- ,'WHERE version IN (SELECT max(version) FROM database_versions)'))[[1]]))
+ return(0)
+### return(as.integer(dbGetQuery(con,
+### paste('SELECT max(base_epoch) FROM database_versions'
+### ,'WHERE version IN (SELECT max(version) FROM database_versions)'))[[1]]))
}
db_get_base_epoch <- function() {
,' ',db_quote(tolower(depend_alias))
,',',db_quote(tolower(pattern))
,')'))
- db_stop(con,TRUE)
+ db_stop(con)
}
db_sysreq_overrides <- function() {
,',',as.integer(build)
,',',db_quote(tolower(debian_pkg))
,')'))
- db_stop(con,TRUE)
+ db_stop(con)
}
db_depends <- function() {
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() {
,' ',db_quote(tolower(name))
,',',as.integer(accept)
,')'))
- db_stop(con,TRUE)
+ db_stop(con)
}
db_license_override_hash <- function(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'
+
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 <- 10240
+ if (end > max_log_len) {
+ log <- db_quote(substr(log,end-max_log_len,end))
+ } else {
+ log <- db_quote(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(git_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)
}
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,verbose=FALSE) {
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)
+ if (verbose) {
+ cat("db_cleanup_builds: newdf")
+ print(newdf)
+ }
+ #print(newdf[, -grep("log", colnames(newdf))])
+ #options(o)
+ #print(newdf[, -grep("log", colnames(newdf))])
+ return(newdf)
}
-db_latest_build <- function(pkgname) {
+db_latest_build <- function(pkgname,verbose=FALSE,debug=FALSE) {
+ if (verbose) {cat("db_latest_build: pkgname:",pkgname,"\n")}
con <- db_start()
+ if (debug) {
+ cat(" connection was opened\n")
+ }
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)))
+ if (debug) {
+ cat(" dbGetQuery was executed:\n")
+ cat(" print(build):\n")
+ print(build)
+ }
db_stop(con)
+ if (debug) {
+ cat(" connection was closed\n")
+ }
if (length(build) == 0) {
return(NULL)
+ } else if (0 == nrow(build)) {
+ return(NULL)
}
- build$success <- as.logical(build$success)
- return(build)
+ return(db_cleanup_builds(build))
}
-db_latest_build_version <- function(pkgname) {
+db_latest_build_version <- function(pkgname,verbose=FALSE) {
+ if (verbose) {cat("db_latest_build_version: pkgname:",pkgname,"\n")}
build <- db_latest_build(pkgname)
if (is.null(build)) {
return(NULL)
+ } else if (0 == nrow(build)) {
+ return(NULL)
}
- return(version_new(build$r_version, build$deb_revision, build$deb_epoch))
+ return(version_new(build$r_version, pkgname=pkgname, build$deb_revision, build$deb_epoch))
}
-db_latest_build_status <- function(pkgname) {
+db_latest_build_status <- function(pkgname,verbose=FALSE) {
+ if (verbose) {cat("db_latest_build_status: pkgname:",pkgname,"\n")}
build <- db_latest_build(pkgname)
if (is.null(build)) {
return(NULL)
+ } else if (0 == nrow(build)) {
+ return(NULL)
}
return(list(build$success,build$log))
}
# 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'
return(packages)
}
+db_blacklist_packages <- function() {
+ con <- db_start()
+ packages <- dbGetQuery(con,'SELECT package from blacklist_packages')$package
+ db_stop(con)
+ return(packages)
+}
+
+db_epoch_override <- function(pkgname) {
+ con <- db_start()
+ epoch.override <- dbGetQuery(con,paste('SELECT epoch FROM epoch_override WHERE package = ',db_quote(pkgname)))
+ print(c("pkgname: ",pkgname))
+ print(epoch.override)
+ db_stop(con)
+ if(NROW(epoch.override)>=1) {
+ return(epoch.override$epoch[1])
+ } else {
+ return(0)
+ }
+}
+
+
+db_blacklist_reasons <- function () {
+ con <- db_start()
+ packages <- dbGetQuery(con,'SELECT package,explanation from blacklist_packages group by explanation')
+ 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)
+}