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