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     tables <- dbListTables(con)
   6     if (!dbExistsTable(con,'sysreq_override')) {
   7         dbGetQuery(con,paste('CREATE TABLE sysreq_override ('
   8                   ,' depend_alias TEXT NOT NULL'
   9                   ,',r_pattern TEXT PRIMARY KEY NOT NULL'
  10                   ,')'))
  11     }
  12     if (!dbExistsTable(con,'debian_dependency')) {
  13         dbGetQuery(con,paste('CREATE TABLE debian_dependency ('
  14                   ,' id INTEGER PRIMARY KEY AUTOINCREMENT 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                   ,')'))
  45         db_add_version(con,1)
  46     }
  47     return(con)
  48 }
  49
  50 db_stop <- function(con,bump=F) {
  51     if (bump) {
  52         db_bump()
  53     }
  54     dbDisconnect(con)
  55 }
  56
  57 db_quote <- function(text) {
  58     return(paste('"',gsub('([^][[:alnum:]*?. ()<>:/=+%-])','\\\\\\1',text),'"',sep=''))
  59 }
  60
  61 db_now <- function() {
  62     return(as.integer(gsub('-','',Sys.Date())))
  63 }
  64
  65 db_cur_version <- function(con) {
  66     return(as.integer(dbGetQuery(con, 'SELECT max(version) FROM database_versions')[[1]]))
  67 }
  68
  69 db_add_version <- function(con, version) {
  70     dbGetQuery(con,paste('INSERT INTO database_versions (version,version_date)'
  71               ,'VALUES (',as.integer(version),',',db_now(),')'))
  72 }
  73
  74 db_bump <- function(con) {
  75     db_add_version(con,db_cur_version(con)+1)
  76 }
  77
  78 db_sysreq_override <- function(sysreq_text) {
  79     con <- db_start()
  80     results <- dbGetQuery(con,paste(
  81                     'SELECT DISTINCT depend_alias FROM sysreq_override WHERE'
  82                             ,db_quote(tolower(sysreq_text)),'LIKE r_pattern'))
  83     db_stop(con)
  84     if (length(results) == 0) {
  85         return(NA)
  86     }
  87     return(results$depend_alias)
  88 }
  89
  90 db_add_sysreq_override <- function(pattern,depend_alias) {
  91     con <- db_start()
  92     results <- dbGetQuery(con,paste(
  93                      'INSERT OR REPLACE INTO sysreq_override'
  94                     ,'(depend_alias, r_pattern) VALUES ('
  95                     ,' ',db_quote(tolower(depend_alias))
  96                     ,',',db_quote(tolower(pattern))
  97                     ,')'))
  98     db_stop(con,TRUE)
  99 }
 100
 101 db_sysreq_overrides <- function() {
 102     con <- db_start()
 103     overrides <- dbGetQuery(con,paste('SELECT * FROM sysreq_override'))
 104     db_stop(con)
 105     return(overrides)
 106 }
 107
 108 db_get_depends <- function(depend_alias,build=F) {
 109     con <- db_start()
 110     results <- dbGetQuery(con,paste(
 111                     'SELECT DISTINCT debian_pkg FROM debian_dependency WHERE'
 112                     ,db_quote(tolower(depend_alias)),'= alias'
 113                     ,'AND',as.integer(build),'= build'))
 114     db_stop(con)
 115     return(results$debian_pkg)
 116 }
 117
 118 db_add_depends <- function(depend_alias,debian_pkg,build=F) {
 119     con <- db_start()
 120     results <- dbGetQuery(con,paste(
 121                      'INSERT OR REPLACE INTO debian_dependency'
 122                     ,'(alias, build, debian_pkg) VALUES ('
 123                     ,' ',db_quote(tolower(depend_alias))
 124                     ,',',as.integer(build)
 125                     ,',',db_quote(tolower(debian_pkg))
 126                     ,')'))
 127     db_stop(con,TRUE)
 128 }
 129
 130 db_depends <- function() {
 131     con <- db_start()
 132     depends <- dbGetQuery(con,paste('SELECT * FROM debian_dependency'))
 133     db_stop(con)
 134     return(depends)
 135 }
 136
 137 db_get_forced_depends <- function(r_name) {
 138     con <- db_start()
 139     forced_depends <- dbGetQuery(con,
 140                 paste('SELECT depend_alias FROM forced_depends WHERE'
 141                      ,db_quote(r_name),'= r_name'))
 142     db_stop(con)
 143     return(forced_depends$depend_alias)
 144 }
 145
 146 db_add_forced_depends <- function(r_name, depend_alias) {
 147     if (!length(db_get_depends(depend_alias,build=F)) &&
 148         !length(db_get_depends(depend_alias,build=T))) {
 149         stop(paste('Debian dependency alias',depend_alias,'is not know,'
 150                   ,'yet trying to force a dependency on it?'))
 151     }
 152     con <- db_start()
 153     dbGetQuery(con,
 154             paste('INSERT OR REPLACE INTO forced_depends (r_name, depend_alias)'
 155                  ,'VALUES (',db_quote(r_name),',',db_quote(depend_alias),')'))
 156     db_stop(con,TRUE)
 157 }
 158
 159 db_forced_depends <- function() {
 160     con <- db_start()
 161     depends <- dbGetQuery(con,paste('SELECT * FROM forced_depends'))
 162     db_stop(con)
 163     return(depends)
 164 }
 165
 166 db_license_override_name <- function(name) {
 167     con <- db_start()
 168     results <- dbGetQuery(con,paste(
 169                     'SELECT DISTINCT accept FROM license_override WHERE'
 170                             ,db_quote(tolower(name)),'= name'))
 171     db_stop(con)
 172     if (length(results) == 0) {
 173         return(NA)
 174     }
 175     return(as.logical(results$accept))
 176 }
 177
 178 db_add_license_override <- function(name,accept) {
 179     message(paste('adding',name,'accept?',accept))
 180     if (accept != TRUE && accept != FALSE) {
 181         stop('accept must be TRUE or FALSE')
 182     }
 183     con <- db_start()
 184     results <- dbGetQuery(con,paste(
 185                      'INSERT OR REPLACE INTO license_override'
 186                     ,'(name, accept) VALUES ('
 187                     ,' ',db_quote(tolower(name))
 188                     ,',',as.integer(accept)
 189                     ,')'))
 190     db_stop(con,TRUE)
 191 }
 192
 193 db_license_override_hash <- function(license_sha1) {
 194     con <- db_start()
 195     results <- dbGetQuery(con,paste(
 196                      'SELECT DISTINCT accept FROM license_override'
 197                     ,'INNER JOIN license_hashes'
 198                     ,'ON license_hashes.name = license_override.name WHERE'
 199                     ,db_quote(tolower(license_sha1)),'= license_hashes.sha1'))
 200     db_stop(con)
 201     if (length(results) == 0) {
 202         return(NA)
 203     }
 204     return(as.logical(results$accept))
 205 }
 206
 207 db_license_overrides <- function() {
 208     con <- db_start()
 209     overrides <- dbGetQuery(con,paste('SELECT * FROM license_override'))
 210     hashes    <- dbGetQuery(con,paste('SELECT * FROM license_hashes'))
 211     db_stop(con)
 212     return(list(overrides=overrides,hashes=hashes))
 213 }
 214
 215 db_add_license_hash <- function(name,license_sha1) {
 216     if (is.na(db_license_override_name(name))) {
 217         stop(paste('license',name,'is not know, yet trying to add a hash for it?'))
 218     }
 219     message(paste('adding hash',license_sha1,'for',name))
 220     con <- db_start()
 221     dbGetQuery(con,paste(
 222          'INSERT OR REPLACE INTO license_hashes'
 223         ,'(name, sha1) VALUES ('
 224         ,' ',db_quote(tolower(name))
 225         ,',',db_quote(tolower(license_sha1))
 226         ,')'))
 227     db_stop(con,TRUE)
 228 }
 229