2 db_start <- function() {
3 pg.service <- Sys.getenv('CRAN2DEB_PG')
4 if (!is.null(pg.service) &&
5 any(grepl(".",pg.service))) {
6 drv <- dbDriver("PostgreSQL")
8 stop("db_start: Could not access driver for postgresql.")
10 con <- dbConnect(drv,service=pg.service)
12 stop("db_start: Could open connection to service ",pg.service)
15 drv <- dbDriver('SQLite')
16 if (is.null(drv)) stop("db_start: Could not access driver for SQLite.\n")
17 con <- dbConnect(drv, dbname=file.path(cache_root,'cran2deb.db'))
18 if (is.null(con)) stop("db_start: Could open connection to file 'cran2deb.db' in directory",cache_root,".\n")
20 if (!dbExistsTable(con,'sysreq_override')) {
21 dbGetQuery(con,paste('CREATE TABLE sysreq_override ('
22 ,' depend_alias TEXT NOT NULL'
23 ,',r_pattern TEXT PRIMARY KEY NOT NULL'
26 if (!dbExistsTable(con,'debian_dependency')) {
27 dbGetQuery(con,paste('CREATE TABLE debian_dependency ('
28 ,' id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL'
29 ,',alias TEXT NOT NULL'
30 ,',build INTEGER NOT NULL'
31 ,',debian_pkg TEXT NOT NULL'
32 ,',UNIQUE (alias,build,debian_pkg)'
35 if (!dbExistsTable(con,'forced_depends')) {
36 dbGetQuery(con,paste('CREATE TABLE forced_depends ('
37 ,' r_name TEXT NOT NULL'
38 ,',depend_alias TEXT NOT NULL'
39 ,',PRIMARY KEY (r_name,depend_alias)'
42 if (!dbExistsTable(con,'license_override')) {
43 dbGetQuery(con,paste('CREATE TABLE license_override ('
44 ,' name TEXT PRIMARY KEY NOT NULL'
45 ,',accept INT NOT NULL'
48 if (!dbExistsTable(con,'license_hashes')) {
49 dbGetQuery(con,paste('CREATE TABLE license_hashes ('
50 ,' name TEXT NOT NULL'
51 ,',sha1 TEXT PRIMARY KEY NOT NULL'
54 if (!dbExistsTable(con,'database_versions')) {
55 dbGetQuery(con,paste('CREATE TABLE database_versions ('
56 ,' version INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL'
57 ,',version_date INTEGER NOT NULL'
58 ,',base_epoch INTEGER NOT NULL'
60 db_add_version(con,1,0)
62 if (!dbExistsTable(con,'packages')) {
63 dbGetQuery(con,paste('CREATE TABLE packages ('
64 ,' package TEXT PRIMARY KEY NOT NULL'
65 ,',latest_r_version TEXT'
68 if (!dbExistsTable(con,'builds')) {
69 dbGetQuery(con,paste('CREATE TABLE builds ('
70 ,' id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL'
71 ,',system TEXT NOT NULL'
72 ,',package TEXT NOT NULL'
73 ,',r_version TEXT NOT NULL'
74 ,',deb_epoch INTEGER NOT NULL'
75 ,',deb_revision INTEGER NOT NULL'
76 ,',db_version INTEGER NOT NULL'
77 ,',date_stamp TEXT NOT NULL'
78 ,',time_stamp TEXT NOT NULL'
79 ,',scm_revision TEXT NOT NULL'
80 ,',success INTEGER NOT NULL'
82 ,',UNIQUE(package,system,r_version,deb_epoch,deb_revision,db_version)'
85 if (!dbExistsTable(con,'blacklist_packages')) {
86 dbGetQuery(con,paste('CREATE TABLE blacklist_packages ('
87 ,' package TEXT PRIMARY KEY NOT NULL '
88 ,',nonfree INTEGER NOT NULL DEFAULT 0'
89 ,',obsolete INTEGER NOT NULL DEFAULT 0'
90 ,',broken_dependency INTEGER NOT NULL DEFAULT 0'
91 ,',unsatisfied_dependency INTEGER NOT NULL DEFAULT 0'
92 ,',breaks_cran2deb INTEGER NOT NULL DEFAULT 0'
93 ,',other INTEGER NOT NULL DEFAULT 0'
94 ,',explanation TEXT NOT NULL '
100 db_stop <- function(con,bump=F) {
107 db_quote <- function(text) {
108 return(paste('\'', gsub('([\'"])','\\1\\1',text),'\'',sep=''))
111 db_now <- function() {
112 return(as.integer(gsub('-','',Sys.Date())))
115 db_cur_version <- function(con) {
116 return(as.integer(dbGetQuery(con, 'SELECT max(version) FROM database_versions')[[1]]))
119 ## this is just wrong. It should never return anything greater than 0.
120 db_base_epoch <- function(con) {
122 ### return(as.integer(dbGetQuery(con,
123 ### paste('SELECT max(base_epoch) FROM database_versions'
124 ### ,'WHERE version IN (SELECT max(version) FROM database_versions)'))[[1]]))
127 db_get_base_epoch <- function() {
129 v <- db_base_epoch(con)
134 db_get_version <- function() {
136 v <- db_cur_version(con)
141 db_add_version <- function(con, version, epoch) {
142 dbGetQuery(con,paste('INSERT INTO database_versions (version,version_date,base_epoch)'
143 ,'VALUES (',as.integer(version),',',db_now(),',',as.integer(epoch),')'))
146 db_bump <- function(con) {
147 db_add_version(con,db_cur_version(con)+1, db_base_epoch(con))
150 db_bump_epoch <- function(con) {
151 db_add_version(con,db_cur_version(con)+1, db_base_epoch(con)+1)
154 db_sysreq_override <- function(sysreq_text) {
156 results <- dbGetQuery(con,paste(
157 'SELECT DISTINCT depend_alias FROM sysreq_override WHERE'
158 ,db_quote(tolower(sysreq_text)),'LIKE r_pattern'))
160 if (length(results) == 0) {
163 return(results$depend_alias)
166 db_add_sysreq_override <- function(pattern,depend_alias) {
168 results <- dbGetQuery(con,paste(
169 'INSERT OR REPLACE INTO sysreq_override'
170 ,'(depend_alias, r_pattern) VALUES ('
171 ,' ',db_quote(tolower(depend_alias))
172 ,',',db_quote(tolower(pattern))
177 db_sysreq_overrides <- function() {
179 overrides <- dbGetQuery(con,paste('SELECT * FROM sysreq_override'))
184 db_get_depends <- function(depend_alias,build=F) {
186 results <- dbGetQuery(con,paste(
187 'SELECT DISTINCT debian_pkg FROM debian_dependency WHERE'
188 ,db_quote(tolower(depend_alias)),'= alias'
189 ,'AND',as.integer(build),'= build'))
191 return(results$debian_pkg)
194 db_add_depends <- function(depend_alias,debian_pkg,build=F) {
196 results <- dbGetQuery(con,paste(
197 'INSERT OR REPLACE INTO debian_dependency'
198 ,'(alias, build, debian_pkg) VALUES ('
199 ,' ',db_quote(tolower(depend_alias))
200 ,',',as.integer(build)
201 ,',',db_quote(tolower(debian_pkg))
206 db_depends <- function() {
208 depends <- dbGetQuery(con,paste('SELECT * FROM debian_dependency'))
213 db_get_forced_depends <- function(r_name) {
215 forced_depends <- dbGetQuery(con,
216 paste('SELECT depend_alias FROM forced_depends WHERE'
217 ,db_quote(r_name),'= r_name'))
219 return(forced_depends$depend_alias)
222 db_add_forced_depends <- function(r_name, depend_alias) {
223 if (!length(db_get_depends(depend_alias,build=F)) &&
224 !length(db_get_depends(depend_alias,build=T))) {
225 fail('Debian dependency alias',depend_alias,'is not know,'
226 ,'yet trying to force a dependency on it?')
230 paste('INSERT OR REPLACE INTO forced_depends (r_name, depend_alias)'
231 ,'VALUES (',db_quote(r_name),',',db_quote(depend_alias),')'))
235 db_forced_depends <- function() {
237 depends <- dbGetQuery(con,paste('SELECT * FROM forced_depends'))
242 db_license_override_name <- function(name) {
244 results <- dbGetQuery(con,paste(
245 'SELECT DISTINCT accept FROM license_override WHERE'
246 ,db_quote(tolower(name)),'= name'))
248 if (length(results) == 0) {
251 return(as.logical(results$accept))
254 db_add_license_override <- function(name,accept) {
255 notice('adding',name,'accept?',accept)
256 if (accept != TRUE && accept != FALSE) {
257 fail('accept must be TRUE or FALSE')
260 results <- dbGetQuery(con,paste(
261 'INSERT OR REPLACE INTO license_override'
262 ,'(name, accept) VALUES ('
263 ,' ',db_quote(tolower(name))
264 ,',',as.integer(accept)
269 db_license_override_hash <- function(license_sha1) {
271 results <- dbGetQuery(con,paste(
272 'SELECT DISTINCT accept FROM license_override'
273 ,'INNER JOIN license_hashes'
274 ,'ON license_hashes.name = license_override.name WHERE'
275 ,db_quote(tolower(license_sha1)),'= license_hashes.sha1'))
277 if (length(results) == 0) {
280 return(as.logical(results$accept))
283 db_license_overrides <- function() {
285 overrides <- dbGetQuery(con,paste('SELECT * FROM license_override'))
286 hashes <- dbGetQuery(con,paste('SELECT * FROM license_hashes'))
288 return(list(overrides=overrides,hashes=hashes))
291 db_add_license_hash <- function(name,license_sha1) {
292 if (is.null(db_license_override_name(name))) {
293 fail('license',name,'is not know, yet trying to add a hash for it?')
295 notice('adding hash',license_sha1,'for',name)
297 dbGetQuery(con,paste(
298 'INSERT OR REPLACE INTO license_hashes'
299 ,'(name, sha1) VALUES ('
300 ,' ',db_quote(tolower(name))
301 ,',',db_quote(tolower(license_sha1))
307 db_update_package_versions <- function() {
308 # seems like the quickest way of doing this:
310 dbGetQuery(con, 'DROP TABLE packages')
312 # db_start re-makes all tables
314 for (package in available[,'Package']) {
315 dbGetQuery(con, paste('INSERT OR REPLACE INTO packages (package,latest_r_version)'
316 ,'VALUES (',db_quote(package)
317 ,',',db_quote(available[package,'Version']),')'))
319 dbGetQuery(con,'DELETE FROM builds WHERE builds.package NOT IN (SELECT package FROM packages)')
323 db_date_format <- '%Y-%m-%d'
324 db_time_format <- '%H:%M:%OS'
326 db_record_build <- function(package, deb_version, log, success=F) {
327 # if the log is more than 1kB, only keep the last 1kB.
328 # this is to work around a problem that seems to have appeared in R 2.10 causing calloc errors.
329 # if the log is not pruned then we get the following error:
331 # Error in gsub("(['\"])", "\\1\\1", text) :
332 # Calloc could not allocate (-197080581 of 1) memory
333 # 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)", :
334 # error in evaluating the argument 'statement' in selecting a method for function 'dbGetQuery'
336 log <- paste(log,collapse='\n')
339 if (end > max_log_len) {
340 log <- db_quote(substr(log,end-max_log_len,end))
345 o <- options(digits.secs = 6)
346 sqlcmd <- paste('INSERT OR REPLACE INTO builds'
347 ,'(package,system,r_version,deb_epoch,deb_revision,db_version,success,date_stamp,time_stamp,scm_revision,log)'
349 ,'(',db_quote(package)
350 ,',',db_quote(which_system)
351 ,',',db_quote(version_upstream(deb_version))
352 ,',',db_quote(version_epoch(deb_version))
353 ,',',db_quote(version_revision(deb_version))
354 ,',',db_cur_version(con)
355 ,',',as.integer(success)
356 ,',',db_quote(format(Sys.time(), db_date_format))
357 ,',',db_quote(format(Sys.time(), db_time_format))
358 ,',',db_quote(scm_revision)
362 try(dbGetQuery(con,sqlcmd))
367 db_builds <- function(pkgname) {
368 # returns all successful builds
370 build <- dbGetQuery(con, paste('SELECT * FROM builds'
372 ,'AND system =',db_quote(which_system)
373 ,'AND package =',db_quote(pkgname)))
375 if (length(build) == 0) {
378 return(db_cleanup_builds(build))
381 db_cleanup_builds <- function(build,verbose=FALSE) {
382 build$success <- as.logical(build$success)
383 #o <-options(digits.secs = 6)
384 dt <- as.POSIXct(strptime(paste(as.character(build[,"date_stamp"]), as.character(build[,"time_stamp"])),
385 paste(db_date_format, db_time_format)))
386 build$time_stamp <- NULL
387 build$date_stamp <- NULL
388 newdf <- data.frame(build, date_stamp=dt)
390 cat("db_cleanup_builds: newdf")
393 #print(newdf[, -grep("log", colnames(newdf))])
395 #print(newdf[, -grep("log", colnames(newdf))])
399 db_latest_build <- function(pkgname,verbose=FALSE,debug=FALSE) {
400 if (verbose) {cat("db_latest_build: pkgname:",pkgname,"\n")}
403 cat(" connection was opened\n")
405 build <- dbGetQuery(con, paste('SELECT * FROM builds'
406 ,'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds'
407 , 'WHERE system =',db_quote(which_system)
408 , 'GROUP BY package) AS last'
410 ,'AND builds.package =',db_quote(pkgname)))
412 cat(" dbGetQuery was executed:\n")
413 cat(" print(build):\n")
418 cat(" connection was closed\n")
420 if (length(build) == 0) {
422 } else if (0 == nrow(build)) {
425 return(db_cleanup_builds(build))
428 db_latest_build_version <- function(pkgname,verbose=FALSE) {
429 if (verbose) {cat("db_latest_build_version: pkgname:",pkgname,"\n")}
430 build <- db_latest_build(pkgname)
431 if (is.null(build)) {
433 } else if (0 == nrow(build)) {
436 return(version_new(build$r_version, pkgname=pkgname, build$deb_revision, build$deb_epoch))
439 db_latest_build_status <- function(pkgname,verbose=FALSE) {
440 if (verbose) {cat("db_latest_build_status: pkgname:",pkgname,"\n")}
441 build <- db_latest_build(pkgname)
442 if (is.null(build)) {
444 } else if (0 == nrow(build)) {
447 return(list(build$success,build$log))
450 db_outdated_packages <- function() {
452 packages <- dbGetQuery(con,paste('SELECT packages.package FROM packages'
454 # extract the latest attempt at building each package
455 , 'SELECT * FROM builds'
456 , 'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds'
457 , 'WHERE system =',db_quote(which_system)
458 , 'GROUP BY package) AS last'
459 , 'WHERE id = max_id) AS build'
460 ,'ON build.package = packages.package'
462 # - there is no latest build
463 ,'WHERE build.package IS NULL'
464 # - the database has changed since last build
465 ,'OR build.db_version < (SELECT max(version) FROM database_versions)'
466 # - the debian epoch has been bumped up
467 ,'OR build.deb_epoch < (SELECT max(base_epoch) FROM database_versions'
468 , 'WHERE version IN ('
469 , 'SELECT max(version) FROM database_versions))'
470 # - the latest build is not of the latest R version
471 ,'OR build.r_version != packages.latest_r_version'
477 db_blacklist_packages <- function() {
479 packages <- dbGetQuery(con,'SELECT package from blacklist_packages')$package
484 db_epoch_override <- function(pkgname) {
486 epoch.override <- dbGetQuery(con,paste('SELECT epoch FROM epoch_override WHERE package = ',db_quote(pkgname)))
487 print(c("pkgname: ",pkgname))
488 print(epoch.override)
490 if(NROW(epoch.override)>=1) {
491 return(epoch.override$epoch[1])
498 db_blacklist_reasons <- function () {
500 packages <- dbGetQuery(con,'SELECT package,explanation from blacklist_packages group by explanation')
505 db_todays_builds <- function() {
506 today <- db_quote(format(Sys.time(), db_date_format))
508 builds <- dbGetQuery(con,paste('select id,success,system,package,
509 r_version as version,deb_epoch as epo,
510 deb_revision as rev, scm_revision as svnrev,
511 db_version as db,date_stamp,time_stamp
512 from builds where date_stamp = ',today))
517 db_successful_builds <- function() {
519 builds <- dbGetQuery(con,'select system,package,r_version,date_stamp,time_stamp
520 from builds natural join (select system,package,max(id) as id
523 (select package from blacklist_packages)
524 group by package,system)
530 db_failed_builds <- function() {
532 builds <- dbGetQuery(con,'select system,package,r_version,date_stamp,time_stamp
533 from builds natural join (select system,package,max(id) as id
536 (select package from blacklist_packages)
537 group by package,system)