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)
# 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)
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.')
}
}
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,
}
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(
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'
,',',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'
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))
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) {
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
}
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.
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)
} 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
,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']
# 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)
}
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)
}
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)
}
}
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)
}
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'])
}
}
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''
--- /dev/null
+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)
+}
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)
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
}
# 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)
system('dpkg-architecture -qDEB_HOST_ARCH',intern=T)
}
-err <- function(text) {
- message(paste('E:',text))
+err <- function(...) {
+ error(...)
exit()
}
# ``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
,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))
+}
+
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)
}
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)
}
,' quit'
,sep='\n'))
- message(paste('N: command',paste(argv,collapse=' ')))
if (argc < 1) {
return()
}
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)) {
} 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)
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'])
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'])
projects / cran2deb.git / commitdiff