X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=trunk%2FR%2Fdb.R;h=d604e7f2966b958bc8817dd2ddc590edac80c72b;hb=f2d6fd8670ba382cba7d1c27e148c4d3487d4e2c;hp=c41fb529465e23ff3580b4e0dc8463322fbd3741;hpb=371d29f94db2f81306dda090d760ce915042477e;p=cran2deb.git diff --git a/trunk/R/db.R b/trunk/R/db.R index c41fb52..d604e7f 100644 --- a/trunk/R/db.R +++ b/trunk/R/db.R @@ -1,7 +1,22 @@ db_start <- function() { - drv <- dbDriver('SQLite') - con <- dbConnect(drv, dbname=file.path(cache_root,'cran2deb.db')) + pg.service <- Sys.getenv('CRAN2DEB_PG') + if (!is.null(pg.service) && + any(grepl(".",pg.service))) { + drv <- dbDriver("PostgreSQL") + if (is.null(drv)) { + stop("db_start: Could not access driver for postgresql.") + } + con <- dbConnect(drv,service=pg.service) + if (is.null(con)) { + stop("db_start: Could open connection to service ",pg.service) + } + } else { + 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' @@ -101,10 +116,12 @@ db_cur_version <- function(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() { @@ -304,41 +321,45 @@ db_update_package_versions <- function() { } db_date_format <- '%Y-%m-%d' -db_time_format <- '%H:%M:%OS %Z' +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 = 1024 + 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)) + 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) - ,',',log - ,')')) + 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) } @@ -357,7 +378,7 @@ db_builds <- function(pkgname) { return(db_cleanup_builds(build)) } -db_cleanup_builds <- function(build) { +db_cleanup_builds <- function(build,verbose=FALSE) { build$success <- as.logical(build$success) #o <-options(digits.secs = 6) dt <- as.POSIXct(strptime(paste(as.character(build[,"date_stamp"]), as.character(build[,"time_stamp"])), @@ -365,39 +386,63 @@ db_cleanup_builds <- function(build) { 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) } 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)) } @@ -436,9 +481,23 @@ db_blacklist_packages <- function() { 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') + packages <- dbGetQuery(con,'SELECT package,explanation from blacklist_packages group by explanation') db_stop(con) return(packages) }