pkg/trunk/R/db.R

   1
   2 db_start <- function() {
   3     drv <- dbDriver('SQLite')
   4     con <- dbConnect(drv, dbname=file.path(root,'data/cran2deb.db'))
   5     tables <- dbListTables(con)
   6     if (!dbExistsTable(con,'sysreq_override')) {
   7         dbGetQuery(con,paste('CREATE TABLE sysreq_override ('
   8                   ,' debian_name TEXT NOT NULL'
   9                   ,',r_pattern TEXT PRIMARY KEY NOT NULL'
  10                   ,')'))
  11     }
  12     if (!dbExistsTable(con,'license_override')) {
  13         dbGetQuery(con,paste('CREATE TABLE license_override ('
  14                   ,' name TEXT PRIMARY KEY NOT NULL'
  15                   ,',accept INT NOT NULL'
  16                   ,')'))
  17     }
  18     if (!dbExistsTable(con,'license_hashes')) {
  19         dbGetQuery(con,paste('CREATE TABLE license_hashes ('
  20                   ,' name TEXT NOT NULL'
  21                   ,',sha1 TEXT PRIMARY KEY NOT NULL'
  22                   ,')'))
  23     }
  24     return(con)
  25 }
  26
  27 db_stop <- function(con) {
  28     dbDisconnect(con)
  29 }
  30
  31 db_quote <- function(text) {
  32     return(paste('"',gsub('([^][[:alnum:]*?. ()<>:/=+-])','\\\\\\1',text),'"',sep=''))
  33 }
  34
  35 db_sysreq_override <- function(sysreq_text) {
  36     sysreq_text <- tolower(sysreq_text)
  37     con <- db_start()
  38     results <- dbGetQuery(con,paste(
  39                     'SELECT DISTINCT debian_name FROM sysreq_override WHERE'
  40                             ,db_quote(sysreq_text),'GLOB r_pattern'))
  41     db_stop(con)
  42     if (length(results) == 0) {
  43         return(NA)
  44     }
  45     return(results$debian_name)
  46 }
  47
  48 db_add_sysreq_override <- function(pattern,debian_name) {
  49     pattern <- tolower(pattern)
  50     debian_name <- tolower(debian_name)
  51     con <- db_start()
  52     results <- dbGetQuery(con,paste(
  53                      'INSERT OR REPLACE INTO sysreq_override'
  54                     ,'(debian_name, r_pattern) VALUES ('
  55                     ,' ',db_quote(debian_name)
  56                     ,',',db_quote(pattern)
  57                     ,')'))
  58     db_stop(con)
  59 }
  60
  61 db_sysreq_overrides <- function() {
  62     con <- db_start()
  63     overrides <- dbGetQuery(con,paste('SELECT * FROM sysreq_override'))
  64     db_stop(con)
  65     return(overrides)
  66 }
  67
  68
  69 db_license_override_name <- function(name) {
  70     name <- tolower(name)
  71     con <- db_start()
  72     results <- dbGetQuery(con,paste(
  73                     'SELECT DISTINCT accept FROM license_override WHERE'
  74                             ,db_quote(name),'= name'))
  75     db_stop(con)
  76     if (length(results) == 0) {
  77         return(NA)
  78     }
  79     return(as.logical(results$accept))
  80 }
  81
  82 db_add_license_override <- function(name,accept) {
  83     name <- tolower(name)
  84     message(paste('adding',name,'accept?',accept))
  85     if (accept != TRUE && accept != FALSE) {
  86         stop('accept must be TRUE or FALSE')
  87     }
  88     con <- db_start()
  89     results <- dbGetQuery(con,paste(
  90                      'INSERT OR REPLACE INTO license_override'
  91                     ,'(name, accept) VALUES ('
  92                     ,' ',db_quote(name)
  93                     ,',',as.integer(accept)
  94                     ,')'))
  95     db_stop(con)
  96 }
  97
  98 db_license_override_hash <- function(license_sha1) {
  99     license_sha1 <- tolower(license_sha1)
 100     con <- db_start()
 101     results <- dbGetQuery(con,paste(
 102                      'SELECT DISTINCT accept FROM license_override'
 103                     ,'INNER JOIN license_hashes'
 104                     ,'ON license_hashes.name = license_override.name WHERE'
 105                     ,db_quote(license_sha1),'= license_hashes.sha1'))
 106     db_stop(con)
 107     if (length(results) == 0) {
 108         return(NA)
 109     }
 110     return(as.logical(results$accept))
 111 }
 112
 113 db_license_overrides <- function() {
 114     con <- db_start()
 115     overrides <- dbGetQuery(con,paste('SELECT * FROM license_override'))
 116     hashes    <- dbGetQuery(con,paste('SELECT * FROM license_hashes'))
 117     db_stop(con)
 118     # TODO: change accept from 0,1 into FALSE,TRUE
 119     return(list(overrides=overrides,hashes=hashes))
 120 }
 121
 122 db_add_license_hash <- function(name,license_sha1) {
 123     name <- tolower(name)
 124     license_sha1 <- tolower(license_sha1)
 125     message(paste('adding hash',license_sha1,'for',name))
 126     con <- db_start()
 127     dbGetQuery(con,paste(
 128          'INSERT OR REPLACE INTO license_hashes'
 129         ,'(name, sha1) VALUES ('
 130         ,' ',db_quote(name)
 131         ,',',db_quote(license_sha1)
 132         ,')'))
 133     db_stop(con)
 134 }
 135