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