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'
                  ,',r_pattern TEXT PRIMARY KEY NOT NULL'
                  ,')'))
    }
    if (!dbExistsTable(con,'debian_dependency')) {
        dbGetQuery(con,paste('CREATE TABLE debian_dependency ('
                  ,' id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL'
                  ,',alias TEXT NOT NULL'
                  ,',build INTEGER NOT NULL'
                  ,',debian_pkg TEXT NOT NULL'
                  ,',UNIQUE (alias,build,debian_pkg)'
                  ,')'))
    }
    if (!dbExistsTable(con,'forced_depends')) {
        dbGetQuery(con,paste('CREATE TABLE forced_depends ('
                  ,' r_name TEXT NOT NULL'
                  ,',depend_alias TEXT NOT NULL'
                  ,',PRIMARY KEY (r_name,depend_alias)'
                  ,')'))
    }
    if (!dbExistsTable(con,'license_override')) {
        dbGetQuery(con,paste('CREATE TABLE license_override ('
                  ,' name TEXT PRIMARY KEY NOT NULL'
                  ,',accept INT NOT NULL'
                  ,')'))
    }
    if (!dbExistsTable(con,'license_hashes')) {
        dbGetQuery(con,paste('CREATE TABLE license_hashes ('
                  ,' name TEXT NOT NULL'
                  ,',sha1 TEXT PRIMARY KEY NOT NULL'
                  ,')'))
    }
    if (!dbExistsTable(con,'database_versions')) {
        dbGetQuery(con,paste('CREATE TABLE database_versions ('
                  ,' version INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL'
                  ,',version_date INTEGER NOT NULL'
                  ,',base_epoch INTEGER NOT NULL'
                  ,')'))
        db_add_version(con,1,0)
    }
    if (!dbExistsTable(con,'packages')) {
        dbGetQuery(con,paste('CREATE TABLE packages ('
                  ,' package TEXT PRIMARY KEY NOT NULL'
                  ,',latest_r_version TEXT'
                  ,')'))
    }
    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'
                  ,',time_stamp TEXT NOT NULL'
                  ,',scm_revision TEXT NOT NULL'
                  ,',success INTEGER NOT NULL'
                  ,',log TEXT'
                  ,',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)
}

db_stop <- function(con,bump=F) {
    if (bump) {
        db_bump(con)
    }
    dbDisconnect(con)
}

db_quote <- function(text) {
    return(paste('\'', gsub('([\'"])','\\1\\1',text),'\'',sep=''))
}

db_now <- function() {
    return(as.integer(gsub('-','',Sys.Date())))
}

db_cur_version <- function(con) {
    return(as.integer(dbGetQuery(con, 'SELECT max(version) FROM database_versions')[[1]]))
}

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]]))
}

db_get_base_epoch <- function() {
    con <- db_start()
    v <- db_base_epoch(con)
    db_stop(con)
    return(v)
}

db_get_version <- function() {
    con <- db_start()
    v <- db_cur_version(con)
    db_stop(con)
    return(v)
}

db_add_version <- function(con, version, epoch) {
    dbGetQuery(con,paste('INSERT INTO database_versions (version,version_date,base_epoch)'
              ,'VALUES (',as.integer(version),',',db_now(),',',as.integer(epoch),')'))
}

db_bump <- function(con) {
    db_add_version(con,db_cur_version(con)+1, db_base_epoch(con))
}

db_bump_epoch <- function(con) {
    db_add_version(con,db_cur_version(con)+1, db_base_epoch(con)+1)
}

db_sysreq_override <- function(sysreq_text) {
    con <- db_start()
    results <- dbGetQuery(con,paste(
                    'SELECT DISTINCT depend_alias FROM sysreq_override WHERE'
                            ,db_quote(tolower(sysreq_text)),'LIKE r_pattern'))
    db_stop(con)
    if (length(results) == 0) {
        return(NULL)
    }
    return(results$depend_alias)
}

db_add_sysreq_override <- function(pattern,depend_alias) {
    con <- db_start()
    results <- dbGetQuery(con,paste(
                     'INSERT OR REPLACE INTO sysreq_override'
                    ,'(depend_alias, r_pattern) VALUES ('
                    ,' ',db_quote(tolower(depend_alias))
                    ,',',db_quote(tolower(pattern))
                    ,')'))
    db_stop(con)
}

db_sysreq_overrides <- function() {
    con <- db_start()
    overrides <- dbGetQuery(con,paste('SELECT * FROM sysreq_override'))
    db_stop(con)
    return(overrides)
}

db_get_depends <- function(depend_alias,build=F) {
    con <- db_start()
    results <- dbGetQuery(con,paste(
                    'SELECT DISTINCT debian_pkg FROM debian_dependency WHERE'
                    ,db_quote(tolower(depend_alias)),'= alias'
                    ,'AND',as.integer(build),'= build'))
    db_stop(con)
    return(results$debian_pkg)
}

