]> git.donarmstrong.com Git - cran2deb.git/blobdiff - trunk/R/db.R
add a missing quote() around sql statement part
[cran2deb.git] / trunk / R / db.R
index f6a4c073a85151d7a3df3e16d900fa712de0693f..285b2ce02c09910dc17e44cfb234461680038064 100644 (file)
@@ -53,16 +53,30 @@ db_start <- function() {
     if (!dbExistsTable(con,'builds')) {
         dbGetQuery(con,paste('CREATE TABLE builds ('
                   ,' id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL'
+                  ,',system TEXT NOT NULL'
                   ,',package TEXT NOT NULL'
                   ,',r_version TEXT NOT NULL'
                   ,',deb_epoch INTEGER NOT NULL'
                   ,',deb_revision INTEGER NOT NULL'
                   ,',db_version INTEGER NOT NULL'
                   ,',date_stamp TEXT NOT NULL'
-                  ,',git_revision TEXT NOT NULL'
+                  ,',time_stamp TEXT NOT NULL'
+                  ,',scm_revision TEXT NOT NULL'
                   ,',success INTEGER NOT NULL'
                   ,',log TEXT'
-                  ,',UNIQUE(package,r_version,deb_epoch,deb_revision,db_version)'
+                  ,',UNIQUE(package,system,r_version,deb_epoch,deb_revision,db_version)'
+                  ,')'))
+    }
+    if (!dbExistsTable(con,'blacklist_packages')) {
+        dbGetQuery(con,paste('CREATE TABLE blacklist_packages ('
+                  ,' package TEXT PRIMARY KEY NOT NULL '
+                  ,',nonfree INTEGER NOT NULL DEFAULT 0'
+                  ,',obsolete INTEGER NOT NULL DEFAULT 0'
+                  ,',broken_dependency INTEGER NOT NULL DEFAULT 0'
+                  ,',unsatisfied_dependency INTEGER NOT NULL DEFAULT 0'
+                  ,',breaks_cran2deb INTEGER NOT NULL DEFAULT 0'
+                  ,',other INTEGER NOT NULL DEFAULT 0'
+                  ,',explanation TEXT NOT NULL '
                   ,')'))
     }
     return(con)
@@ -140,7 +154,7 @@ db_add_sysreq_override <- function(pattern,depend_alias) {
                     ,' ',db_quote(tolower(depend_alias))
                     ,',',db_quote(tolower(pattern))
                     ,')'))
-    db_stop(con,TRUE)
+    db_stop(con)
 }
 
 db_sysreq_overrides <- function() {
@@ -169,7 +183,7 @@ db_add_depends <- function(depend_alias,debian_pkg,build=F) {
                     ,',',as.integer(build)
                     ,',',db_quote(tolower(debian_pkg))
                     ,')'))
-    db_stop(con,TRUE)
+    db_stop(con)
 }
 
 db_depends <- function() {
@@ -198,7 +212,7 @@ db_add_forced_depends <- function(r_name, depend_alias) {
     dbGetQuery(con,
             paste('INSERT OR REPLACE INTO forced_depends (r_name, depend_alias)'
                  ,'VALUES (',db_quote(r_name),',',db_quote(depend_alias),')'))
-    db_stop(con,TRUE)
+    db_stop(con)
 }
 
 db_forced_depends <- function() {
@@ -232,7 +246,7 @@ db_add_license_override <- function(name,accept) {
                     ,' ',db_quote(tolower(name))
                     ,',',as.integer(accept)
                     ,')'))
-    db_stop(con,TRUE)
+    db_stop(con)
 }
 
 db_license_override_hash <- function(license_sha1) {
@@ -269,35 +283,67 @@ db_add_license_hash <- function(name,license_sha1) {
         ,' ',db_quote(tolower(name))
         ,',',db_quote(tolower(license_sha1))
         ,')'))
-    db_stop(con,TRUE)
+    db_stop(con)
 }
 
 
 db_update_package_versions <- function() {
+    # seems like the quickest way of doing this:
+    con <- db_start()
+    dbGetQuery(con, 'DROP TABLE packages')
+    db_stop(con)
+    # db_start re-makes all tables
     con <- db_start()
     for (package in available[,'Package']) {
         dbGetQuery(con, paste('INSERT OR REPLACE INTO packages (package,latest_r_version)'
                              ,'VALUES (',db_quote(package)
                              ,',',db_quote(available[package,'Version']),')'))
     }
+    dbGetQuery(con,'DELETE FROM builds WHERE builds.package NOT IN (SELECT package FROM packages)')
     db_stop(con)
 }
 
