pkg/trunk/R/db.R

   1
   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'
   9                   ,')'))
  10     }
  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)'
  18                   ,')'))
  19     }
  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)'
  25                   ,')'))
  26     }
  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'
  31                   ,')'))
  32     }
  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'
  37                   ,')'))
  38     }
  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'
  44                   ,')'))
  45         db_add_version(con,1,0)
  46     }
  47     if (!dbExistsTable(con,'packages')) {
  48         dbGetQuery(con,paste('CREATE TABLE packages ('
  49                   ,' package TEXT PRIMARY KEY NOT NULL'
  50                   ,',latest_r_version TEXT'
  51                   ,')'))
  52     }
  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'
  62                   ,',log TEXT'
  63                   ,',UNIQUE(package,r_version,deb_epoch,deb_revision,db_version)'
  64                   ,')'))
  65     }
  66     return(con)
  67 }
  68
  69 db_stop <- function(con,bump=F) {
  70     if (bump) {
  71         db_bump(con)
  72     }
  73     dbDisconnect(con)
  74 }
  75
  76 db_quote <- function(text) {
  77     return(paste('\'', gsub('([\'"])','\\1\\1',text),'\'',sep=''))
  78 }
  79
  80 db_now <- function() {
  81     return(as.integer(gsub('-','',Sys.Date())))
  82 }
  83
  84 db_cur_version <- function(con) {
  85     return(as.integer(dbGetQuery(con, 'SELECT max(version) FROM database_versions')[[1]]))
  86 }
  87
  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]]))
  92 }
  93
  94 db_get_base_epoch <- function() {
  95     con <- db_start()
  96     v <- db_base_epoch(con)
  97     db_stop(con)
  98     return(v)
  99 }
 100
 101 db_get_version <- function() {
 102     con <- db_start()
 103     v <- db_cur_version(con)
 104     db_stop(con)
 105     return(v)
 106 }
 107
 108 db_add_version <- function(con, version, epoch) {
 109     dbGetQuery(con,paste('INSERT INTO database_versions (version,version_date,base_epoch)'
 110               ,'VALUES (',as.integer(version),',',db_now(),',',as.integer(epoch),')'))
 111 }
 112
 113 db_bump <- function(con) {
 114     db_add_version(con,db_cur_version(con)+1, db_base_epoch(con))
 115 }
 116
 117 db_bump_epoch <- function(con) {
 118     db_add_version(con,db_cur_version(con)+1, db_base_epoch(con)+1)
 119 }
 120
 121 db_sysreq_override <- function(sysreq_text) {
 122     con <- db_start()
 123     results <- dbGetQuery(con,paste(
 124                     'SELECT DISTINCT depend_alias FROM sysreq_override WHERE'
 125                             ,db_quote(tolower(sysreq_text)),'LIKE r_pattern'))
 126     db_stop(con)
 127     if (length(results) == 0) {
 128         return(NULL)
 129     }
 130     return(results$depend_alias)
 131 }
 132
 133 db_add_sysreq_override <- function(pattern,depend_alias) {
 134     con <- db_start()
 135     results <- dbGetQuery(con,paste(
 136                      'INSERT OR REPLACE INTO sysreq_override'
 137                     ,'(depend_alias, r_pattern) VALUES ('
 138                     ,' ',db_quote(tolower(depend_alias))
 139                     ,',',db_quote(tolower(pattern))
 140                     ,')'))
 141     db_stop(con,TRUE)
 142 }
 143
 144 db_sysreq_overrides <- function() {
 145     con <- db_start()
 146     overrides <- dbGetQuery(con,paste('SELECT * FROM sysreq_override'))
 147     db_stop(con)
 148     return(overrides)
 149 }
 150
 151 db_get_depends <- function(depend_alias,build=F) {
 152     con <- db_start()
 153     results <- dbGetQuery(con,paste(
 154                     'SELECT DISTINCT debian_pkg FROM debian_dependency WHERE'
 155                     ,db_quote(tolower(depend_alias)),'= alias'
 156                     ,'AND',as.integer(build),'= build'))
 157     db_stop(con)
 158     return(results$debian_pkg)
 159 }
 160
 161 db_add_depends <- function(depend_alias,debian_pkg,build=F) {
 162     con <- db_start()
 163     results <- dbGetQuery(con,paste(
 164                      'INSERT OR REPLACE INTO debian_dependency'
 165                     ,'(alias, build, debian_pkg) VALUES ('
 166                     ,' ',db_quote(tolower(depend_alias))
 167                     ,',',as.integer(build)
 168                     ,',',db_quote(tolower(debian_pkg))
 169                     ,')'))
 170     db_stop(con,TRUE)
 171 }
 172
 173 db_depends <- function() {
 174     con <- db_start()
 175     depends <- dbGetQuery(con,paste('SELECT * FROM debian_dependency'))
 176     db_stop(con)
 177     return(depends)
 178 }
 179
 180 db_get_forced_depends <- function(r_name) {
 181     con <- db_start()
 182     forced_depends <- dbGetQuery(con,
 183                 paste('SELECT depend_alias FROM forced_depends WHERE'
 184                      ,db_quote(r_name),'= r_name'))
 185     db_stop(con)
 186     return(forced_depends$depend_alias)
 187 }
 188
 189 db_add_forced_depends <- function(r_name, depend_alias) {
 190     if (!length(db_get_depends(depend_alias,build=F)) &&
 191         !length(db_get_depends(depend_alias,build=T))) {
 192         fail('Debian dependency alias',depend_alias,'is not know,'
 193                   ,'yet trying to force a dependency on it?')
 194     }
 195     con <- db_start()
 196     dbGetQuery(con,
 197             paste('INSERT OR REPLACE INTO forced_depends (r_name, depend_alias)'
 198                  ,'VALUES (',db_quote(r_name),',',db_quote(depend_alias),')'))
 199     db_stop(con,TRUE)
 200 }
 201
 202 db_forced_depends <- function() {
 203     con <- db_start()
 204     depends <- dbGetQuery(con,paste('SELECT * FROM forced_depends'))
 205     db_stop(con)
 206     return(depends)
 207 }
 208
 209 db_license_override_name <- function(name) {
 210     con <- db_start()
 211     results <- dbGetQuery(con,paste(
 212                     'SELECT DISTINCT accept FROM license_override WHERE'
 213                             ,db_quote(tolower(name)),'= name'))
 214     db_stop(con)
 215     if (length(results) == 0) {
 216         return(NA)
 217     }
 218     return(as.logical(results$accept))
 219 }
 220
 221 db_add_license_override <- function(name,accept) {
 222     notice('adding',name,'accept?',accept)
 223     if (accept != TRUE && accept != FALSE) {
 224         fail('accept must be TRUE or FALSE')
 225     }
 226     con <- db_start()
 227     results <- dbGetQuery(con,paste(
 228                      'INSERT OR REPLACE INTO license_override'
 229                     ,'(name, accept) VALUES ('
 230                     ,' ',db_quote(tolower(name))
 231                     ,',',as.integer(accept)
 232                     ,')'))
 233     db_stop(con,TRUE)
 234 }
 235
 236 db_license_override_hash <- function(license_sha1) {
 237     con <- db_start()
 238     results <- dbGetQuery(con,paste(
 239                      'SELECT DISTINCT accept FROM license_override'
 240                     ,'INNER JOIN license_hashes'
 241                     ,'ON license_hashes.name = license_override.name WHERE'
 242                     ,db_quote(tolower(license_sha1)),'= license_hashes.sha1'))
 243     db_stop(con)
 244     if (length(results) == 0) {
 245         return(NA)
 246     }
 247     return(as.logical(results$accept))
 248 }
 249
 250 db_license_overrides <- function() {
 251     con <- db_start()
 252     overrides <- dbGetQuery(con,paste('SELECT * FROM license_override'))
 253     hashes    <- dbGetQuery(con,paste('SELECT * FROM license_hashes'))
 254     db_stop(con)
 255     return(list(overrides=overrides,hashes=hashes))
 256 }
 257
 258 db_add_license_hash <- function(name,license_sha1) {
 259     if (is.na(db_license_override_name(name))) {
 260         fail('license',name,'is not know, yet trying to add a hash for it?')
 261     }
 262     notice('adding hash',license_sha1,'for',name)
 263     con <- db_start()
 264     dbGetQuery(con,paste(
 265          'INSERT OR REPLACE INTO license_hashes'
 266         ,'(name, sha1) VALUES ('
 267         ,' ',db_quote(tolower(name))
 268         ,',',db_quote(tolower(license_sha1))
 269         ,')'))
 270     db_stop(con,TRUE)
 271 }
 272
 273
 274 db_update_package_versions <- function() {
 275     con <- db_start()
 276     for (package in available[,'Package']) {
 277         dbGetQuery(con, paste('INSERT OR REPLACE INTO packages (package,latest_r_version)'
 278                              ,'VALUES (',db_quote(package)
 279                              ,',',db_quote(available[package,'Version']),')'))
 280     }
 281     db_stop(con)
 282 }
 283
 284 db_record_build <- function(package, deb_version, log, success=F) {
 285     con <- db_start()
 286     dbGetQuery(con,paste('INSERT OR REPLACE INTO builds'
 287                         ,'(package,r_version,deb_epoch,deb_revision,db_version,success,log)'
 288                         ,'VALUES'
 289                         ,'(',db_quote(package)
 290                         ,',',db_quote(version_upstream(deb_version))
 291                         ,',',db_quote(version_epoch(deb_version))
 292                         ,',',db_quote(version_revision(deb_version))
 293                         ,',',db_cur_version(con)
 294                         ,',',as.integer(success)
 295                         ,',',db_quote(paste(log, collapse='\n'))
 296                         ,')'))
 297     db_stop(con)
 298 }
 299
 300 db_latest_build <- function(pkgname) {
 301     con <- db_start()
 302     build <- dbGetQuery(con, paste('SELECT * FROM builds'
 303                        ,'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds'
 304                        ,              'GROUP BY package) AS last'
 305                        ,'WHERE id = max_id'
 306                        ,'AND builds.package =',db_quote(pkgname)))
 307     db_stop(con)
 308     if (length(build) == 0) {
 309         return(NULL)
 310     }
 311     build$success <- as.logical(build$success)
 312     return(build)
 313 }
 314
 315 db_latest_build_version <- function(pkgname) {
 316     build <- db_latest_build(pkgname)
 317     if (is.null(build)) {
 318         return(NULL)
 319     }
 320     return(version_new(build$r_version, build$deb_revision, build$deb_epoch))
 321 }
 322
 323 db_latest_build_status <- function(pkgname) {
 324     build <- db_latest_build(pkgname)
 325     if (is.null(build)) {
 326         return(NULL)
 327     }
 328     return(list(build$success,build$log))
 329 }
 330
 331 db_outdated_packages <- function() {
 332     con <- db_start()
 333     packages <- dbGetQuery(con,paste('SELECT packages.package FROM packages'
 334                ,'LEFT OUTER JOIN ('
 335                # extract the latest attempt at building each package
 336                ,      'SELECT * FROM builds'
 337                ,      'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds'
 338                ,                    'GROUP BY package) AS last'
 339                ,      'WHERE id = max_id) AS build'
 340                ,'ON build.package = packages.package'
 341                # outdated iff:
 342                # - there is no latest build
 343                ,'WHERE build.package IS NULL'
 344                # - the database has changed since last build
 345                ,'OR build.db_version < (SELECT max(version) FROM database_versions)'
 346                # - the debian epoch has been bumped up
 347                ,'OR build.deb_epoch < (SELECT max(base_epoch) FROM database_versions'
 348                ,                        'WHERE version IN ('
 349                ,                            'SELECT max(version) FROM database_versions))'
 350                # - the latest build is not of the latest R version
 351                ,'OR build.r_version != packages.latest_r_version'
 352                ))$package
 353     db_stop(con)
 354     return(packages)
 355 }
 356