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 ,',package TEXT NOT NULL'
57 ,',r_version TEXT NOT NULL'
58 ,',deb_epoch INTEGER NOT NULL'
59 ,',deb_revision INTEGER NOT NULL'
60 ,',db_version INTEGER NOT NULL'
61 ,',success INTEGER NOT NULL'
63 ,',UNIQUE(package,r_version,deb_epoch,deb_revision,db_version)'
69 db_stop <- function(con,bump=F) {
76 db_quote <- function(text) {
77 return(paste('"',gsub('([^][[:alnum:][:space:]*?.,()<>;:/=+%-])','\\\\\\5',text),'"',sep=''))
80 db_now <- function() {
81 return(as.integer(gsub('-','',Sys.Date())))
84 db_cur_version <- function(con) {
85 return(as.integer(dbGetQuery(con, 'SELECT max(version) FROM database_versions')[[1]]))
88 db_base_epoch <- function(con) {
89 return(as.integer(dbGetQuery(con,
90 paste('SELECT max(base_epoch) FROM database_versions'
91 ,'WHERE version IN (SELECT max(version) FROM database_versions)'))[[1]]))
94 db_get_base_epoch <- function() {
96 v <- db_base_epoch(con)
101 db_add_version <- function(con, version, epoch) {
102 dbGetQuery(con,paste('INSERT INTO database_versions (version,version_date,base_epoch)'
103 ,'VALUES (',as.integer(version),',',db_now(),',',as.integer(epoch),')'))
106 db_bump <- function(con) {
107 db_add_version(con,db_cur_version(con)+1, db_base_epoch(con))
110 db_bump_epoch <- function(con) {
111 db_add_version(con,db_cur_version(con)+1, db_base_epoch(con)+1)
114 db_sysreq_override <- function(sysreq_text) {
116 results <- dbGetQuery(con,paste(
117 'SELECT DISTINCT depend_alias FROM sysreq_override WHERE'
118 ,db_quote(tolower(sysreq_text)),'LIKE r_pattern'))
120 if (length(results) == 0) {
123 return(results$depend_alias)
126 db_add_sysreq_override <- function(pattern,depend_alias) {
128 results <- dbGetQuery(con,paste(
129 'INSERT OR REPLACE INTO sysreq_override'
130 ,'(depend_alias, r_pattern) VALUES ('
131 ,' ',db_quote(tolower(depend_alias))
132 ,',',db_quote(tolower(pattern))
137 db_sysreq_overrides <- function() {
139 overrides <- dbGetQuery(con,paste('SELECT * FROM sysreq_override'))
144 db_get_depends <- function(depend_alias,build=F) {
146 results <- dbGetQuery(con,paste(
147 'SELECT DISTINCT debian_pkg FROM debian_dependency WHERE'
148 ,db_quote(tolower(depend_alias)),'= alias'
149 ,'AND',as.integer(build),'= build'))
151 return(results$debian_pkg)
154 db_add_depends <- function(depend_alias,debian_pkg,build=F) {
156 results <- dbGetQuery(con,paste(
157 'INSERT OR REPLACE INTO debian_dependency'
158 ,'(alias, build, debian_pkg) VALUES ('
159 ,' ',db_quote(tolower(depend_alias))
160 ,',',as.integer(build)
161 ,',',db_quote(tolower(debian_pkg))
166 db_depends <- function() {
168 depends <- dbGetQuery(con,paste('SELECT * FROM debian_dependency'))
173 db_get_forced_depends <- function(r_name) {
175 forced_depends <- dbGetQuery(con,
176 paste('SELECT depend_alias FROM forced_depends WHERE'
177 ,db_quote(r_name),'= r_name'))
179 return(forced_depends$depend_alias)
182 db_add_forced_depends <- function(r_name, depend_alias) {
183 if (!length(db_get_depends(depend_alias,build=F)) &&
184 !length(db_get_depends(depend_alias,build=T))) {
185 fail('Debian dependency alias',depend_alias,'is not know,'
186 ,'yet trying to force a dependency on it?')
190 paste('INSERT OR REPLACE INTO forced_depends (r_name, depend_alias)'
191 ,'VALUES (',db_quote(r_name),',',db_quote(depend_alias),')'))
195 db_forced_depends <- function() {
197 depends <- dbGetQuery(con,paste('SELECT * FROM forced_depends'))
202 db_license_override_name <- function(name) {
204 results <- dbGetQuery(con,paste(
205 'SELECT DISTINCT accept FROM license_override WHERE'
206 ,db_quote(tolower(name)),'= name'))
208 if (length(results) == 0) {
211 return(as.logical(results$accept))
214 db_add_license_override <- function(name,accept) {
215 notice('adding',name,'accept?',accept)
216 if (accept != TRUE && accept != FALSE) {
217 fail('accept must be TRUE or FALSE')
220 results <- dbGetQuery(con,paste(
221 'INSERT OR REPLACE INTO license_override'
222 ,'(name, accept) VALUES ('
223 ,' ',db_quote(tolower(name))
224 ,',',as.integer(accept)
229 db_license_override_hash <- function(license_sha1) {
231 results <- dbGetQuery(con,paste(
232 'SELECT DISTINCT accept FROM license_override'
233 ,'INNER JOIN license_hashes'
234 ,'ON license_hashes.name = license_override.name WHERE'
235 ,db_quote(tolower(license_sha1)),'= license_hashes.sha1'))
237 if (length(results) == 0) {
240 return(as.logical(results$accept))
243 db_license_overrides <- function() {
245 overrides <- dbGetQuery(con,paste('SELECT * FROM license_override'))
246 hashes <- dbGetQuery(con,paste('SELECT * FROM license_hashes'))
248 return(list(overrides=overrides,hashes=hashes))
251 db_add_license_hash <- function(name,license_sha1) {
252 if (is.na(db_license_override_name(name))) {
253 fail('license',name,'is not know, yet trying to add a hash for it?')
255 notice('adding hash',license_sha1,'for',name)
257 dbGetQuery(con,paste(
258 'INSERT OR REPLACE INTO license_hashes'
259 ,'(name, sha1) VALUES ('
260 ,' ',db_quote(tolower(name))
261 ,',',db_quote(tolower(license_sha1))
267 db_update_package_versions <- function() {
269 for (package in available[,'Package']) {
270 dbGetQuery(con, paste('INSERT OR REPLACE INTO packages (package,latest_r_version)'
271 ,'VALUES (',db_quote(package)
272 ,',',db_quote(available[package,'Version']),')'))
277 db_record_build <- function(package, deb_version, log, success=F) {
279 dbGetQuery(con,paste('INSERT INTO builds'
280 ,'(package,r_version,deb_epoch,deb_revision,db_version,success,log)'
282 ,'(',db_quote(package)
283 ,',',db_quote(version_upstream(deb_version))
284 ,',',db_quote(version_epoch(deb_version))
285 ,',',db_quote(version_revision(deb_version))
286 ,',',db_cur_version(con)
287 ,',',as.integer(success)
288 ,',',db_quote(paste(log, collapse='\n'))
293 db_latest_build <- function(pkgname) {
295 build <- dbGetQuery(con, paste('SELECT * FROM builds'
296 ,'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds'
297 , 'GROUP BY package) AS last'
299 ,'AND builds.package =',db_quote(pkgname)))
304 db_latest_build_version <- function(pkgname) {
305 build <- db_latest_build(pkgname)
306 if (length(build) == 0) {
309 return(version_new(build$r_version, build$deb_revision, build$deb_epoch))
312 db_latest_build_status <- function(pkgname) {
313 build <- db_latest_build(pkgname)
314 if (length(build) == 0) {
317 return(c(build$success,build$log))
320 db_outdated_packages <- function() {
322 packages <- dbGetQuery(con,paste('SELECT packages.package FROM packages'
324 # extract the latest attempt at building each package
325 , 'SELECT * FROM builds'
326 , 'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds'
327 , 'GROUP BY package) AS last'
328 , 'WHERE id = max_id) AS build'
329 ,'ON build.package = packages.package'
331 # - there is no latest build
332 ,'WHERE build.package IS NULL'
333 # - the database has changed since last build
334 ,'OR build.db_version < (SELECT max(version) FROM database_versions)'
335 # - the debian epoch has been bumped up
336 ,'OR build.deb_epoch < (SELECT max(base_epoch) FROM database_versions'
337 , 'WHERE version IN ('
338 , 'SELECT max(version) FROM database_versions))'
339 # - the latest build is not of the latest R version
340 ,'OR build.r_version != packages.latest_r_version'