db_add_depends <- function(depend_alias,debian_pkg,build=F) {
    con <- db_start()
    results <- dbGetQuery(con,paste(
                     'INSERT OR REPLACE INTO debian_dependency'
                    ,'(alias, build, debian_pkg) VALUES ('
                    ,' ',db_quote(tolower(depend_alias))
                    ,',',as.integer(build)
                    ,',',db_quote(tolower(debian_pkg))
                    ,')'))
    db_stop(con)
}

db_depends <- function() {
    con <- db_start()
    depends <- dbGetQuery(con,paste('SELECT * FROM debian_dependency'))
    db_stop(con)
    return(depends)
}

db_get_forced_depends <- function(r_name) {
    con <- db_start()
    forced_depends <- dbGetQuery(con,
                paste('SELECT depend_alias FROM forced_depends WHERE'
                     ,db_quote(r_name),'= r_name'))
    db_stop(con)
    return(forced_depends$depend_alias)
}

db_add_forced_depends <- function(r_name, depend_alias) {
    if (!length(db_get_depends(depend_alias,build=F)) &&
        !length(db_get_depends(depend_alias,build=T))) {
        fail('Debian dependency alias',depend_alias,'is not know,'
                  ,'yet trying to force a dependency on it?')
    }
    con <- db_start()
    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)
}

db_forced_depends <- function() {
    con <- db_start()
    depends <- dbGetQuery(con,paste('SELECT * FROM forced_depends'))
    db_stop(con)
    return(depends)
}

db_license_override_name <- function(name) {
    con <- db_start()
    results <- dbGetQuery(con,paste(
                    'SELECT DISTINCT accept FROM license_override WHERE'
                            ,db_quote(tolower(name)),'= name'))
    db_stop(con)
    if (length(results) == 0) {
        return(NULL)
    }
    return(as.logical(results$accept))
}

db_add_license_override <- function(name,accept) {
    notice('adding',name,'accept?',accept)
    if (accept != TRUE && accept != FALSE) {
        fail('accept must be TRUE or FALSE')
    }
    con <- db_start()
    results <- dbGetQuery(con,paste(
                     'INSERT OR REPLACE INTO license_override'
                    ,'(name, accept) VALUES ('
                    ,' ',db_quote(tolower(name))
                    ,',',as.integer(accept)
                    ,')'))
    db_stop(con)
}

db_license_override_hash <- function(license_sha1) {
    con <- db_start()
    results <- dbGetQuery(con,paste(
                     'SELECT DISTINCT accept FROM license_override'
                    ,'INNER JOIN license_hashes'
                    ,'ON license_hashes.name = license_override.name WHERE'
                    ,db_quote(tolower(license_sha1)),'= license_hashes.sha1'))
    db_stop(con)
    if (length(results) == 0) {
        return(NULL)
    }
    return(as.logical(results$accept))
}

db_license_overrides <- function() {
    con <- db_start()
    overrides <- dbGetQuery(con,paste('SELECT * FROM license_override'))
    hashes    <- dbGetQuery(con,paste('SELECT * FROM license_hashes'))
    db_stop(con)
    return(list(overrides=overrides,hashes=hashes))
}

db_add_license_hash <- function(name,license_sha1) {
    if (is.null(db_license_override_name(name))) {
        fail('license',name,'is not know, yet trying to add a hash for it?')
    }
    notice('adding hash',license_sha1,'for',name)
    con <- db_start()
    dbGetQuery(con,paste(
         'INSERT OR REPLACE INTO license_hashes'
        ,'(name, sha1) VALUES ('
        ,' ',db_quote(tolower(name))
        ,',',db_quote(tolower(license_sha1))
        ,')'))
    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()
    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)
}

db_builds <- function(pkgname) {
    # returns all successful builds
    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)
    #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,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,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))
}

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))
}

db_outdated_packages <- function() {
    con <- db_start()
    packages <- dbGetQuery(con,paste('SELECT packages.package FROM packages'
               ,'LEFT OUTER JOIN ('
               # 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'
               # outdated iff:
               # - there is no latest build
               ,'WHERE build.package IS NULL'
               # - the database has changed since last build
               ,'OR build.db_version < (SELECT max(version) FROM database_versions)'
               # - the debian epoch has been bumped up
               ,'OR build.deb_epoch < (SELECT max(base_epoch) FROM database_versions'
               ,                        'WHERE version IN ('
               ,                            'SELECT max(version) FROM database_versions))'
               # - the latest build is not of the latest R version
               ,'OR build.r_version != packages.latest_r_version'
               ))$package
    db_stop(con)
    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 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)
}