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 ,',alias TEXT NOT NULL'
15 ,',build INTEGER NOT NULL'
16 ,',debian_pkg TEXT NOT NULL'
17 ,',UNIQUE (alias,build,debian_pkg)'
20 if (!dbExistsTable(con,'forced_depends')) {
21 dbGetQuery(con,paste('CREATE TABLE forced_depends ('
22 ,' r_name TEXT NOT NULL'
23 ,',depend_alias TEXT NOT NULL'
24 ,',PRIMARY KEY (r_name,depend_alias)'
27 if (!dbExistsTable(con,'license_override')) {
28 dbGetQuery(con,paste('CREATE TABLE license_override ('
29 ,' name TEXT PRIMARY KEY NOT NULL'
30 ,',accept INT NOT NULL'
33 if (!dbExistsTable(con,'license_hashes')) {
34 dbGetQuery(con,paste('CREATE TABLE license_hashes ('
35 ,' name TEXT NOT NULL'
36 ,',sha1 TEXT PRIMARY KEY NOT NULL'
39 if (!dbExistsTable(con,'database_versions')) {
40 dbGetQuery(con,paste('CREATE TABLE database_versions ('
41 ,' version INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL'
42 ,',version_date INTEGER NOT NULL'
43 ,',base_epoch INTEGER NOT NULL'
45 db_add_version(con,1,0)
47 if (!dbExistsTable(con,'packages')) {
48 dbGetQuery(con,paste('CREATE TABLE packages ('
49 ,' package TEXT PRIMARY KEY NOT NULL'
50 ,',latest_r_version TEXT'
53 if (!dbExistsTable(con,'builds')) {
54 dbGetQuery(con,paste('CREATE TABLE builds ('
55 ,' id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL'
56 ,',system TEXT NOT NULL'
57 ,',package TEXT NOT NULL'
58 ,',r_version TEXT NOT NULL'
59 ,',deb_epoch INTEGER NOT NULL'
60 ,',deb_revision INTEGER NOT NULL'
61 ,',db_version INTEGER NOT NULL'
62 ,',date_stamp TEXT NOT NULL'
63 ,',time_stamp TEXT NOT NULL'
64 ,',scm_revision TEXT NOT NULL'
65 ,',success INTEGER NOT NULL'
67 ,',UNIQUE(package,system,r_version,deb_epoch,deb_revision,db_version)'
70 if (!dbExistsTable(con,'blacklist_packages')) {
71 dbGetQuery(con,paste('CREATE TABLE blacklist_packages ('
72 ,' package TEXT PRIMARY KEY NOT NULL '
73 ,',nonfree INTEGER NOT NULL DEFAULT 0'
74 ,',obsolete INTEGER NOT NULL DEFAULT 0'
75 ,',broken_dependency INTEGER NOT NULL DEFAULT 0'
76 ,',unsatisfied_dependency INTEGER NOT NULL DEFAULT 0'
77 ,',breaks_cran2deb INTEGER NOT NULL DEFAULT 0'
78 ,',other INTEGER NOT NULL DEFAULT 0'
79 ,',explanation TEXT NOT NULL '
85 db_stop <- function(con,bump=F) {
92 db_quote <- function(text) {
93 return(paste('\'', gsub('([\'"])','\\1\\1',text),'\'',sep=''))
96 db_now <- function() {
97 return(as.integer(gsub('-','',Sys.Date())))
100 db_cur_version <- function(con) {
101 return(as.integer(dbGetQuery(con, 'SELECT max(version) FROM database_versions')[[1]]))
104 db_base_epoch <- function(con) {
105 return(as.integer(dbGetQuery(con,
106 paste('SELECT max(base_epoch) FROM database_versions'
107 ,'WHERE version IN (SELECT max(version) FROM database_versions)'))[[1]]))
110 db_get_base_epoch <- function() {
112 v <- db_base_epoch(con)
117 db_get_version <- function() {
119 v <- db_cur_version(con)
124 db_add_version <- function(con, version, epoch) {
125 dbGetQuery(con,paste('INSERT INTO database_versions (version,version_date,base_epoch)'
126 ,'VALUES (',as.integer(version),',',db_now(),',',as.integer(epoch),')'))
129 db_bump <- function(con) {
130 db_add_version(con,db_cur_version(con)+1, db_base_epoch(con))
133 db_bump_epoch <- function(con) {
134 db_add_version(con,db_cur_version(con)+1, db_base_epoch(con)+1)
137 db_sysreq_override <- function(sysreq_text) {
139 results <- dbGetQuery(con,paste(
140 'SELECT DISTINCT depend_alias FROM sysreq_override WHERE'
141 ,db_quote(tolower(sysreq_text)),'LIKE r_pattern'))
143 if (length(results) == 0) {
146 return(results$depend_alias)
149 db_add_sysreq_override <- function(pattern,depend_alias) {
151 results <- dbGetQuery(con,paste(
152 'INSERT OR REPLACE INTO sysreq_override'
153 ,'(depend_alias, r_pattern) VALUES ('
154 ,' ',db_quote(tolower(depend_alias))
155 ,',',db_quote(tolower(pattern))
160 db_sysreq_overrides <- function() {
162 overrides <- dbGetQuery(con,paste('SELECT * FROM sysreq_override'))
167 db_get_depends <- function(depend_alias,build=F) {
169 results <- dbGetQuery(con,paste(
170 'SELECT DISTINCT debian_pkg FROM debian_dependency WHERE'
171 ,db_quote(tolower(depend_alias)),'= alias'
172 ,'AND',as.integer(build),'= build'))
174 return(results$debian_pkg)
177 db_add_depends <- function(depend_alias,debian_pkg,build=F) {
179 results <- dbGetQuery(con,paste(
180 'INSERT OR REPLACE INTO debian_dependency'
181 ,'(alias, build, debian_pkg) VALUES ('
182 ,' ',db_quote(tolower(depend_alias))
183 ,',',as.integer(build)
184 ,',',db_quote(tolower(debian_pkg))
189 db_depends <- function() {
191 depends <- dbGetQuery(con,paste('SELECT * FROM debian_dependency'))
196 db_get_forced_depends <- function(r_name) {
198 forced_depends <- dbGetQuery(con,
199 paste('SELECT depend_alias FROM forced_depends WHERE'
200 ,db_quote(r_name),'= r_name'))
202 return(forced_depends$depend_alias)
205 db_add_forced_depends <- function(r_name, depend_alias) {
206 if (!length(db_get_depends(depend_alias,build=F)) &&
207 !length(db_get_depends(depend_alias,build=T))) {
208 fail('Debian dependency alias',depend_alias,'is not know,'
209 ,'yet trying to force a dependency on it?')
213 paste('INSERT OR REPLACE INTO forced_depends (r_name, depend_alias)'
214 ,'VALUES (',db_quote(r_name),',',db_quote(depend_alias),')'))
218 db_forced_depends <- function() {
220 depends <- dbGetQuery(con,paste('SELECT * FROM forced_depends'))
225 db_license_override_name <- function(name) {
227 results <- dbGetQuery(con,paste(
228 'SELECT DISTINCT accept FROM license_override WHERE'
229 ,db_quote(tolower(name)),'= name'))
231 if (length(results) == 0) {
234 return(as.logical(results$accept))
237 db_add_license_override <- function(name,accept) {
238 notice('adding',name,'accept?',accept)
239 if (accept != TRUE && accept != FALSE) {
240 fail('accept must be TRUE or FALSE')
243 results <- dbGetQuery(con,paste(
244 'INSERT OR REPLACE INTO license_override'
245 ,'(name, accept) VALUES ('
246 ,' ',db_quote(tolower(name))
247 ,',',as.integer(accept)
252 db_license_override_hash <- function(license_sha1) {
254 results <- dbGetQuery(con,paste(
255 'SELECT DISTINCT accept FROM license_override'
256 ,'INNER JOIN license_hashes'
257 ,'ON license_hashes.name = license_override.name WHERE'
258 ,db_quote(tolower(license_sha1)),'= license_hashes.sha1'))
260 if (length(results) == 0) {
263 return(as.logical(results$accept))
266 db_license_overrides <- function() {
268 overrides <- dbGetQuery(con,paste('SELECT * FROM license_override'))
269 hashes <- dbGetQuery(con,paste('SELECT * FROM license_hashes'))
271 return(list(overrides=overrides,hashes=hashes))
274 db_add_license_hash <- function(name,license_sha1) {
275 if (is.null(db_license_override_name(name))) {
276 fail('license',name,'is not know, yet trying to add a hash for it?')
278 notice('adding hash',license_sha1,'for',name)
280 dbGetQuery(con,paste(
281 'INSERT OR REPLACE INTO license_hashes'
282 ,'(name, sha1) VALUES ('
283 ,' ',db_quote(tolower(name))
284 ,',',db_quote(tolower(license_sha1))
290 db_update_package_versions <- function() {
291 # seems like the quickest way of doing this:
293 dbGetQuery(con, 'DROP TABLE packages')
295 # db_start re-makes all tables
297 for (package in available[,'Package']) {
298 dbGetQuery(con, paste('INSERT OR REPLACE INTO packages (package,latest_r_version)'
299 ,'VALUES (',db_quote(package)
300 ,',',db_quote(available[package,'Version']),')'))
302 dbGetQuery(con,'DELETE FROM builds WHERE builds.package NOT IN (SELECT package FROM packages)')
306 db_date_format <- '%Y-%m-%d'
307 db_time_format <- '%H:%M:%OS %Z'
309 db_record_build <- function(package, deb_version, log, success=F) {
311 o<-options(digits.secs = 6)
312 dbGetQuery(con,paste('INSERT OR REPLACE INTO builds'
313 ,'(package,system,r_version,deb_epoch,deb_revision,db_version,success,date_stamp,time_stamp,scm_revision,log)'
315 ,'(',db_quote(package)
316 ,',',db_quote(which_system)
317 ,',',db_quote(version_upstream(deb_version))
318 ,',',db_quote(version_epoch(deb_version))
319 ,',',db_quote(version_revision(deb_version))
320 ,',',db_cur_version(con)
321 ,',',as.integer(success)
322 ,',',db_quote(format(Sys.time(), db_date_format))
323 ,',',db_quote(format(Sys.time(), db_time_format))
324 ,',',db_quote(scm_revision)
325 ,',',db_quote(paste(log, collapse='\n'))
331 db_builds <- function(pkgname) {
332 # returns all successful builds
334 build <- dbGetQuery(con, paste('SELECT * FROM builds'
336 ,'AND system =',db_quote(which_system)
337 ,'AND package =',db_quote(pkgname)))
339 if (length(build) == 0) {
342 return(db_cleanup_builds(build))
345 db_cleanup_builds <- function(build) {
346 build$success <- as.logical(build$success)
347 #o <-options(digits.secs = 6)
348 dt <- as.POSIXct(strptime(paste(as.character(build[,"date_stamp"]), as.character(build[,"time_stamp"])),
349 paste(db_date_format, db_time_format)))
350 build$time_stamp <- NULL
351 build$date_stamp <- NULL
352 newdf <- data.frame(build, date_stamp=dt)
353 #print(newdf[, -grep("log", colnames(newdf))])
355 #print(newdf[, -grep("log", colnames(newdf))])
359 db_latest_build <- function(pkgname) {
361 build <- dbGetQuery(con, paste('SELECT * FROM builds'
362 ,'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds'
363 , 'WHERE system =',db_quote(which_system)
364 , 'GROUP BY package) AS last'
366 ,'AND builds.package =',db_quote(pkgname)))
368 if (length(build) == 0) {
371 return(db_cleanup_builds(build))
374 db_latest_build_version <- function(pkgname) {
375 build <- db_latest_build(pkgname)
376 if (is.null(build)) {
379 return(version_new(build$r_version, build$deb_revision, build$deb_epoch))
382 db_latest_build_status <- function(pkgname) {
383 build <- db_latest_build(pkgname)
384 if (is.null(build)) {
387 return(list(build$success,build$log))
390 db_outdated_packages <- function() {
392 packages <- dbGetQuery(con,paste('SELECT packages.package FROM packages'
394 # extract the latest attempt at building each package
395 , 'SELECT * FROM builds'
396 , 'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds'
397 , 'WHERE system =',db_quote(which_system)
398 , 'GROUP BY package) AS last'
399 , 'WHERE id = max_id) AS build'
400 ,'ON build.package = packages.package'
402 # - there is no latest build
403 ,'WHERE build.package IS NULL'
404 # - the database has changed since last build
405 ,'OR build.db_version < (SELECT max(version) FROM database_versions)'
406 # - the debian epoch has been bumped up
407 ,'OR build.deb_epoch < (SELECT max(base_epoch) FROM database_versions'
408 , 'WHERE version IN ('
409 , 'SELECT max(version) FROM database_versions))'
410 # - the latest build is not of the latest R version
411 ,'OR build.r_version != packages.latest_r_version'
417 db_blacklist_packages <- function() {
419 packages <- dbGetQuery(con,'SELECT package from blacklist_packages')$package
424 db_blacklist_reasons <- function () {
426 packages <- dbGetQuery(con,'SELECT package,explanation from blacklist_packages')
431 db_todays_builds <- function() {
432 today <- db_quote(format(Sys.time(), db_date_format))
434 builds <- dbGetQuery(con,paste('select id,success,system,package,
435 r_version as version,deb_epoch as epo,
436 deb_revision as rev, scm_revision as svnrev,
437 db_version as db,date_stamp,time_stamp
438 from builds where date_stamp = ',today))
443 db_successful_builds <- function() {
445 builds <- dbGetQuery(con,'select system,package,r_version,date_stamp,time_stamp
446 from builds natural join (select system,package,max(id) as id
449 (select package from blacklist_packages)
450 group by package,system)
456 db_failed_builds <- function() {
458 builds <- dbGetQuery(con,'select system,package,r_version,date_stamp,time_stamp
459 from builds natural join (select system,package,max(id) as id
462 (select package from blacklist_packages)
463 group by package,system)