From f4ed1d083e094aac3220fc95f75d2c983d884c61 Mon Sep 17 00:00:00 2001 From: blundellc Date: Sat, 13 Sep 2008 13:22:28 +0000 Subject: [PATCH] build: automatically version package builds, record results in build log, record all cran2deb generated messages in log. automatic version works as follows: - if there is no previous build in the database, use R version with epoch=0 (will probably change to base_epoch in the DB), revision=1. - if there is a previous build, and the R version of that build is the same as the R version of the to-be-built, then increment the revision by one. - otherwise use the previous epoch and revision=1 with the new R version. TODO: grab the output from system()s into the log too. TODO: whilst version changes make sense, the Debian revision number probably creeps up a little bit too quickly. No point in versioning failed builds or repeat builds where nothing changed. git-svn-id: svn://svn.r-forge.r-project.org/svnroot/cran2deb@91 edb9625f-4e0d-4859-8d74-9fd3b1da38cb --- pkg/trunk/R/build.R | 47 ++++++++++++++++++++++---------------- pkg/trunk/R/db.R | 41 +++++++++++++++++++++++++++------ pkg/trunk/R/debcontrol.R | 8 +++---- pkg/trunk/R/debiannaming.R | 4 ++-- pkg/trunk/R/debianpkg.R | 11 ++++++--- pkg/trunk/R/getrpkg.R | 12 +++++----- pkg/trunk/R/license.R | 16 ++++++------- pkg/trunk/R/log.R | 32 ++++++++++++++++++++++++++ pkg/trunk/R/rdep.R | 8 +++---- pkg/trunk/R/util.R | 4 ++-- pkg/trunk/R/version.R | 16 ++++++++++--- pkg/trunk/exec/autobuild | 2 +- pkg/trunk/exec/build | 2 +- pkg/trunk/exec/depend | 1 - pkg/trunk/exec/license | 12 +++++----- 15 files changed, 148 insertions(+), 68 deletions(-) create mode 100644 pkg/trunk/R/log.R diff --git a/pkg/trunk/R/build.R b/pkg/trunk/R/build.R index bf3049a..151d47a 100644 --- a/pkg/trunk/R/build.R +++ b/pkg/trunk/R/build.R @@ -1,22 +1,23 @@ build <- function(name,extra_deps) { + log_clear() dir <- setup() - pkg <- try((function() { + 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) - version <- version_new(available[name,'Version']) if (file.exists(changesfile(srcname, version))) { - message(paste('N: already built',srcname,'version',version)) + notice('already built',srcname,'version',version) return(NA) } # XXX: what about building newer versions? if (debname %in% debian_pkgs) { - message(paste('N:',srcname,' exists in Debian (perhaps a different version)')) + notice(srcname,' exists in Debian (perhaps a different version)') return(NA) } - rm(debname,srcname,version) + rm(debname,srcname) pkg <- prepare_new_debian(prepare_pkg(dir,name),extra_deps) # delete the current archive (XXX: assumes mini-dinstall) @@ -33,24 +34,24 @@ build <- function(name,extra_deps) { # make mini-dinstall generate the skeleton of the archive ret = system(paste('umask 022;mini-dinstall --batch -c',dinstall_config)) if (ret != 0) { - stop('failed to create archive') + fail('failed to create archive') } # pull in all the R dependencies - message(paste('N: dependencies:',paste(pkg$depends$r,collapse=', '))) + notice('dependencies:',paste(pkg$depends$r,collapse=', ')) for (dep in pkg$depends$r) { if (pkgname_as_debian(dep) %in% debian_pkgs) { - message(paste('N: using Debian package of',dep)) + notice('using Debian package of',dep) next } # otherwise, convert to source package name srcdep = pkgname_as_debian(dep,binary=F) - message(paste('N: uploading',srcdep)) + notice('uploading',srcdep) ret = system(paste('umask 022;dput','-c',shQuote(dput_config),'local' ,changesfile(srcdep))) if (ret != 0) { - stop('upload of dependency failed! maybe you did not build it first?') + fail('upload of dependency failed! maybe you did not build it first?') } } build_debian(pkg) @@ -59,31 +60,37 @@ build <- function(name,extra_deps) { ret = system(paste('umask 022;dput','-c',shQuote(dput_config),'local' ,changesfile(pkg$srcname,pkg$debversion))) if (ret != 0) { - stop('upload failed!') + fail('upload failed!') } - return(pkg) + return(pkg$debversion) })()) cleanup(dir) - if (inherits(pkg,'try-error')) { - message(paste('E: failure of',name,'means these packages will fail:' - ,paste(r_dependency_closure(name,forward_arcs=F),collapse=', '))) - stop(call.=F) + if (is.na(result)) { + # nothing was done so escape asap. + return(result) } - return(pkg) + # otherwise record progress + failed = inherits(result,'try-error') + if (failed) { + error('failure of',name,'means these packages will fail:' + ,paste(r_dependency_closure(name,forward_arcs=F),collapse=', ')) + } + db_record_build(name, version, log_retrieve(), !failed) + return(!failed) } build_debian <- function(pkg) { wd <- getwd() setwd(pkg$path) - message(paste('N: building Debian package' + notice('building Debian package' ,pkg$debname ,paste('(',pkg$debversion,')',sep='') - ,'...')) + ,'...') ret = system(paste('pdebuild --configfile',shQuote(pbuilder_config))) setwd(wd) if (ret != 0) { - stop('Failed to build package.') + fail('Failed to build package.') } } diff --git a/pkg/trunk/R/db.R b/pkg/trunk/R/db.R index e0971ab..baad105 100644 --- a/pkg/trunk/R/db.R +++ b/pkg/trunk/R/db.R @@ -175,8 +175,8 @@ db_get_forced_depends <- function(r_name) { db_add_forced_depends <- function(r_name, depend_alias) { if (!length(db_get_depends(depend_alias,build=F)) && !length(db_get_depends(depend_alias,build=T))) { - stop(paste('Debian dependency alias',depend_alias,'is not know,' - ,'yet trying to force a dependency on it?')) + fail('Debian dependency alias',depend_alias,'is not know,' + ,'yet trying to force a dependency on it?') } con <- db_start() dbGetQuery(con, @@ -205,9 +205,9 @@ db_license_override_name <- function(name) { } db_add_license_override <- function(name,accept) { - message(paste('adding',name,'accept?',accept)) + notice('adding',name,'accept?',accept) if (accept != TRUE && accept != FALSE) { - stop('accept must be TRUE or FALSE') + fail('accept must be TRUE or FALSE') } con <- db_start() results <- dbGetQuery(con,paste( @@ -243,9 +243,9 @@ db_license_overrides <- function() { db_add_license_hash <- function(name,license_sha1) { if (is.na(db_license_override_name(name))) { - stop(paste('license',name,'is not know, yet trying to add a hash for it?')) + fail('license',name,'is not know, yet trying to add a hash for it?') } - message(paste('adding hash',license_sha1,'for',name)) + notice('adding hash',license_sha1,'for',name) con <- db_start() dbGetQuery(con,paste( 'INSERT OR REPLACE INTO license_hashes' @@ -278,11 +278,38 @@ db_record_build <- function(package, deb_version, log, success=F) { ,',',db_quote(version_revision(deb_version)) ,',',db_cur_version(con) ,',',as.integer(success) - ,',',log + ,',',db_quote(paste(log, collapse='\n')) ,')')) db_stop(con) } +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' + , 'GROUP BY package) AS last' + ,'WHERE id = max_id' + ,'AND builds.package =',db_quote(pkgname))) + db_stop(con) + return(build) +} + +db_latest_build_version <- function(pkgname) { + build <- db_latest_build(pkgname) + if (length(build) == 0) { + return(NA) + } + return(version_new(build$r_version, build$deb_revision, build$deb_epoch)) +} + +db_latest_build_status <- function(pkgname) { + build <- db_latest_build(pkgname) + if (length(build) == 0) { + return(NA) + } + return(c(build$success,build$log)) +} + db_outdated_packages <- function() { con <- db_start() packages <- dbGetQuery(con,paste('SELECT packages.package FROM packages' diff --git a/pkg/trunk/R/debcontrol.R b/pkg/trunk/R/debcontrol.R index 6030783..ac163de 100644 --- a/pkg/trunk/R/debcontrol.R +++ b/pkg/trunk/R/debcontrol.R @@ -74,11 +74,11 @@ sysreqs_as_debian <- function(sysreq_text) { sysreq = chomp(gsub('[[:space:]]+',' ',sysreq)) alias <- db_sysreq_override(sysreq) if (is.na(alias)) { - message(paste('E: do not know what to do with SystemRequirement:',sysreq)) - message(paste('E: original SystemRequirement:',startreq)) - stop('unmet system requirement') + error('do not know what to do with SystemRequirement:',sysreq) + error('original SystemRequirement:',startreq) + fail('unmet system requirement') } - message(paste('N: mapped SystemRequirement',startreq,'onto',alias,'via',sysreq)) + notice('mapped SystemRequirement',startreq,'onto',alias,'via',sysreq) aliases = c(aliases,alias) } return(map_aliases_to_debian(aliases)) diff --git a/pkg/trunk/R/debiannaming.R b/pkg/trunk/R/debiannaming.R index ceb217c..ab5741b 100644 --- a/pkg/trunk/R/debiannaming.R +++ b/pkg/trunk/R/debiannaming.R @@ -6,7 +6,7 @@ repourl_as_debian <- function(url) { if (length(grep('bioc',url))) { return('bioc') } - stop(paste('unknown repository',url)) + fail('unknown repository',url) } pkgname_as_debian <- function(name,repopref=NULL,version=NULL,binary=T,build=F) { @@ -31,7 +31,7 @@ pkgname_as_debian <- function(name,repopref=NULL,version=NULL,binary=T,build=F) if (!(name %in% rownames(available))) { bundle <- r_bundle_of(name) if (is.na(bundle)) { - stop(paste('package',name,'is not available')) + fail('package',name,'is not available') } name <- bundle } diff --git a/pkg/trunk/R/debianpkg.R b/pkg/trunk/R/debianpkg.R index 81670e4..171aa4d 100644 --- a/pkg/trunk/R/debianpkg.R +++ b/pkg/trunk/R/debianpkg.R @@ -54,15 +54,20 @@ generate_copyright <- function(pkg) { prepare_new_debian <- function(pkg,extra_deps) { # generate Debian version and name pkg$repo = repourl_as_debian(pkg$repoURL) - pkg$debversion = version_new(pkg$version) + if (pkg$version != available[pkg$name,'Version']) { + # should never happen since available is the basis upon which the + # package is retrieved. + fail('inconsistency between R package version and cached R version') + } + pkg$debversion = new_build_version(pkg$name) if (!length(grep('^[A-Za-z0-9][A-Za-z0-9+.-]+$',pkg$name))) { - stop(paste('Cannot convert package name into a Debian name',pkg$name)) + fail('Cannot convert package name into a Debian name',pkg$name) } pkg$srcname = tolower(pkg$name) pkg$debname = pkgname_as_debian(pkg$name,repo=pkg$repo) if (!length(grep('\\.tar\\.gz',pkg$archive))) { - stop('archive is not tarball') + fail('archive is not tarball') } # re-pack into a Debian-named archive with a Debian-named directory. diff --git a/pkg/trunk/R/getrpkg.R b/pkg/trunk/R/getrpkg.R index dc3aa38..d19187e 100644 --- a/pkg/trunk/R/getrpkg.R +++ b/pkg/trunk/R/getrpkg.R @@ -23,13 +23,13 @@ prepare_pkg <- function(dir, pkgname) { if (!(pkgname %in% rownames(available))) { bundle <- r_bundle_of(pkgname) if (is.na(bundle)) { - stop(paste('package',pkgname,'is unavailable')) + fail('package',pkgname,'is unavailable') } pkgname <- bundle } archive <- download.packages(pkgname, dir, available=available, repos='', type="source")[1,2] if (length(grep('\\.\\.',archive)) || normalizePath(archive) != archive) { - stop(paste('funny looking path',archive)) + fail('funny looking path',archive) } wd <- getwd() setwd(dir) @@ -38,12 +38,12 @@ prepare_pkg <- function(dir, pkgname) { } else if (length(grep('\\.tar\\.gz$',archive))) { cmd = paste('tar','xzf',shQuote(archive)) } else { - stop(paste('Type of archive',archive,'is unknown.')) + fail('Type of archive',archive,'is unknown.') } ret = system(cmd) setwd(wd) if (ret != 0) { - stop(paste('Extraction of archive',archive,'failed.')) + fail('Extraction of archive',archive,'failed.') } pkg <- pairlist() pkg$name = pkgname @@ -52,7 +52,7 @@ prepare_pkg <- function(dir, pkgname) { ,gsub(.standard_regexps()$valid_package_version, "" ,archive)) if (!file.info(pkg$path)[,'isdir']) { - stop(paste(pkg$path,'is not a directory and should be.')) + fail(pkg$path,'is not a directory and should be.') } pkg$description = read.dcf(file.path(pkg$path,'DESCRIPTION')) pkg$repoURL = available[pkgname,'Repository'] @@ -61,7 +61,7 @@ prepare_pkg <- function(dir, pkgname) { # note subtly of short circuit operators (no absorption) if ((!pkg$is_bundle && pkg$description[1,'Package'] != pkg$name) || ( pkg$is_bundle && pkg$description[1,'Bundle'] != pkg$name)) { - stop(paste('package name mismatch')) + fail('package name mismatch') } return(pkg) } diff --git a/pkg/trunk/R/license.R b/pkg/trunk/R/license.R index 6453524..42222bf 100644 --- a/pkg/trunk/R/license.R +++ b/pkg/trunk/R/license.R @@ -13,17 +13,17 @@ is_acceptable_license <- function(license) { license <- license_text_further_reduce(license) action = db_license_override_name(license) if (!is.na(action)) { - message(paste('W: Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!')) + warn('Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!') return(action) } license <- license_text_extreme_reduce(license) action = db_license_override_name(license) if (!is.na(action)) { - message(paste('W: Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!')) + warn('Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!') return(action) } # TODO: file {LICENSE,LICENCE} (+ maybe COPYING?) - message(paste('E: Wild license',license,'did not match classic rules; rejecting')) + error('Wild license',license,'did not match classic rules; rejecting') return(F) } @@ -89,7 +89,7 @@ get_license <- function(pkg,license) { path = file.path(pkg$path, path) license <- license_text_reduce(readChar(path,file.info(path)$size)) } else { - message(paste('E: invalid license file specification',license)) + error('invalid license file specification',license) return(NA) } } @@ -110,7 +110,7 @@ is_acceptable_hash_license <- function(pkg,license) { action = FALSE } if (action) { - message(paste('W: Wild license',license,'accepted via hash',license_sha1)) + warn('Wild license',license,'accepted via hash',license_sha1) } return(action) } @@ -119,7 +119,7 @@ is_acceptable_hash_license <- function(pkg,license) { accept_license <- function(pkg) { # check the license if (!('License' %in% names(pkg$description[1,]))) { - stop('package has no License: field in description!') + fail('package has no License: field in description!') } accept=NULL for (license in strsplit(chomp(pkg$description[1,'License']) @@ -134,9 +134,9 @@ accept_license <- function(pkg) { } } if (is.null(accept)) { - stop(paste('No acceptable license:',pkg$description[1,'License'])) + fail('No acceptable license:',pkg$description[1,'License']) } else { - message(paste('N: Auto-accepted license',accept)) + notice('Auto-accepted license',accept) } if (accept == 'Unlimited') { # definition of Unlimited from ``Writing R extensions'' diff --git a/pkg/trunk/R/log.R b/pkg/trunk/R/log.R new file mode 100644 index 0000000..09549fc --- /dev/null +++ b/pkg/trunk/R/log.R @@ -0,0 +1,32 @@ +log_messages <- list() + +log_clear <- function() { + assign('log_messages',list(),envir=.GlobalEnv) +} + +log_add <- function(text) { + message(text) + assign('log_messages',c(log_messages, text),envir=.GlobalEnv) +} + +log_retrieve <- function() { + return(log_messages) +} + +notice <- function(...) { + log_add(paste('N:',...)) +} + +warn <- function(...) { + log_add(paste('W:',...)) +} + +error <- function(...) { + log_add(paste('E:',...)) +} + +fail <- function(...) { + txt <- paste('E:',...) + log_add(txt) + stop(txt) +} diff --git a/pkg/trunk/R/rdep.R b/pkg/trunk/R/rdep.R index 2665c53..c29f62c 100644 --- a/pkg/trunk/R/rdep.R +++ b/pkg/trunk/R/rdep.R @@ -20,7 +20,7 @@ r_requiring <- function(names) { if (!(name %in% base_pkgs) && !(name %in% rownames(available))) { bundle <- r_bundle_of(name) if (is.na(bundle)) { - stop(paste('package',name,'is not available')) + fail('package',name,'is not available') } name = bundle names <- c(names,bundle) @@ -64,13 +64,13 @@ r_dependencies_of <- function(name=NULL,description=NULL) { return(data.frame()) } if (is.null(description) && is.null(name)) { - stop('must specify either a description or a name.') + fail('must specify either a description or a name.') } if (is.null(description)) { if (!(name %in% rownames(available))) { bundle <- r_bundle_of(name) if (is.na(bundle)) { - stop(paste('package',name,'is not available')) + fail('package',name,'is not available') } name <- bundle } @@ -108,7 +108,7 @@ r_parse_dep_field <- function(dep) { # parse version pat = '^([^ ()]+) ?(\\( ?([<=>!]+ ?[0-9.-]+) ?\\))?$' if (!length(grep(pat,dep))) { - stop(paste('R dependency',dep,'does not appear to be well-formed')) + fail('R dependency',dep,'does not appear to be well-formed') } version = sub(pat,'\\3',dep) dep = sub(pat,'\\1',dep) diff --git a/pkg/trunk/R/util.R b/pkg/trunk/R/util.R index 58f83cf..e10951e 100644 --- a/pkg/trunk/R/util.R +++ b/pkg/trunk/R/util.R @@ -15,8 +15,8 @@ host_arch <- function() { system('dpkg-architecture -qDEB_HOST_ARCH',intern=T) } -err <- function(text) { - message(paste('E:',text)) +err <- function(...) { + error(...) exit() } diff --git a/pkg/trunk/R/version.R b/pkg/trunk/R/version.R index 8820182..6ac7601 100644 --- a/pkg/trunk/R/version.R +++ b/pkg/trunk/R/version.R @@ -6,14 +6,14 @@ version_new <- function(rver,debian_revision=1, debian_epoch=0) { # ``Writing R extensions'' says that the version consists of at least two # non-negative integers, separated by . or - if (!length(grep('^([0-9]+[.-])+[0-9]+$',rver))) { - stop(paste('Not a valid R package version',rver)) + fail('Not a valid R package version',rver) } # Debian policy says that an upstream version should start with a digit and # may only contain ASCII alphanumerics and '.+-:~' if (!length(grep('^[0-9][A-Za-z0-9.+:~-]*$',rver))) { - stop(paste('R package version',rver - ,'does not obviously translate into a valid Debian version.')) + fail('R package version',rver + ,'does not obviously translate into a valid Debian version.') } # if rver contains a : then the Debian version must also have a colon @@ -68,3 +68,13 @@ version_update <- function(rver, prev_pkgver) { ,debian_epoch = version_epoch(prev_pkgver) )) } + +new_build_version <- function(pkgname) { + db_ver <- db_latest_build_version(pkgname) + latest_r_ver <- available[pkgname,'Version'] + if (!is.na(db_ver)) { + return(version_update(latest_r_ver, db_ver)) + } + return(version_new(latest_r_ver)) +} + diff --git a/pkg/trunk/exec/autobuild b/pkg/trunk/exec/autobuild index ef113f6..1e1a65d 100755 --- a/pkg/trunk/exec/autobuild +++ b/pkg/trunk/exec/autobuild @@ -5,7 +5,7 @@ if (exists('argv')) { # check for littler db_update_package_versions() outdated <- db_outdated_packages() build_order <- r_dependency_closure(outdated) - message(paste('N: build order',paste(build_order,collapse=', '))) + notice('build order',paste(build_order,collapse=', ')) for (pkg in build_order) { build(pkg,extra_deps) } diff --git a/pkg/trunk/exec/build b/pkg/trunk/exec/build index bdaedac..ebab8da 100755 --- a/pkg/trunk/exec/build +++ b/pkg/trunk/exec/build @@ -33,7 +33,7 @@ if (exists('argv')) { # check for littler err('usage: cran2deb [-D extra_dep1,extra_dep2,...] package package ...') } build_order <- r_dependency_closure(c(extra_deps$r,argv)) - message(paste('N: build order',paste(build_order,collapse=', '))) + notice('build order',paste(build_order,collapse=', ')) for (pkg in build_order) { build(pkg,extra_deps) } diff --git a/pkg/trunk/exec/depend b/pkg/trunk/exec/depend index ee32af3..fc6ada8 100755 --- a/pkg/trunk/exec/depend +++ b/pkg/trunk/exec/depend @@ -14,7 +14,6 @@ exec_cmd <- function(argc, argv) { ,' quit' ,sep='\n')) - message(paste('N: command',paste(argv,collapse=' '))) if (argc < 1) { return() } diff --git a/pkg/trunk/exec/license b/pkg/trunk/exec/license index ece135a..984ffa0 100755 --- a/pkg/trunk/exec/license +++ b/pkg/trunk/exec/license @@ -34,7 +34,7 @@ exec_cmd <- function(argc, argv) { license = argv[2] path = argv[3] if (is.na(db_license_override_name(license))) { - message(paste('E: license',license,'is not known; add it first')) + error('license',license,'is not known; add it first') return() } if (file.exists(path)) { @@ -43,7 +43,7 @@ exec_cmd <- function(argc, argv) { } else if (length(grep('^[0-9a-f]{40}$',path))) { license_sha1 = path } else { - message(paste('E:',path,'does not exist and does not look like an SHA1 hash')) + error(path,'does not exist and does not look like an SHA1 hash') return() } db_add_license_hash(license,license_sha1) @@ -56,19 +56,19 @@ exec_cmd <- function(argc, argv) { pkg_name <- argv[3] current_action <- db_license_override_name(license) if (is.na(current_action)) { - message(paste('N: license',license,'is not known; add it')) + notice('license',license,'is not known; add it') return() } action = 'accept' if (!current_action) { action = 'reject' } - message(paste('in future, will',action,'the package',pkg_name,'under license',license)) + notice('in future, will',action,'the package',pkg_name,'under license',license) tmp <- setup() success <- try((function() { pkg <- prepare_pkg(tmp,pkg_name) if (!('License' %in% names(pkg$description[1,]))) { - message(paste('E: package',pkg$name,'has no License: field in DESCRIPTION')) + error('package',pkg$name,'has no License: field in DESCRIPTION') return() } first_license = (strsplit(chomp(pkg$description[1,'License']) @@ -90,7 +90,7 @@ exec_cmd <- function(argc, argv) { success <- try((function() { pkg <- prepare_pkg(tmp,pkg_name) if (!('License' %in% names(pkg$description[1,]))) { - message(paste('E: package',pkg$name,'has no License: field in DESCRIPTION')) + error('package',pkg$name,'has no License: field in DESCRIPTION') return() } first_license = (strsplit(chomp(pkg$description[1,'License']) -- 2.39.5