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