+db_date_format <- '%Y-%m-%d'
+db_time_format <- '%H:%M:%OS %Z'
+
 db_record_build <- function(package, deb_version, log, success=F) {
+    # if the log is more than 1kB, only keep the last 1kB.
+    # this is to work around a problem that seems to have appeared in R 2.10 causing calloc errors.
+    # if the log is not pruned then we get the following error:
+    #
+    # Error in gsub("(['\"])", "\\1\\1", text) :
+    #   Calloc could not allocate (-197080581 of 1) memory
+    # 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)",  :
+    #   error in evaluating the argument 'statement' in selecting a method for function 'dbGetQuery'
+
+    log <- paste(log,collapse='\n')
+    end <- nchar(log)
+    max_log_len <- 1024
+    if (end > max_log_len) {
+        log <- db_quote(substr(log,end-max_log_len,end))
+    } else {
+        log <- db_quote(substr(log))
+    }
     con <- db_start()
-    dbGetQuery(con,paste('INSERT OR REPLACE INTO builds'
-                        ,'(package,r_version,deb_epoch,deb_revision,db_version,success,date_stamp,git_revision,log)'
-                        ,'VALUES'
-                        ,'(',db_quote(package)
-                        ,',',db_quote(version_upstream(deb_version))
-                        ,',',db_quote(version_epoch(deb_version))
-                        ,',',db_quote(version_revision(deb_version))
-                        ,',',db_cur_version(con)
-                        ,',',as.integer(success)
-                        ,',',db_quote(format(Sys.time(),'%a, %d %b %Y %H:%M:%S %z'))
-                        ,',',db_quote(git_revision)
-                        ,',',db_quote(paste(log, collapse='\n'))
-                        ,')'))
+    o <- options(digits.secs = 6)
+    sqlcmd <- paste('INSERT OR REPLACE INTO builds'
+                    ,'(package,system,r_version,deb_epoch,deb_revision,db_version,success,date_stamp,time_stamp,scm_revision,log)'
+                    ,'VALUES'
+                    ,'(',db_quote(package)
+                    ,',',db_quote(which_system)
+                    ,',',db_quote(version_upstream(deb_version))
+                    ,',',db_quote(version_epoch(deb_version))
+                    ,',',db_quote(version_revision(deb_version))
+                    ,',',db_cur_version(con)
+                    ,',',as.integer(success)
+                    ,',',db_quote(format(Sys.time(), db_date_format))
+                    ,',',db_quote(format(Sys.time(), db_time_format))
+                    ,',',db_quote(scm_revision)
+                    ,',',log
+                    ,')')
+    print(sqlcmd)
+    try(dbGetQuery(con,sqlcmd))
+    options(o)
     db_stop(con)
 }
 
@@ -306,19 +352,34 @@ db_builds <- function(pkgname) {
     con <- db_start()
     build <- dbGetQuery(con, paste('SELECT * FROM builds'
                        ,'WHERE success = 1'
+                       ,'AND system =',db_quote(which_system)
                        ,'AND package =',db_quote(pkgname)))
     db_stop(con)
     if (length(build) == 0) {
         return(NULL)
     }
+    return(db_cleanup_builds(build))
+}
+
+db_cleanup_builds <- function(build) {
     build$success <- as.logical(build$success)
-    return(build)
+    #o <-options(digits.secs = 6)
+    dt <- as.POSIXct(strptime(paste(as.character(build[,"date_stamp"]), as.character(build[,"time_stamp"])),
+                              paste(db_date_format, db_time_format)))
+    build$time_stamp <- NULL
+    build$date_stamp <- NULL
+    newdf <- data.frame(build, date_stamp=dt)
+    #print(newdf[, -grep("log", colnames(newdf))])
+    #options(o)
+    #print(newdf[, -grep("log", colnames(newdf))])
+    return(newdf)
 }
 
 db_latest_build <- function(pkgname) {
     con <- db_start()
     build <- dbGetQuery(con, paste('SELECT * FROM builds'
                        ,'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds'
+                       ,              'WHERE system =',db_quote(which_system)
                        ,              'GROUP BY package) AS last'
                        ,'WHERE id = max_id'
                        ,'AND builds.package =',db_quote(pkgname)))
@@ -326,8 +387,7 @@ db_latest_build <- function(pkgname) {
     if (length(build) == 0) {
         return(NULL)
     }
-    build$success <- as.logical(build$success)
-    return(build)
+    return(db_cleanup_builds(build))
 }
 
 db_latest_build_version <- function(pkgname) {
@@ -353,6 +413,7 @@ db_outdated_packages <- function() {
                # extract the latest attempt at building each package
                ,      'SELECT * FROM builds'
                ,      'NATURAL JOIN (SELECT package,max(id) AS max_id FROM builds'
+               ,                    'WHERE system =',db_quote(which_system)
                ,                    'GROUP BY package) AS last'
                ,      'WHERE id = max_id) AS build'
                ,'ON build.package = packages.package'
@@ -372,3 +433,54 @@ db_outdated_packages <- function() {
     return(packages)
 }
 
+db_blacklist_packages <- function() {
+    con <- db_start()
+    packages <- dbGetQuery(con,'SELECT package from blacklist_packages')$package
+    db_stop(con)
+    return(packages)
+}
+
+db_blacklist_reasons <- function () {
+    con <- db_start()
+    packages <- dbGetQuery(con,'SELECT package,explanation from blacklist_packages')
+    db_stop(con)
+    return(packages)
+}
+
+db_todays_builds <- function() {
+    today <- db_quote(format(Sys.time(), db_date_format))
+    con <- db_start()
+    builds <- dbGetQuery(con,paste('select id,success,system,package,
+                                    r_version as version,deb_epoch as epo,
+                                    deb_revision as rev, scm_revision as svnrev,
+                                    db_version as db,date_stamp,time_stamp
+                                    from builds where date_stamp = ',today))
+    db_stop(con)
+    return(builds)
+}
+
+db_successful_builds <- function() {
+    con <- db_start()
+    builds <- dbGetQuery(con,'select system,package,r_version,date_stamp,time_stamp
+                              from builds natural join (select system,package,max(id) as id
+                                                        from builds
+                                                        where package not in
+                                                                (select package from blacklist_packages)
+                                                        group by package,system)
+                              where success = 1')
+    db_stop(con)
+    return(builds)
+}
+
+db_failed_builds <- function() {
+    con <- db_start()
+    builds <- dbGetQuery(con,'select system,package,r_version,date_stamp,time_stamp
+                              from builds natural join (select system,package,max(id) as id
+                                                        from builds
+                                                        where package not in
+                                                                (select package from blacklist_packages)
+                                                        group by package,system)
+                              where success = 0')
+    db_stop(con)
+    return(builds)
+}