build: log system output, build if last build failed. don't build if last build succe...

in particular, it checks that the upstream version, the debian epoch,
and the database version have not changed.

git-svn-id: svn://svn.r-forge.r-project.org/svnroot/cran2deb@101 edb9625f-4e0d-4859-8d74-9fd3b1da38cb

diff --git a/pkg/trunk/R/build.R b/pkg/trunk/R/build.R
index 778410b9fb1d757913fbcb73facc0cbc2f6590f6..5201ea7b72cc898f17994c4e7f7734667b4574c4 100644 (file)
--- a/pkg/trunk/R/build.R
+++ b/pkg/trunk/R/build.R
@@ -1,25 +1,18 @@
 
-build <- function(name,extra_deps) {
+build <- function(name,extra_deps,force=F) {
     log_clear()
     dir <- setup()
     version <- new_build_version(name)
     result <- try((function() {
-        # see if it has already been built
-        srcname <- pkgname_as_debian(name,binary=F)
-        debname <- pkgname_as_debian(name,binary=T)
-        if (file.exists(changesfile(srcname, version))) {
-            notice('already built',srcname,'version',version)
+        if (!force && !needs_build(name,version)) {
+            notice('skipping build of',name)
             return(NA)
         }
-        # XXX: what about building newer versions?
-        if (debname %in% debian_pkgs) {
-            notice(srcname,' exists in Debian (perhaps a different version)')
-            return(NA)
-        }
-
-        rm(debname,srcname)
 
         pkg <- prepare_new_debian(prepare_pkg(dir,name),extra_deps)
+        if (pkg$debversion != version) {
+            fail('expected Debian version',version,'not equal to actual version',pkg$debversion)
+        }
         # delete the current archive (XXX: assumes mini-dinstall)
         for (subdir in c('mini-dinstall','unstable')) {
             path = file.path(dinstall_archive,subdir)
@@ -32,7 +25,7 @@ build <- function(name,extra_deps) {
         file.remove(Sys.glob(file.path(pbuilder_results,'*.upload')))
 
         # make mini-dinstall generate the skeleton of the archive
-        ret = system(paste('umask 022;mini-dinstall --batch -c',dinstall_config))
+        ret = log_system('umask 022;mini-dinstall --batch -c',dinstall_config)
         if (ret != 0) {
             fail('failed to create archive')
         }
@@ -48,8 +41,8 @@ build <- function(name,extra_deps) {
             srcdep = pkgname_as_debian(dep,binary=F)
 
             notice('uploading',srcdep)
-            ret = system(paste('umask 022;dput','-c',shQuote(dput_config),'local'
-                        ,changesfile(srcdep)))
+            ret = log_system('umask 022;dput','-c',shQuote(dput_config),'local'
+                        ,changesfile(srcdep))
             if (ret != 0) {
                 fail('upload of dependency failed! maybe you did not build it first?')
             }
@@ -57,8 +50,8 @@ build <- function(name,extra_deps) {
         build_debian(pkg)
 
         # upload the package
-        ret = system(paste('umask 022;dput','-c',shQuote(dput_config),'local'
-                    ,changesfile(pkg$srcname,pkg$debversion)))
+        ret = log_system('umask 022;dput','-c',shQuote(dput_config),'local'
+                    ,changesfile(pkg$srcname,pkg$debversion))
         if (ret != 0) {
             fail('upload failed!')
         }
@@ -80,6 +73,37 @@ build <- function(name,extra_deps) {
     return(!failed)
 }
 
+needs_build <- function(name,version) {
+    # see if the last build was successful
+    build <- db_latest_build(name)
+    if (!is.null(build) && build$success) {
+        # then something must have changed for us to attempt this
+        # build
+        if (db_latest_build_version(name) == version &&
+            build$db_version == db_get_version()) {
+            return(F)
+        }
+    } else {
+        # always rebuild on failure or no record
+        return(T)
+    }
+    # see if it has already been built
+    srcname <- pkgname_as_debian(name,binary=F)
+    debname <- pkgname_as_debian(name,binary=T)
+    if (file.exists(changesfile(srcname, version))) {
+        notice('already built',srcname,'version',version)
+        return(F)
+    }
+    # XXX: what about building newer versions of Debian packages?
+    if (debname %in% debian_pkgs) {
+        notice(srcname,' exists in Debian (perhaps a different version)')
+        return(F)
+    }
+
+    rm(debname,srcname)
+    return(T)
+}
+
 build_debian <- function(pkg) {
     wd <- getwd()
     setwd(pkg$path)
@@ -92,7 +116,7 @@ build_debian <- function(pkg) {
     if (version_revision(pkg$debversion) > 2) {
         cmd = paste(cmd,'--debbuildopts','-sd')
     }
-    ret = system(cmd)
+    ret = log_system(cmd)
     setwd(wd)
     if (ret != 0) {
         fail('Failed to build package.')

diff --git a/pkg/trunk/R/debianpkg.R b/pkg/trunk/R/debianpkg.R
index 956e187e663703169fca3377c184e326eaaaa137..4f4830c379c07cc3491ad22cf1467113a4ebc447 100644 (file)
--- a/pkg/trunk/R/debianpkg.R
+++ b/pkg/trunk/R/debianpkg.R
@@ -86,10 +86,10 @@ prepare_new_debian <- function(pkg,extra_deps) {
     wd <- getwd()
     setwd(dirname(pkg$path))
     # remove them pesky +x files
-    system(paste('find',shQuote(basename(pkg$path))
-                ,'-type f -exec chmod -x {} \\;'))
+    log_system('find',shQuote(basename(pkg$path))
+                ,'-type f -exec chmod -x {} \\;')
     # tar it all back up
-    system(paste('tar -czf',shQuote(debarchive),shQuote(basename(pkg$path))))
+    log_system('tar -czf',shQuote(debarchive),shQuote(basename(pkg$path)))
     setwd(wd)
     file.remove(pkg$archive)
     pkg$archive = debarchive
@@ -136,9 +136,9 @@ prepare_new_debian <- function(pkg,extra_deps) {
     # convert text to utf8 (who knows what the original character set is --
     # let's hope iconv DTRT).
     for (file in c('control','changelog','copyright')) {
-        system(paste('iconv -o ',shQuote(pkg$debfile(file))
+        log_system('iconv -o ',shQuote(pkg$debfile(file))
                     ,' -t utf8 '
-                    ,shQuote(pkg$debfile(paste(file,'in',sep='.')))))
+                    ,shQuote(pkg$debfile(paste(file,'in',sep='.'))))
         file.remove(pkg$debfile(paste(file,'in',sep='.')))
     }
     return(pkg)

diff --git a/pkg/trunk/R/getrpkg.R b/pkg/trunk/R/getrpkg.R
index d19187e1d9ee4bb85355bb4249a46bb2cb43fbcc..6fb60bd71575ce19c1c34610ea59ba9df72d6cef 100644 (file)
--- a/pkg/trunk/R/getrpkg.R
+++ b/pkg/trunk/R/getrpkg.R
@@ -40,7 +40,7 @@ prepare_pkg <- function(dir, pkgname) {
     } else {
         fail('Type of archive',archive,'is unknown.')
     }
-    ret = system(cmd)
+    ret = log_system(cmd)
     setwd(wd)
     if (ret != 0) {
         fail('Extraction of archive',archive,'failed.')

diff --git a/pkg/trunk/R/log.R b/pkg/trunk/R/log.R
index 09549fc65358992c035f4866dd07d96036688e9d..f8762edc291b22e48ba6059ae13a82283343d790 100644 (file)
--- a/pkg/trunk/R/log.R
+++ b/pkg/trunk/R/log.R
@@ -4,8 +4,10 @@ log_clear <- function() {
     assign('log_messages',list(),envir=.GlobalEnv)
 }
 
-log_add <- function(text) {
-    message(text)
+log_add <- function(text,print=T) {
+    if (print) {
+        message(text)
+    }
     assign('log_messages',c(log_messages, text),envir=.GlobalEnv)
 }
 
@@ -30,3 +32,32 @@ fail <- function(...) {
     log_add(txt)
     stop(txt)
 }
+
+log_system <- function(...) {
+    r <- try((function() {
+        # pipe() does not appear useful here, since
+        # we want the return value!
+        # XXX: doesn't work with ; or | !
+        tmp <- tempfile('log_system')
+        on.exit(unlink(tmp))
+        cmd <- paste(...)
+        cmd <- paste(cmd,'2>&1','| tee',tmp)
+        ret <- system(cmd)
+        f <- file(tmp)
+        output <- readLines(f)
+        close(f)
+        unlink(tmp)
+        return(list(ret,output))
+    })())
+    if (inherits(r,'try-error')) {
+        fail('system failed on:',paste(...))
+    }
+    for (line in r[[2]]) {
+        if (!length(grep('^[WENI]:',line))) {
+            line = paste('I:',line)
+        }
+        log_add(line,print=F)
+    }
+    return(r[[1]])
+}
+