From 03fe6d6f2c195e583af0a73748dfad11fe5600ab Mon Sep 17 00:00:00 2001 From: blundellc Date: Sat, 13 Sep 2008 13:24:56 +0000 Subject: [PATCH] use NULL instead of NA. include git revision and date stamp in build log. generate changelog. NA has length 1 and conveys perhaps-ok information. NULL was often more appropriate. a configure script edits R/zzz.R to add a new global 'git_revision' prior to R building the package. This assumes that the current working directory is in a git repository and will fail if it is not. changelog generated according to Debian guidelines---latest builds to the top. Included: the git revision of cran2deb, the time/date, and the database version. git-svn-id: svn://svn.r-forge.r-project.org/svnroot/cran2deb@111 edb9625f-4e0d-4859-8d74-9fd3b1da38cb --- pkg/trunk/R/build.R | 7 ++++--- pkg/trunk/R/db.R | 26 ++++++++++++++++++++++---- pkg/trunk/R/debcontrol.R | 2 +- pkg/trunk/R/debiannaming.R | 2 +- pkg/trunk/R/debianpkg.R | 37 ++++++++++++++++++++++++++++++------- pkg/trunk/R/getrpkg.R | 2 +- pkg/trunk/R/license.R | 10 +++++----- pkg/trunk/R/log.R | 2 +- pkg/trunk/R/rdep.R | 8 ++++---- pkg/trunk/R/version.R | 2 +- pkg/trunk/R/zzz.R | 3 +++ pkg/trunk/configure | 12 ++++++++++++ pkg/trunk/exec/license | 4 ++-- 13 files changed, 87 insertions(+), 30 deletions(-) create mode 100755 pkg/trunk/configure diff --git a/pkg/trunk/R/build.R b/pkg/trunk/R/build.R index d5b0437..6f206a2 100644 --- a/pkg/trunk/R/build.R +++ b/pkg/trunk/R/build.R @@ -9,12 +9,12 @@ build <- function(name,extra_deps,force=F) { version <- try(new_build_version(name)) if (inherits(version,'try-error')) { error('failed to build',name) - return(NA) + return(NULL) } result <- try((function() { if (!force && !needs_build(name,version)) { notice('skipping build of',name) - return(NA) + return(NULL) } pkg <- prepare_new_debian(prepare_pkg(dir,name),extra_deps) @@ -67,7 +67,7 @@ build <- function(name,extra_deps,force=F) { return(pkg$debversion) })()) cleanup(dir) - if (is.na(result)) { + if (is.null(result)) { # nothing was done so escape asap. return(result) } @@ -124,6 +124,7 @@ build_debian <- function(pkg) { cmd = paste('pdebuild --configfile',shQuote(pbuilder_config)) if (version_revision(pkg$debversion) > 2) { cmd = paste(cmd,'--debbuildopts','-sd') + notice('build should exclude original source') } ret = log_system(cmd) setwd(wd) diff --git a/pkg/trunk/R/db.R b/pkg/trunk/R/db.R index 1ddcf8a..f6a4c07 100644 --- a/pkg/trunk/R/db.R +++ b/pkg/trunk/R/db.R @@ -58,6 +58,8 @@ db_start <- function() { ,',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' ,',success INTEGER NOT NULL' ,',log TEXT' ,',UNIQUE(package,r_version,deb_epoch,deb_revision,db_version)' @@ -213,7 +215,7 @@ db_license_override_name <- function(name) { ,db_quote(tolower(name)),'= name')) db_stop(con) if (length(results) == 0) { - return(NA) + return(NULL) } return(as.logical(results$accept)) } @@ -242,7 +244,7 @@ db_license_override_hash <- function(license_sha1) { ,db_quote(tolower(license_sha1)),'= license_hashes.sha1')) db_stop(con) if (length(results) == 0) { - return(NA) + return(NULL) } return(as.logical(results$accept)) } @@ -256,7 +258,7 @@ db_license_overrides <- function() { } db_add_license_hash <- function(name,license_sha1) { - if (is.na(db_license_override_name(name))) { + if (is.null(db_license_override_name(name))) { fail('license',name,'is not know, yet trying to add a hash for it?') } notice('adding hash',license_sha1,'for',name) @@ -284,7 +286,7 @@ db_update_package_versions <- function() { db_record_build <- function(package, deb_version, log, success=F) { con <- db_start() dbGetQuery(con,paste('INSERT OR REPLACE INTO builds' - ,'(package,r_version,deb_epoch,deb_revision,db_version,success,log)' + ,'(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)) @@ -292,11 +294,27 @@ db_record_build <- function(package, deb_version, log, success=F) { ,',',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')) ,')')) db_stop(con) } +db_builds <- function(pkgname) { + # returns all successful builds + con <- db_start() + build <- dbGetQuery(con, paste('SELECT * FROM builds' + ,'WHERE success = 1' + ,'AND package =',db_quote(pkgname))) + db_stop(con) + if (length(build) == 0) { + return(NULL) + } + build$success <- as.logical(build$success) + return(build) +} + db_latest_build <- function(pkgname) { con <- db_start() build <- dbGetQuery(con, paste('SELECT * FROM builds' diff --git a/pkg/trunk/R/debcontrol.R b/pkg/trunk/R/debcontrol.R index 1e748e6..6ae2ed2 100644 --- a/pkg/trunk/R/debcontrol.R +++ b/pkg/trunk/R/debcontrol.R @@ -73,7 +73,7 @@ sysreqs_as_debian <- function(sysreq_text) { # squish out space sysreq = chomp(gsub('[[:space:]]+',' ',sysreq)) alias <- db_sysreq_override(sysreq) - if (is.na(alias)) { + if (is.null(alias)) { error('do not know what to do with SystemRequirement:',sysreq) error('original SystemRequirement:',startreq) fail('unmet system requirement') diff --git a/pkg/trunk/R/debiannaming.R b/pkg/trunk/R/debiannaming.R index 2af857b..83c0ab5 100644 --- a/pkg/trunk/R/debiannaming.R +++ b/pkg/trunk/R/debiannaming.R @@ -30,7 +30,7 @@ pkgname_as_debian <- function(name,repopref=NULL,version=NULL,binary=T,build=F) # now. if (!(name %in% rownames(available))) { bundle <- r_bundle_of(name) - if (!is.na(bundle)) { + if (!is.null(bundle)) { name <- bundle } } diff --git a/pkg/trunk/R/debianpkg.R b/pkg/trunk/R/debianpkg.R index 4f4830c..a4f8d04 100644 --- a/pkg/trunk/R/debianpkg.R +++ b/pkg/trunk/R/debianpkg.R @@ -1,11 +1,33 @@ +append_build_from_pkg <- function(pkg, builds) { + pkg_build <- data.frame(id = -1 # never used + ,package = pkg$name + ,r_version = version_upstream(pkg$debversion) + ,deb_epoch = version_epoch(pkg$debversion) + ,deb_revision = version_revision(pkg$debversion) + ,db_version = db_get_version() + ,date_stamp = pkg$date_stamp + ,git_revision = git_revision + ,success = 1 # never used + ,log = '' # never used + ) + return(cbind(data.frame(srcname=pkg$srcname), rbind(builds, pkg_build))) +} + generate_changelog <- function(pkg) { - # construct a dummy changelog # TODO: ``Writing R extensions'' mentions that a package may also have # {NEWS,ChangeLog} files. - cat(paste(paste(pkg$srcname,' (',pkg$debversion,') unstable; urgency=low',sep='') - ,'' ,' * Initial release.','' - ,paste(' --',maintainer,'',format(Sys.time(),'%a, %d %b %Y %H:%M:%S %z')) - ,'',sep='\n'),file=pkg$debfile('changelog.in')) + builds <- append_build_from_pkg(pkg, db_builds(pkg$name)) + sapply(rev(rownames(builds)), function(b, changelog) generate_changelog_entry(builds[b,], changelog), pkg$debfile('changelog.in')) +} + +generate_changelog_entry <- function(build, changelog) { + # TODO: should say 'New upstream release' when necessary + debversion <- version_new(build$r_version, build$deb_revision, build$deb_epoch) + cat(paste(paste(build$srcname,' (',debversion,') unstable; urgency=low',sep='') + ,'' ,paste(' * cran2deb ',build$git_revision + ,' with DB version ',as.integer(build$db_version),'.',sep='') + ,'',paste(' --',maintainer,'',build$date_stamp) + ,'','','',sep='\n'),file=changelog, append=TRUE) } generate_rules <- function(pkg) { @@ -37,8 +59,8 @@ generate_copyright <- function(pkg) { ,'' ,'' ,'The GNU R package DESCRIPTION offers a' - ,'Copyright licenses under the terms of the',pkg$license - ,'license. On a Debian GNU/Linux system, common' + ,'Copyright licenses under the terms of the license:' + ,pkg$license,'. On a Debian GNU/Linux system, common' ,'licenses are included in the directory' ,'/usr/share/common-licenses/.' ,'' @@ -53,6 +75,7 @@ generate_copyright <- function(pkg) { prepare_new_debian <- function(pkg,extra_deps) { # generate Debian version and name + pkg$date_stamp = format(Sys.time(),'%a, %d %b %Y %H:%M:%S %z') pkg$repo = repourl_as_debian(pkg$repoURL) if (pkg$version != available[pkg$name,'Version']) { # should never happen since available is the basis upon which the diff --git a/pkg/trunk/R/getrpkg.R b/pkg/trunk/R/getrpkg.R index a0d6bc9..90e266d 100644 --- a/pkg/trunk/R/getrpkg.R +++ b/pkg/trunk/R/getrpkg.R @@ -22,7 +22,7 @@ prepare_pkg <- function(dir, pkgname) { # first a little trick; change pkgname if pkgname is contained in a bundle if (!(pkgname %in% rownames(available))) { bundle <- r_bundle_of(pkgname) - if (is.na(bundle)) { + if (is.null(bundle)) { fail('package',pkgname,'is unavailable') } pkgname <- bundle diff --git a/pkg/trunk/R/license.R b/pkg/trunk/R/license.R index 42222bf..c392e11 100644 --- a/pkg/trunk/R/license.R +++ b/pkg/trunk/R/license.R @@ -7,18 +7,18 @@ is_acceptable_license <- function(license) { } license <- license_text_reduce(license) action = db_license_override_name(license) - if (!is.na(action)) { + if (!is.null(action)) { return(action) } license <- license_text_further_reduce(license) action = db_license_override_name(license) - if (!is.na(action)) { + if (!is.null(action)) { 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)) { + if (!is.null(action)) { warn('Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!') return(action) } @@ -102,11 +102,11 @@ get_license_hash <- function(pkg,license) { is_acceptable_hash_license <- function(pkg,license) { license_sha1 <- get_license_hash(pkg,license) - if (is.na(license_sha1)) { + if (is.null(license_sha1)) { return(FALSE) } action = db_license_override_hash(license_sha1) - if (is.na(action)) { + if (is.null(action)) { action = FALSE } if (action) { diff --git a/pkg/trunk/R/log.R b/pkg/trunk/R/log.R index d9dce0a..2a9be4e 100644 --- a/pkg/trunk/R/log.R +++ b/pkg/trunk/R/log.R @@ -58,7 +58,7 @@ log_system <- function(...) { if (!length(grep('^[WENI]:',line))) { line = paste('I:',line) } - log_add(line,print=F) + log_add(line) #,print=F) } return(r[[1]]) } diff --git a/pkg/trunk/R/rdep.R b/pkg/trunk/R/rdep.R index 87ef168..141453b 100644 --- a/pkg/trunk/R/rdep.R +++ b/pkg/trunk/R/rdep.R @@ -8,7 +8,7 @@ r_bundle_of <- function(pkgname) { return(bundle) } } - return(NA) + return(NULL) } r_bundle_contains <- function(bundlename) { @@ -19,7 +19,7 @@ r_requiring <- function(names) { for (name in names) { if (!(name %in% base_pkgs) && !(name %in% rownames(available))) { bundle <- r_bundle_of(name) - if (!is.na(bundle)) { + if (!is.null(bundle)) { name = bundle names <- c(names,bundle) } @@ -68,7 +68,7 @@ r_dependencies_of <- function(name=NULL,description=NULL) { if (is.null(description)) { if (!(name %in% rownames(available))) { bundle <- r_bundle_of(name) - if (!is.na(bundle)) { + if (!is.null(bundle)) { name <- bundle } else { # unavailable packages don't depend upon anything @@ -115,7 +115,7 @@ r_parse_dep_field <- function(dep) { dep = sub(pat,'\\1',dep) if (!(dep %in% rownames(available))) { depb <- r_bundle_of(dep) - if (!is.na(depb)) { + if (!is.null(depb)) { dep <- depb } } diff --git a/pkg/trunk/R/version.R b/pkg/trunk/R/version.R index 5be77a3..184ec23 100644 --- a/pkg/trunk/R/version.R +++ b/pkg/trunk/R/version.R @@ -76,7 +76,7 @@ version_update <- function(rver, prev_pkgver, prev_success) { new_build_version <- function(pkgname) { if (!(pkgname %in% rownames(available))) { bundle <- r_bundle_of(pkgname) - if (is.na(bundle)) { + if (is.null(bundle)) { fail('tried to discover new version of',pkgname,'but it does not appear to be available') } name <- bundle diff --git a/pkg/trunk/R/zzz.R b/pkg/trunk/R/zzz.R index 1889155..de8aeae 100644 --- a/pkg/trunk/R/zzz.R +++ b/pkg/trunk/R/zzz.R @@ -9,6 +9,9 @@ global("dinstall_config", file.path(root,'etc/mini-dinstall.conf')) global("dinstall_archive", file.path(root,'var/archive')) global("r_depend_fields", c('Depends','Imports')) # Suggests, Enhances + # git_revision { + global("git_revision","bc0b57d181288d67ce7829455c9e11fcfc9faa1a") + # git_revision } global("changesfile", function(srcname,version='*') { return(file.path(pbuilder_results ,paste(srcname,'_',version,'_' diff --git a/pkg/trunk/configure b/pkg/trunk/configure new file mode 100755 index 0000000..03aa5d9 --- /dev/null +++ b/pkg/trunk/configure @@ -0,0 +1,12 @@ +#!/bin/sh +# stamp the source with the originating git revision. +git_rev=$(git show --pretty'=oneline' 'HEAD' | head -n1 | cut -f1 -d' ') +#git_r='assign("git_revision","'$git_rev'",envir=.GlobalEnv)' +git_r=' global("git_revision","'$git_rev'")' + +awk -v "git_r=$git_r" ' +/# git_revision }/ {suppress=0} +suppress == 0 {print} +/# git_revision {/ {print git_r; suppress=1} +' R/zzz.R.new && \ +mv R/zzz.R.new R/zzz.R diff --git a/pkg/trunk/exec/license b/pkg/trunk/exec/license index 984ffa0..343bc18 100755 --- a/pkg/trunk/exec/license +++ b/pkg/trunk/exec/license @@ -33,7 +33,7 @@ exec_cmd <- function(argc, argv) { } license = argv[2] path = argv[3] - if (is.na(db_license_override_name(license))) { + if (is.null(db_license_override_name(license))) { error('license',license,'is not known; add it first') return() } @@ -55,7 +55,7 @@ exec_cmd <- function(argc, argv) { license <- argv[2] pkg_name <- argv[3] current_action <- db_license_override_name(license) - if (is.na(current_action)) { + if (is.null(current_action)) { notice('license',license,'is not known; add it') return() } -- 2.39.5