2 db_start <- function() {
3 drv <- dbDriver('SQLite')
4 con <- dbConnect(drv, dbname=file.path(cache_root,'cran2deb.db'))
5 if (!dbExistsTable(con,'sysreq_override')) {
6 dbGetQuery(con,paste('CREATE TABLE sysreq_override ('
7 ,' depend_alias TEXT NOT NULL'
8 ,',r_pattern TEXT PRIMARY KEY NOT NULL'
11 if (!dbExistsTable(con,'debian_dependency')) {
12 dbGetQuery(con,paste('CREATE TABLE debian_dependency ('
13 ,' id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL'
14 ,',system TEXT NOT NULL'
15 ,',alias TEXT NOT NULL'
16 ,',build INTEGER NOT NULL'
17 ,',debian_pkg TEXT NOT NULL'
18 ,',UNIQUE (alias,build,debian_pkg)'
21 if (!dbExistsTable(con,'forced_depends')) {
22 dbGetQuery(con,paste('CREATE TABLE forced_depends ('
23 ,' r_name TEXT NOT NULL'
24 ,',depend_alias TEXT NOT NULL'
25 ,',PRIMARY KEY (r_name,depend_alias)'
28 if (!dbExistsTable(con,'license_override')) {
29 dbGetQuery(con,paste('CREATE TABLE license_override ('
30 ,' name TEXT PRIMARY KEY NOT NULL'
31 ,',accept INT NOT NULL'
34 if (!dbExistsTable(con,'license_hashes')) {
35 dbGetQuery(con,paste('CREATE TABLE license_hashes ('
36 ,' name TEXT NOT NULL'
37 ,',sha1 TEXT PRIMARY KEY NOT NULL'
40 if (!dbExistsTable(con,'database_versions')) {
41 dbGetQuery(con,paste('CREATE TABLE database_versions ('
42 ,' version INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL'
43 ,',version_date INTEGER NOT NULL'
44 ,',base_epoch INTEGER NOT NULL'
46 db_add_version(con,1,0)
48 if (!dbExistsTable(con,'packages')) {
49 dbGetQuery(con,paste('CREATE TABLE packages ('
50 ,' package TEXT PRIMARY KEY NOT NULL'
51 ,',latest_r_version TEXT'
54 if (!dbExistsTable(con,'builds')) {
55 dbGetQuery(con,paste('CREATE TABLE builds ('
56 ,' id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL'
57 ,',system TEXT NOT NULL'
58 ,',package TEXT NOT NULL'
59 ,',r_version TEXT NOT NULL'
60 ,',deb_epoch INTEGER NOT NULL'
61 ,',deb_revision INTEGER NOT NULL'
62 ,',db_version INTEGER NOT NULL'
63 ,',date_stamp TEXT NOT NULL'
64 ,',time_stamp TEXT NOT NULL'
65 ,',scm_revision TEXT NOT NULL'
66 ,',success INTEGER NOT NULL'
68 ,',UNIQUE(package,system,r_version,deb_epoch,deb_revision,db_version)'
71 if (!dbExistsTable(con,'blacklist_packages')) {
72 dbGetQuery(con,paste('CREATE TABLE blacklist_packages ('
73 ,' package TEXT PRIMARY KEY NOT NULL '
74 ,',system TEXT NOT NULL'
75 ,',nonfree INTEGER NOT NULL DEFAULT 0'
76 ,',obsolete INTEGER NOT NULL DEFAULT 0'
77 ,',broken_dependency INTEGER NOT NULL DEFAULT 0'
78 ,',unsatisfied_dependency INTEGER NOT NULL DEFAULT 0'
79 ,',breaks_cran2deb INTEGER NOT NULL DEFAULT 0'
80 ,',other INTEGER NOT NULL DEFAULT 0'
81 ,',explanation TEXT NOT NULL '
87 db_stop <- function(con,bump=F) {
94 db_quote <- function(text) {
95 return(paste('\'', gsub('([\'"])','\\1\\1',text),'\'',sep=''))
98 db_now <- function() {
99 return(as.integer(gsub('-','',Sys.Date())))
102 db_cur_version <- function(con) {
103 return(as.integer(dbGetQuery(con, 'SELECT max(version) FROM database_versions')[[1]]))
106 db_base_epoch <- function(con) {
107 return(as.integer(dbGetQuery(con,
108 paste('SELECT max(base_epoch) FROM database_versions'
109 ,'WHERE version IN (SELECT max(version) FROM database_versions)'))[[1]]))
112 db_get_base_epoch <- function() {
114 v <- db_base_epoch(con)
119 db_get_version <- function() {
121 v <- db_cur_version(con)
126 db_add_version <- function(con, version, epoch) {
127 dbGetQuery(con,paste('INSERT INTO database_versions (version,version_date,base_epoch)'
128 ,'VALUES (',as.integer(version),',',db_now(),',',as.integer(epoch),')'))
131 db_bump <- function(con) {
132 db_add_version(con,db_cur_version(con)+1, db_base_epoch(con))
135 db_bump_epoch <- function(con) {
136 db_add_version(con,db_cur_version(con)+1, db_base_epoch(con)+1)
139 db_sysreq_override <- function(sysreq_text) {
141 results <- dbGetQuery(con,paste(
142 'SELECT DISTINCT depend_alias FROM sysreq_override WHERE'
143 ,db_quote(tolower(sysreq_text)),'LIKE r_pattern'))
145 if (length(results) == 0) {
148 return(results$depend_alias)
151 db_add_sysreq_override <- function(pattern,depend_alias) {
153 results <- dbGetQuery(con,paste(
154 'INSERT OR REPLACE INTO sysreq_override'
155 ,'(depend_alias, r_pattern) VALUES ('
156 ,' ',db_quote(tolower(depend_alias))
157 ,',',db_quote(tolower(pattern))
162 db_sysreq_overrides <- function() {
164 overrides <- dbGetQuery(con,paste('SELECT * FROM sysreq_override'))
169 db_get_depends <- function(depend_alias,build=F) {
171 results <- dbGetQuery(con,paste(
172 'SELECT DISTINCT debian_pkg FROM debian_dependency WHERE'
173 ,db_quote(tolower(depend_alias)),'= alias'
174 ,'AND',as.integer(build),'= build',
175 ,'AND',db_quote(which_system),'= system'))
177 return(results$debian_pkg)
180 db_add_depends <- function(depend_alias,debian_pkg,build=F) {
182 results <- dbGetQuery(con,paste(
183 'INSERT OR REPLACE INTO debian_dependency'
184 ,'(system, alias, build, debian_pkg) VALUES ('
185 ,' ',db_quote(which_system)
186 ,' ',db_quote(tolower(depend_alias))
187 ,',',as.integer(build)
188 ,',',db_quote(tolower(debian_pkg))
193 db_depends <- function() {
195 depends <- dbGetQuery(con,paste('SELECT * FROM debian_dependency WHERE system = ',db_quote(which_system)))
200 db_get_forced_depends <- function(r_name) {
202 forced_depends <- dbGetQuery(con,
203 paste('SELECT depend_alias FROM forced_depends WHERE'
204 ,db_quote(r_name),'= r_name'))
206 return(forced_depends$depend_alias)
209 db_add_forced_depends <- function(r_name, depend_alias) {
210 if (!length(db_get_depends(depend_alias,build=F)) &&
211 !length(db_get_depends(depend_alias,build=T))) {
212 fail('Debian dependency alias',depend_alias,'is not know,'
213 ,'yet trying to force a dependency on it?')
217 paste('INSERT OR REPLACE INTO forced_depends (r_name, depend_alias)'
218 ,'VALUES (',db_quote(r_name),',',db_quote(depend_alias),')'))
222 db_forced_depends <- function() {
224 depends <- dbGetQuery(con,paste('SELECT * FROM forced_depends'))
229 db_license_override_name <- function(name) {
231 results <- dbGetQuery(con,paste(
232 'SELECT DISTINCT accept FROM license_override WHERE'
233 ,db_quote(tolower(name)),'= name'))
235 if (length(results) == 0) {
238 return(as.logical(results$accept))
241 db_add_license_override <- function(name,accept) {
242 notice('adding',name,'accept?',accept)
243 if (accept != TRUE && accept != FALSE) {
244 fail('accept must be TRUE or FALSE')
247 results <- dbGetQuery(con,paste(
248 'INSERT OR REPLACE INTO license_override'
249 ,'(name, accept) VALUES ('
250 ,' ',db_quote(tolower(name))
251 ,',',as.integer(accept)
256 db_license_override_hash <- function(license_sha1) {
258 results <- dbGetQuery(con,paste(
259 'SELECT DISTINCT accept FROM license_override'
260 ,'INNER JOIN license_hashes'
261 ,'ON license_hashes.name = license_override.name WHERE'
262 ,db_quote(tolower(license_sha1)),'= license_hashes.sha1'))
264 if (length(results) == 0) {
267 return(as.logical(results$accept))
270 db_license_overrides <- function() {
272 overrides <- dbGetQuery(con,paste('SELECT * FROM license_override'))
273 hashes <- dbGetQuery(con,paste('SELECT * FROM license_hashes'))
275 return(list(overrides=overrides,hashes=hashes))
278 db_add_license_hash <- function(name,license_sha1) {
279 if (is.null(db_license_override_name(name))) {
280 fail('license',name,'is not know, yet trying to add a hash for it?')
282 notice('adding hash',license_sha1,'for',name)
284 dbGetQuery(con,paste(
285 'INSERT OR REPLACE INTO license_hashes'
286 ,'(name, sha1) VALUES ('
287 ,' ',db_quote(tolower(name))
288 ,',',db_quote(tolower(license_sha1))
294 db_update_package_versions <- function() {
295 # seems like the quickest way of doing this:
297 dbGetQuery(con, 'DROP TABLE packages')
299 # db_start re-makes all tables
301 for (package in available[,'Package']) {
302 dbGetQuery(con, paste('INSERT OR REPLACE INTO packages (package,latest_r_version)'
303 ,'VALUES (',db_quote(package)
304 ,',',db_quote(available[package,'Version']),')'))
306 dbGetQuery(con,'DELETE FROM builds WHERE builds.package NOT IN (SELECT package FROM packages)')
310 db_date_format <- '%Y-%m-%d'
311 db_time_format <- '%H:%M:%OS'
313 db_record_build <- function(package, deb_version, log, success=F) {
314 # if the log is more than 1kB, only keep the last 1kB.
315 # this is to work around a problem that seems to have appeared in R 2.10 causing calloc errors.
316 # if the log is not pruned then we get the following error:
318 # Error in gsub("(['\"])", "\\1\\1", text) :
319 # Calloc could not allocate (-197080581 of 1) memory
320 # 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)", :
321 # error in evaluating the argument 'statement' in selecting a method for function 'dbGetQuery'
323 log <- paste(log,collapse='\n')
326 if (end > max_log_len) {
327 log <- db_quote(substr(log,end-max_log_len,end))
332 o <- options(digits.secs = 6)
333 sqlcmd <- paste('INSERT OR REPLACE INTO builds'
334 ,'(package,system,r_version,deb_epoch,deb_revision,db_version,success,date_stamp,time_stamp,scm_revision,log)'
336 ,'(',db_quote(package)
337 ,',',db_quote(which_system)
338 ,',',db_quote(version_upstream(deb_version))
339 ,',',db_quote(version_epoch(deb_version))
340 ,',',db_quote(version_revision(deb_version))
341 ,',',db_cur_version(con)
342 ,',',as.integer(success)
343 ,',',db_quote(format(Sys.time(), db_date_format))
344 ,',',db_quote(format(Sys.time(), db_time_format))
345 ,',',db_quote(scm_revision)
349 try(dbGetQuery(con,sqlcmd))
354 db_builds <- function(pkgname) {
355 # returns all successful builds
357 build <- dbGetQuery(con, paste('SELECT * FROM builds'
359 ,'AND system =',db_quote(which_system)
360 ,'AND package =',db_quote(pkgname)))
362 if (length(build) == 0) {
365 return(db_cleanup_builds(build))
368 db_cleanup_builds <- function(build) {
369 build$success <- as.logical(build$success)
370 #o <-options(digits.secs = 6)
371 dt <- as.POSIXct(strptime(paste(as.character(build[,"date_stamp"]), as.character(build[,"time_stamp"])),
372 paste(db_date_format, db_time_format)))
373 build$time_stamp <- NULL
374 build$date_stamp <- NULL
375 newdf <- data.frame(build, date_stamp=dt)
376 #print(newdf[, -grep("log", colnames(newdf))])
378 #print(newdf[, -grep("log", colnames(newdf))])
382 db_latest_build <- function(pkgname) {
384 build <- dbGetQuery(con, paste('SELECT * FROM builds'
385 ,'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds'
386 , 'WHERE system =',db_quote(which_system)
387 , 'GROUP BY package) AS last'
389 ,'AND builds.package =',db_quote(pkgname)))
391 if (length(build) == 0) {
394 return(db_cleanup_builds(build))
397 db_latest_build_version <- function(pkgname) {
398 build <- db_latest_build(pkgname)
399 if (is.null(build)) {
402 return(version_new(build$r_version, build$deb_revision, build$deb_epoch))
405 db_latest_build_status <- function(pkgname) {
406 build <- db_latest_build(pkgname)
407 if (is.null(build)) {
410 return(list(build$success,build$log))
413 db_outdated_packages <- function() {
415 packages <- dbGetQuery(con,paste('SELECT packages.package FROM packages'
417 # extract the latest attempt at building each package
418 , 'SELECT * FROM builds'
419 , 'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds'
420 , 'WHERE system =',db_quote(which_system)
421 , 'GROUP BY package) AS last'
422 , 'WHERE id = max_id) AS build'
423 ,'ON build.package = packages.package'
425 # - there is no latest build
426 ,'WHERE build.package IS NULL'
427 # - the database has changed since last build
428 ,'OR build.db_version < (SELECT max(version) FROM database_versions)'
429 # - the debian epoch has been bumped up
430 ,'OR build.deb_epoch < (SELECT max(base_epoch) FROM database_versions'
431 , 'WHERE version IN ('
432 , 'SELECT max(version) FROM database_versions))'
433 # - the latest build is not of the latest R version
434 ,'OR build.r_version != packages.latest_r_version'
440 db_blacklist_packages <- function() {
442 packages <- dbGetQuery(con,paste('SELECT package from blacklist_packages'
443 ,' where system=',db_quote(which_system)))$package
448 db_blacklist_reasons <- function () {
450 packages <- dbGetQuery(con,paste('SELECT package,explanation from blacklist_packages'
451 ,'where system=',db_quote(which_system),' group by explanation'))
456 db_todays_builds <- function() {
457 today <- db_quote(format(Sys.time(), db_date_format))
459 builds <- dbGetQuery(con,paste('select id,success,system,package,
460 r_version as version,deb_epoch as epo,
461 deb_revision as rev, scm_revision as svnrev,
462 db_version as db,date_stamp,time_stamp
463 from builds where date_stamp = ',today))
468 db_successful_builds <- function() {
470 builds <- dbGetQuery(con,'select system,package,r_version,date_stamp,time_stamp
471 from builds natural join (select system,package,max(id) as id
474 (select package from blacklist_packages
475 where blacklist_packages.system == builds.system)
476 group by package,system)
482 db_failed_builds <- function() {
484 builds <- dbGetQuery(con,'select system,package,r_version,date_stamp,time_stamp
485 from builds natural join (select system,package,max(id) as id
488 (select package from blacklist_packages)
489 group by package,system)