branch/double_build/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                   ,',system TEXT NOT NULL'
  15                   ,',alias TEXT NOT NULL'
  16                   ,',build INTEGER NOT NULL'
  17                   ,',debian_pkg TEXT NOT NULL'
  18                   ,',UNIQUE (alias,build,debian_pkg)'
  19                   ,')'))
  20     }
  21     if (!dbExistsTable(con,'forced_depends')) {
  22         dbGetQuery(con,paste('CREATE TABLE forced_depends ('
  23                   ,' r_name TEXT NOT NULL'
  24                   ,',depend_alias TEXT NOT NULL'
  25                   ,',PRIMARY KEY (r_name,depend_alias)'
  26                   ,')'))
  27     }
  28     if (!dbExistsTable(con,'license_override')) {
  29         dbGetQuery(con,paste('CREATE TABLE license_override ('
  30                   ,' name TEXT PRIMARY KEY NOT NULL'
  31                   ,',accept INT NOT NULL'
  32                   ,')'))
  33     }
  34     if (!dbExistsTable(con,'license_hashes')) {
  35         dbGetQuery(con,paste('CREATE TABLE license_hashes ('
  36                   ,' name TEXT NOT NULL'
  37                   ,',sha1 TEXT PRIMARY KEY NOT NULL'
  38                   ,')'))
  39     }
  40     if (!dbExistsTable(con,'database_versions')) {
  41         dbGetQuery(con,paste('CREATE TABLE database_versions ('
  42                   ,' version INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL'
  43                   ,',version_date INTEGER NOT NULL'
  44                   ,',base_epoch INTEGER NOT NULL'
  45                   ,')'))
  46         db_add_version(con,1,0)
  47     }
  48     if (!dbExistsTable(con,'packages')) {
  49         dbGetQuery(con,paste('CREATE TABLE packages ('
  50                   ,' package TEXT PRIMARY KEY NOT NULL'
  51                   ,',latest_r_version TEXT'
  52                   ,')'))
  53     }
  54     if (!dbExistsTable(con,'builds')) {
  55         dbGetQuery(con,paste('CREATE TABLE builds ('
  56                   ,' id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL'
  57                   ,',system TEXT NOT NULL'
  58                   ,',package TEXT NOT NULL'
  59                   ,',r_version TEXT NOT NULL'
  60                   ,',deb_epoch INTEGER NOT NULL'
  61                   ,',deb_revision INTEGER NOT NULL'
  62                   ,',db_version INTEGER NOT NULL'
  63                   ,',date_stamp TEXT NOT NULL'
  64                   ,',time_stamp TEXT NOT NULL'
  65                   ,',scm_revision TEXT NOT NULL'
  66                   ,',success INTEGER NOT NULL'
  67                   ,',log TEXT'
  68                   ,',UNIQUE(package,system,r_version,deb_epoch,deb_revision,db_version)'
  69                   ,')'))
  70     }
  71     if (!dbExistsTable(con,'blacklist_packages')) {
  72         dbGetQuery(con,paste('CREATE TABLE blacklist_packages ('
  73                   ,' package TEXT PRIMARY KEY NOT NULL '
  74                   ,',system TEXT NOT NULL'
  75                   ,',nonfree INTEGER NOT NULL DEFAULT 0'
  76                   ,',obsolete INTEGER NOT NULL DEFAULT 0'
  77                   ,',broken_dependency INTEGER NOT NULL DEFAULT 0'
  78                   ,',unsatisfied_dependency INTEGER NOT NULL DEFAULT 0'
  79                   ,',breaks_cran2deb INTEGER NOT NULL DEFAULT 0'
  80                   ,',other INTEGER NOT NULL DEFAULT 0'
  81                   ,',explanation TEXT NOT NULL '
  82                   ,')'))
  83     }
  84     return(con)
  85 }
  86
  87 db_stop <- function(con,bump=F) {
  88     if (bump) {
  89         db_bump(con)
  90     }
  91     dbDisconnect(con)
  92 }
  93
  94 db_quote <- function(text) {
  95     return(paste('\'', gsub('([\'"])','\\1\\1',text),'\'',sep=''))
  96 }
  97
  98 db_now <- function() {
  99     return(as.integer(gsub('-','',Sys.Date())))
 100 }
 101
 102 db_cur_version <- function(con) {
 103     return(as.integer(dbGetQuery(con, 'SELECT max(version) FROM database_versions')[[1]]))
 104 }
 105
 106 db_base_epoch <- function(con) {
 107     return(as.integer(dbGetQuery(con,
 108         paste('SELECT max(base_epoch) FROM database_versions'
 109              ,'WHERE version IN (SELECT max(version) FROM database_versions)'))[[1]]))
 110 }
 111
 112 db_get_base_epoch <- function() {
 113     con <- db_start()
 114     v <- db_base_epoch(con)
 115     db_stop(con)
 116     return(v)
 117 }
 118
 119 db_get_version <- function() {
 120     con <- db_start()
 121     v <- db_cur_version(con)
 122     db_stop(con)
 123     return(v)
 124 }
 125
 126 db_add_version <- function(con, version, epoch) {
 127     dbGetQuery(con,paste('INSERT INTO database_versions (version,version_date,base_epoch)'
 128               ,'VALUES (',as.integer(version),',',db_now(),',',as.integer(epoch),')'))
 129 }
 130
 131 db_bump <- function(con) {
 132     db_add_version(con,db_cur_version(con)+1, db_base_epoch(con))
 133 }
 134
 135 db_bump_epoch <- function(con) {
 136     db_add_version(con,db_cur_version(con)+1, db_base_epoch(con)+1)
 137 }
 138
 139 db_sysreq_override <- function(sysreq_text) {
 140     con <- db_start()
 141     results <- dbGetQuery(con,paste(
 142                     'SELECT DISTINCT depend_alias FROM sysreq_override WHERE'
 143                             ,db_quote(tolower(sysreq_text)),'LIKE r_pattern'))
 144     db_stop(con)
 145     if (length(results) == 0) {
 146         return(NULL)
 147     }
 148     return(results$depend_alias)
 149 }
 150
 151 db_add_sysreq_override <- function(pattern,depend_alias) {
 152     con <- db_start()
 153     results <- dbGetQuery(con,paste(
 154                      'INSERT OR REPLACE INTO sysreq_override'
 155                     ,'(depend_alias, r_pattern) VALUES ('
 156                     ,' ',db_quote(tolower(depend_alias))
 157                     ,',',db_quote(tolower(pattern))
 158                     ,')'))
 159     db_stop(con)
 160 }
 161
 162 db_sysreq_overrides <- function() {
 163     con <- db_start()
 164     overrides <- dbGetQuery(con,paste('SELECT * FROM sysreq_override'))
 165     db_stop(con)
 166     return(overrides)
 167 }
 168
 169 db_get_depends <- function(depend_alias,build=F) {
 170     con <- db_start()
 171     results <- dbGetQuery(con,paste(
 172                     'SELECT DISTINCT debian_pkg FROM debian_dependency WHERE'
 173                     ,db_quote(tolower(depend_alias)),'= alias'
 174                     ,'AND',as.integer(build),'= build',
 175                     ,'AND',db_quote(which_system),'= system'))
 176     db_stop(con)
 177     return(results$debian_pkg)
 178 }
 179
 180 db_add_depends <- function(depend_alias,debian_pkg,build=F) {
 181     con <- db_start()
 182     results <- dbGetQuery(con,paste(
 183                      'INSERT OR REPLACE INTO debian_dependency'
 184                     ,'(system, alias, build, debian_pkg) VALUES ('
 185                     ,' ',db_quote(which_system)
 186                     ,' ',db_quote(tolower(depend_alias))
 187                     ,',',as.integer(build)
 188                     ,',',db_quote(tolower(debian_pkg))
 189                     ,')'))
 190     db_stop(con)
 191 }
 192
 193 db_depends <- function() {
 194     con <- db_start()
 195     depends <- dbGetQuery(con,paste('SELECT * FROM debian_dependency WHERE system = ',db_quote(which_system)))
 196     db_stop(con)
 197     return(depends)
 198 }
 199
 200 db_get_forced_depends <- function(r_name) {
 201     con <- db_start()
 202     forced_depends <- dbGetQuery(con,
 203                 paste('SELECT depend_alias FROM forced_depends WHERE'
 204                      ,db_quote(r_name),'= r_name'))
 205     db_stop(con)
 206     return(forced_depends$depend_alias)
 207 }
 208
 209 db_add_forced_depends <- function(r_name, depend_alias) {
 210     if (!length(db_get_depends(depend_alias,build=F)) &&
 211         !length(db_get_depends(depend_alias,build=T))) {
 212         fail('Debian dependency alias',depend_alias,'is not know,'
 213                   ,'yet trying to force a dependency on it?')
 214     }
 215     con <- db_start()
 216     dbGetQuery(con,
 217             paste('INSERT OR REPLACE INTO forced_depends (r_name, depend_alias)'
 218                  ,'VALUES (',db_quote(r_name),',',db_quote(depend_alias),')'))
 219     db_stop(con)
 220 }
 221
 222 db_forced_depends <- function() {
 223     con <- db_start()
 224     depends <- dbGetQuery(con,paste('SELECT * FROM forced_depends'))
 225     db_stop(con)
 226     return(depends)
 227 }
 228
 229 db_license_override_name <- function(name) {
 230     con <- db_start()
 231     results <- dbGetQuery(con,paste(
 232                     'SELECT DISTINCT accept FROM license_override WHERE'
 233                             ,db_quote(tolower(name)),'= name'))
 234     db_stop(con)
 235     if (length(results) == 0) {
 236         return(NULL)
 237     }
 238     return(as.logical(results$accept))
 239 }
 240
 241 db_add_license_override <- function(name,accept) {
 242     notice('adding',name,'accept?',accept)
 243     if (accept != TRUE && accept != FALSE) {
 244         fail('accept must be TRUE or FALSE')
 245     }
 246     con <- db_start()
 247     results <- dbGetQuery(con,paste(
 248                      'INSERT OR REPLACE INTO license_override'
 249                     ,'(name, accept) VALUES ('
 250                     ,' ',db_quote(tolower(name))
 251                     ,',',as.integer(accept)
 252                     ,')'))
 253     db_stop(con)
 254 }
 255
 256 db_license_override_hash <- function(license_sha1) {
 257     con <- db_start()
 258     results <- dbGetQuery(con,paste(
 259                      'SELECT DISTINCT accept FROM license_override'
 260                     ,'INNER JOIN license_hashes'
 261                     ,'ON license_hashes.name = license_override.name WHERE'
 262                     ,db_quote(tolower(license_sha1)),'= license_hashes.sha1'))
 263     db_stop(con)
 264     if (length(results) == 0) {
 265         return(NULL)
 266     }
 267     return(as.logical(results$accept))
 268 }
 269
 270 db_license_overrides <- function() {
 271     con <- db_start()
 272     overrides <- dbGetQuery(con,paste('SELECT * FROM license_override'))
 273     hashes    <- dbGetQuery(con,paste('SELECT * FROM license_hashes'))
 274     db_stop(con)
 275     return(list(overrides=overrides,hashes=hashes))
 276 }
 277
 278 db_add_license_hash <- function(name,license_sha1) {
 279     if (is.null(db_license_override_name(name))) {
 280         fail('license',name,'is not know, yet trying to add a hash for it?')
 281     }
 282     notice('adding hash',license_sha1,'for',name)
 283     con <- db_start()
 284     dbGetQuery(con,paste(
 285          'INSERT OR REPLACE INTO license_hashes'
 286         ,'(name, sha1) VALUES ('
 287         ,' ',db_quote(tolower(name))
 288         ,',',db_quote(tolower(license_sha1))
 289         ,')'))
 290     db_stop(con)
 291 }
 292
 293
 294 db_update_package_versions <- function() {
 295     # seems like the quickest way of doing this:
 296     con <- db_start()
 297     dbGetQuery(con, 'DROP TABLE packages')
 298     db_stop(con)
 299     # db_start re-makes all tables
 300     con <- db_start()
 301     for (package in available[,'Package']) {
 302         dbGetQuery(con, paste('INSERT OR REPLACE INTO packages (package,latest_r_version)'
 303                              ,'VALUES (',db_quote(package)
 304                              ,',',db_quote(available[package,'Version']),')'))
 305     }
 306     dbGetQuery(con,'DELETE FROM builds WHERE builds.package NOT IN (SELECT package FROM packages)')
 307     db_stop(con)
 308 }
 309
 310 db_date_format <- '%Y-%m-%d'
 311 db_time_format <- '%H:%M:%OS'
 312
 313 db_record_build <- function(package, deb_version, log, success=F) {
 314     # if the log is more than 1kB, only keep the last 1kB.
 315     # this is to work around a problem that seems to have appeared in R 2.10 causing calloc errors.
 316     # if the log is not pruned then we get the following error:
 317     #
 318     # Error in gsub("(['\"])", "\\1\\1", text) :
 319     #   Calloc could not allocate (-197080581 of 1) memory
 320     # Error in dbGetQuery(con, paste("INSERT OR REPLACE INTO builds", "(package,system,r_version,deb_epoch,deb_revision,db_version,success,date_stamp,time_stamp,scm_revision,log)",  :
 321     #   error in evaluating the argument 'statement' in selecting a method for function 'dbGetQuery'
 322
 323     log <- paste(log,collapse='\n')
 324     end <- nchar(log)
 325     max_log_len <- 10240
 326     if (end > max_log_len) {
 327         log <- db_quote(substr(log,end-max_log_len,end))
 328     } else {
 329         log <- db_quote(log)
 330     }
 331     con <- db_start()
 332     o <- options(digits.secs = 6)
 333     sqlcmd <- paste('INSERT OR REPLACE INTO builds'
 334                     ,'(package,system,r_version,deb_epoch,deb_revision,db_version,success,date_stamp,time_stamp,scm_revision,log)'
 335                     ,'VALUES'
 336                     ,'(',db_quote(package)
 337                     ,',',db_quote(which_system)
 338                     ,',',db_quote(version_upstream(deb_version))
 339                     ,',',db_quote(version_epoch(deb_version))
 340                     ,',',db_quote(version_revision(deb_version))
 341                     ,',',db_cur_version(con)
 342                     ,',',as.integer(success)
 343                     ,',',db_quote(format(Sys.time(), db_date_format))
 344                     ,',',db_quote(format(Sys.time(), db_time_format))
 345                     ,',',db_quote(scm_revision)
 346                     ,',',log
 347                     ,')')
 348     ##print(sqlcmd)
 349     try(dbGetQuery(con,sqlcmd))
 350     options(o)
 351     db_stop(con)
 352 }
 353
 354 db_builds <- function(pkgname) {
 355     # returns all successful builds
 356     con <- db_start()
 357     build <- dbGetQuery(con, paste('SELECT * FROM builds'
 358                        ,'WHERE success = 1'
 359                        ,'AND system =',db_quote(which_system)
 360                        ,'AND package =',db_quote(pkgname)))
 361     db_stop(con)
 362     if (length(build) == 0) {
 363         return(NULL)
 364     }
 365     return(db_cleanup_builds(build))
 366 }
 367
 368 db_cleanup_builds <- function(build) {
 369     build$success <- as.logical(build$success)
 370     #o <-options(digits.secs = 6)
 371     dt <- as.POSIXct(strptime(paste(as.character(build[,"date_stamp"]), as.character(build[,"time_stamp"])),
 372                               paste(db_date_format, db_time_format)))
 373     build$time_stamp <- NULL
 374     build$date_stamp <- NULL
 375     newdf <- data.frame(build, date_stamp=dt)
 376     #print(newdf[, -grep("log", colnames(newdf))])
 377     #options(o)
 378     #print(newdf[, -grep("log", colnames(newdf))])
 379     return(newdf)
 380 }
 381
 382 db_latest_build <- function(pkgname) {
 383     con <- db_start()
 384     build <- dbGetQuery(con, paste('SELECT * FROM builds'
 385                        ,'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds'
 386                        ,              'WHERE system =',db_quote(which_system)
 387                        ,              'GROUP BY package) AS last'
 388                        ,'WHERE id = max_id'
 389                        ,'AND builds.package =',db_quote(pkgname)))
 390     db_stop(con)
 391     if (length(build) == 0) {
 392         return(NULL)
 393     }
 394     return(db_cleanup_builds(build))
 395 }
 396
 397 db_latest_build_version <- function(pkgname) {
 398     build <- db_latest_build(pkgname)
 399     if (is.null(build)) {
 400         return(NULL)
 401     }
 402     return(version_new(build$r_version, build$deb_revision, build$deb_epoch))
 403 }
 404
 405 db_latest_build_status <- function(pkgname) {
 406     build <- db_latest_build(pkgname)
 407     if (is.null(build)) {
 408         return(NULL)
 409     }
 410     return(list(build$success,build$log))
 411 }
 412
 413 db_outdated_packages <- function() {
 414     con <- db_start()
 415     packages <- dbGetQuery(con,paste('SELECT packages.package FROM packages'
 416                ,'LEFT OUTER JOIN ('
 417                # extract the latest attempt at building each package
 418                ,      'SELECT * FROM builds'
 419                ,      'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds'
 420                ,                    'WHERE system =',db_quote(which_system)
 421                ,                    'GROUP BY package) AS last'
 422                ,      'WHERE id = max_id) AS build'
 423                ,'ON build.package = packages.package'
 424                # outdated iff:
 425                # - there is no latest build
 426                ,'WHERE build.package IS NULL'
 427                # - the database has changed since last build
 428                ,'OR build.db_version < (SELECT max(version) FROM database_versions)'
 429                # - the debian epoch has been bumped up
 430                ,'OR build.deb_epoch < (SELECT max(base_epoch) FROM database_versions'
 431                ,                        'WHERE version IN ('
 432                ,                            'SELECT max(version) FROM database_versions))'
 433                # - the latest build is not of the latest R version
 434                ,'OR build.r_version != packages.latest_r_version'
 435                ))$package
 436     db_stop(con)
 437     return(packages)
 438 }
 439
 440 db_blacklist_packages <- function() {
 441     con <- db_start()
 442     packages <- dbGetQuery(con,paste('SELECT package from blacklist_packages'
 443                                     ,' where system=',db_quote(which_system)))$package
 444     db_stop(con)
 445     return(packages)
 446 }
 447
 448 db_blacklist_reasons <- function () {
 449     con <- db_start()
 450     packages <- dbGetQuery(con,paste('SELECT package,explanation from blacklist_packages'
 451                                     ,'where system=',db_quote(which_system),' group by explanation'))
 452     db_stop(con)
 453     return(packages)
 454 }
 455
 456 db_todays_builds <- function() {
 457     today <- db_quote(format(Sys.time(), db_date_format))
 458     con <- db_start()
 459     builds <- dbGetQuery(con,paste('select id,success,system,package,
 460                                     r_version as version,deb_epoch as epo,
 461                                     deb_revision as rev, scm_revision as svnrev,
 462                                     db_version as db,date_stamp,time_stamp
 463                                     from builds where date_stamp = ',today))
 464     db_stop(con)
 465     return(builds)
 466 }
 467
 468 db_successful_builds <- function() {
 469     con <- db_start()
 470     builds <- dbGetQuery(con,'select system,package,r_version,date_stamp,time_stamp
 471                               from builds natural join (select system,package,max(id) as id
 472                                                         from builds
 473                                                         where package not in
 474                                                                 (select package from blacklist_packages
 475                                                                  where blacklist_packages.system == builds.system)
 476                                                         group by package,system)
 477                               where success = 1')
 478     db_stop(con)
 479     return(builds)
 480 }
 481
 482 db_failed_builds <- function() {
 483     con <- db_start()
 484     builds <- dbGetQuery(con,'select system,package,r_version,date_stamp,time_stamp
 485                               from builds natural join (select system,package,max(id) as id
 486                                                         from builds
 487                                                         where package not in
 488                                                                 (select package from blacklist_packages)
 489                                                         group by package,system)
 490                               where success = 0')
 491     db_stop(con)
 492     return(builds)
 493 }