-db.start <- function() {
+db_start <- function() {
drv <- dbDriver('SQLite')
con <- dbConnect(drv, dbname=file.path(root,'data/cran2deb.db'))
tables <- dbListTables(con)
return(con)
}
-db.stop <- function(con) {
+db_stop <- function(con) {
dbDisconnect(con)
}
-db.quote <- function(text) {
+db_quote <- function(text) {
return(paste('"',gsub('([^][[:alnum:]*?. ()<>:/=+-])','\\\\\\1',text),'"',sep=''))
}
-db.sysreq.override <- function(sysreq_text) {
+db_sysreq_override <- function(sysreq_text) {
sysreq_text <- tolower(sysreq_text)
- con <- db.start()
+ con <- db_start()
results <- dbGetQuery(con,paste(
'SELECT debian_name FROM sysreq_override WHERE'
- ,db.quote(sysreq_text),'GLOB r_pattern'))
- db.stop(con)
+ ,db_quote(sysreq_text),'GLOB r_pattern'))
+ db_stop(con)
if (length(results) == 0) {
return(NA)
}
return(results$debian_name)
}
-db.add.sysreq.override <- function(pattern,debian_name) {
+db_add_sysreq_override <- function(pattern,debian_name) {
pattern <- tolower(pattern)
debian_name <- tolower(debian_name)
- con <- db.start()
+ con <- db_start()
results <- dbGetQuery(con,paste(
'INSERT OR REPLACE INTO sysreq_override'
,'(debian_name, r_pattern) VALUES ('
- ,' ',db.quote(debian_name)
- ,',',db.quote(pattern)
+ ,' ',db_quote(debian_name)
+ ,',',db_quote(pattern)
,')'))
- db.stop(con)
+ db_stop(con)
}
-db.sysreq.overrides <- function() {
- con <- db.start()
+db_sysreq_overrides <- function() {
+ con <- db_start()
overrides <- dbGetQuery(con,paste('SELECT * FROM sysreq_override'))
- db.stop(con)
+ db_stop(con)
return(overrides)
}
-db.license.override.name <- function(name) {
+db_license_override_name <- function(name) {
name <- tolower(name)
- con <- db.start()
+ con <- db_start()
results <- dbGetQuery(con,paste(
'SELECT accept FROM license_override WHERE'
- ,db.quote(name),'= name'))
- db.stop(con)
+ ,db_quote(name),'= name'))
+ db_stop(con)
if (length(results) == 0) {
return(NA)
}
return(as.logical(results$accept))
}
-db.add.license.override <- function(name,accept) {
+db_add_license_override <- function(name,accept) {
name <- tolower(name)
message(paste('adding',name,'accept?',accept))
if (accept != TRUE && accept != FALSE) {
stop('accept must be TRUE or FALSE')
}
- con <- db.start()
+ con <- db_start()
results <- dbGetQuery(con,paste(
'INSERT OR REPLACE INTO license_override'
,'(name, accept) VALUES ('
- ,' ',db.quote(name)
+ ,' ',db_quote(name)
,',',as.integer(accept)
,')'))
- db.stop(con)
+ db_stop(con)
}
-db.license.override.file <- function(file_sha1) {
+db_license_override_file <- function(file_sha1) {
file_sha1 <- tolower(file_sha1)
- con <- db.start()
+ con <- db_start()
results <- dbGetQuery(con,paste(
'SELECT name,accept FROM license_override'
,'INNER JOIN license_files'
,'ON license_files.name = license_override.name WHERE'
- ,db.quote(file_sha1),'= license_files.file_sha1'))
- db.stop(con)
+ ,db_quote(file_sha1),'= license_files.file_sha1'))
+ db_stop(con)
# TODO: change accept from 0,1 into FALSE,TRUE
# TODO: NULL -> NA
return(results)
}
-db.license.overrides <- function() {
- con <- db.start()
+db_license_overrides <- function() {
+ con <- db_start()
overrides <- dbGetQuery(con,paste('SELECT * FROM license_override'))
files <- dbGetQuery(con,paste('SELECT * FROM license_files'))
- db.stop(con)
+ db_stop(con)
# TODO: change accept from 0,1 into FALSE,TRUE
return(list(overrides=overrides,files=files))
}
-db.add.license.file <- function(name,file_sha1) {
+db_add_license_file <- function(name,file_sha1) {
name <- tolower(name)
file_sha1 <- tolower(file_sha1)
message(paste('adding file',file_sha1,'for',name))
- con <- db.start()
+ con <- db_start()
dbGetQuery(con,paste(
'INSERT OR REPLACE INTO license_files'
,'(name, file_sha1) VALUES ('
- ,' ',db.quote(name)
- ,',',db.quote(file_sha1)
+ ,' ',db_quote(name)
+ ,',',db_quote(file_sha1)
,')'))
- db.stop(con)
+ db_stop(con)
}
-get.dependencies <- function(pkg,extra_deps) {
+get_dependencies <- function(pkg,extra_deps) {
# determine dependencies
- dependencies <- r.dependencies.of(description=pkg$description)
+ dependencies <- r_dependencies_of(description=pkg$description)
depends <- list()
# these are used for generating the Depends fields
- as.deb <- function(r,build) {
- return(pkgname.as.debian(paste(dependencies[r,]$name)
+ as_deb <- function(r,build) {
+ return(pkgname_as_debian(paste(dependencies[r,]$name)
,version=dependencies[r,]$version
,repopref=pkg$repo
,build=build))
}
- depends$bin <- lapply(rownames(dependencies), as.deb, build=F)
- depends$build <- lapply(rownames(dependencies), as.deb, build=T)
+ depends$bin <- lapply(rownames(dependencies), as_deb, build=F)
+ depends$build <- lapply(rownames(dependencies), as_deb, build=T)
# add the command line dependencies
depends$bin = c(extra_deps$deb,depends$bin)
depends$build = c(extra_deps$deb,depends$build)
# add the system requirements
if ('SystemRequirements' %in% colnames(pkg$description)) {
- sysreq <- sysreqs.as.debian(pkg$description[1,'SystemRequirements'])
+ sysreq <- sysreqs_as_debian(pkg$description[1,'SystemRequirements'])
depends$bin = c(sysreq,depends$bin)
depends$build = c(sysreq,depends$build)
}
# make sure we depend upon R in some way...
if (!length(grep('^r-base',depends$build))) {
- depends$build = c(depends$build,pkgname.as.debian('R',version='>= 2.7.0',build=T))
- depends$bin = c(depends$bin, pkgname.as.debian('R',version='>= 2.7.0',build=F))
+ depends$build = c(depends$build,pkgname_as_debian('R',version='>= 2.7.0',build=T))
+ depends$bin = c(depends$bin, pkgname_as_debian('R',version='>= 2.7.0',build=F))
}
# also include stuff to allow tcltk to build (suggested by Dirk)
depends$build = c(depends$build,'xvfb','xauth','xfonts-base')
# the names of dependent source packages (to find the .changes file to
# upload via dput). these can be found recursively.
- depends$r = r.dependency.closure(dependencies)
+ depends$r = r_dependency_closure(dependencies)
# append command line dependencies
depends$r = c(extra_deps$r, depends$r)
return(depends)
}
-sysreqs.as.debian <- function(sysreq_text) {
+sysreqs_as_debian <- function(sysreq_text) {
# form of this field is unspecified (ugh) but most people seem to stick
# with this
debs <- c()
sysreq = gsub('(ht|f)tps?://[[:alnum:]!?*"\'(),%$_@.&+/=-]*','',sysreq)
# squish out space
sysreq = chomp(gsub('[[:space:]]+',' ',sysreq))
- deb <- db.sysreq.override(sysreq)
+ deb <- db_sysreq_override(sysreq)
if (is.na(deb)) {
message(paste('E: do not know what to do with SystemRequirement:',sysreq))
message(paste('E: original SystemRequirement:',startreq))
return(debs)
}
-generate.control <- function(pkg) {
+generate_control <- function(pkg) {
# construct control file
control = data.frame()
control[1,'Source'] = pkg$srcname
# bundles provide virtual packages of their contents
if (pkg$is_bundle) {
control[2,'Provides'] = paste(
- lapply(r.bundle.contains(pkg$name)
- ,function(name) return(pkgname.as.debian(paste(name)
+ lapply(r_bundle_contains(pkg$name)
+ ,function(name) return(pkgname_as_debian(paste(name)
,repopref=pkg$repo)))
,collapse=', ')
}
-repourl.as.debian <- function(url) {
+repourl_as_debian <- function(url) {
# map the url to a repository onto its name in debian package naming
if (length(grep('cran',url))) {
return('cran')
stop(paste('unknown repository',url))
}
-pkgname.as.debian <- function(name,repopref=NULL,version=NULL,binary=T,build=F) {
+pkgname_as_debian <- function(name,repopref=NULL,version=NULL,binary=T,build=F) {
# generate the debian package name corresponding to the R package name
if (name %in% base_pkgs) {
name = 'R'
# XXX: data.frame rownames are unique, so always override repopref for
# now.
if (!(name %in% rownames(available))) {
- bundle <- r.bundle.of(name)
+ bundle <- r_bundle_of(name)
if (is.na(bundle)) {
stop(paste('package',name,'is not available'))
}
}
debname = tolower(name)
if (binary) {
- repopref <- tolower(repourl.as.debian(available[name,'Repository']))
+ repopref <- tolower(repourl_as_debian(available[name,'Repository']))
debname = paste('r',repopref,debname,sep='-')
}
}
-generate.changelog <- function(pkg) {
+generate_changelog <- function(pkg) {
# construct a dummy changelog
# TODO: ``Writing R extensions'' mentions that a package may also have
# {NEWS,ChangeLog} files.
,'',sep='\n'),file=pkg$debfile('changelog.in'))
}
-generate.rules <- function(pkg) {
+generate_rules <- function(pkg) {
cat(paste('#!/usr/bin/make -f'
,paste('debRreposname :=',pkg$repo)
,'include /usr/share/R/debian/r-cran.mk'
Sys.chmod(pkg$debfile('rules'),'0700')
}
-generate.copyright <- function(pkg) {
- # generate copyright file; we trust DESCRIPTION
+generate_copyright <- function(pkg) {
+ # generate_copyright file; we trust DESCRIPTION
writeLines(strwrap(
paste('This Debian package of the GNU R package',pkg$name
,'was generated automatically using cran2deb by'
,sep='\n'), width=72), con=pkg$debfile('copyright.in'))
}
-prepare.new.debian <- function(pkg,extra_deps) {
+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)
+ pkg$repo = repourl_as_debian(pkg$repoURL)
+ pkg$debversion = version_new(pkg$version)
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))
}
pkg$srcname = tolower(pkg$name)
- pkg$debname = pkgname.as.debian(pkg$name,repo=pkg$repo)
+ pkg$debname = pkgname_as_debian(pkg$name,repo=pkg$repo)
if (!length(grep('\\.tar\\.gz',pkg$archive))) {
stop('archive is not tarball')
if (pkg$is_bundle) {
# if it's a bundle, check each of the packages
pkg$archdep = F
- for (pkgname in r.bundle.contains(pkg$name)) {
+ for (pkgname in r_bundle_contains(pkg$name)) {
pkg$archdep = file.exists(file.path(pkg$path,pkgname,'src'))
if (pkg$archdep) {
break
}
pkg$arch <- 'all'
if (pkg$archdep) {
- pkg$arch <- host.arch()
+ pkg$arch <- host_arch()
}
- pkg$license <- accept.license(pkg)
- pkg$depends <- get.dependencies(pkg,extra_deps)
- generate.changelog(pkg)
- generate.rules(pkg)
- generate.copyright(pkg)
- generate.control(pkg)
+ pkg$license <- accept_license(pkg)
+ pkg$depends <- get_dependencies(pkg,extra_deps)
+ generate_changelog(pkg)
+ generate_rules(pkg)
+ generate_copyright(pkg)
+ generate_control(pkg)
# TODO: debian/watch from pkg$repoURL
return(pkg)
}
-build.debian <- function(pkg) {
+build_debian <- function(pkg) {
wd <- getwd()
setwd(pkg$path)
message(paste('N: building Debian package'
invisible()
}
-prepare.pkg <- function(dir, pkgname) {
+prepare_pkg <- function(dir, pkgname) {
# download and extract an R package named pkgname
# OR the bundle containing pkgname
# first a little trick; change pkgname if pkgname is contained in a bundle
if (!(pkgname %in% rownames(available))) {
- bundle <- r.bundle.of(pkgname)
+ bundle <- r_bundle_of(pkgname)
if (is.na(bundle)) {
stop(paste('package',pkgname,'is unavailable'))
}
# don't care about versions of licenses
license = chomp(sub('\\( ?[<=>!]+ ?[0-9.-]+ ?\\)',''
,sub('-[0-9.-]+','',license)))
- action = db.license.override.name(license)
+ action = db_license_override_name(license)
if (!is.na(action)) {
return(action)
}
license = gsub('(mozilla )?(mpl|mozilla public)','mpl',license)
# remove any extra space introduced
license = chomp(gsub('[[:space:]]+',' ',license))
- action = db.license.override.name(license)
+ action = db_license_override_name(license)
if (!is.na(action)) {
message(paste('W: Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!'))
return(action)
,license)
# remove any extra space introduced
license = chomp(gsub('[[:space:]]+',' ',license))
- action = db.license.override.name(license)
+ action = db_license_override_name(license)
if (!is.na(action)) {
message(paste('W: Accepting/rejecting wild license as',license,'. FIX THE PACKAGE!'))
return(action)
return(F)
}
-accept.license <- function(pkg) {
+accept_license <- function(pkg) {
# check the license
if (!('License' %in% names(pkg$description[1,]))) {
stop('package has no License: field in description!')
-r.bundle.of <- function(pkgname) {
+r_bundle_of <- function(pkgname) {
# returns the bundle containing pkgname or NA
bundles <- names(available[!is.na(available[, 'Bundle']), 'Contains'])
# use the first bundle
for (bundle in bundles) {
- if (pkgname %in% r.bundle.contains(bundle)) {
+ if (pkgname %in% r_bundle_contains(bundle)) {
return(bundle)
}
}
return(NA)
}
-r.bundle.contains <- function(bundlename) {
+r_bundle_contains <- function(bundlename) {
return(strsplit(available[bundlename,'Contains'],'[[:space:]]+')[[1]])
}
-r.requiring <- function(names) {
+r_requiring <- function(names) {
for (name in names) {
if (!(name %in% base_pkgs) && !(name %in% rownames(available))) {
- bundle <- r.bundle.of(name)
+ bundle <- r_bundle_of(name)
if (is.na(bundle)) {
stop(paste('package',name,'is not available'))
}
names <- c(names,bundle)
}
if (!is.na(available[name,'Contains'])) {
- names <- c(names,r.bundle.contains(name))
+ names <- c(names,r_bundle_contains(name))
}
}
# approximately prune first into a smaller availability
return(unique(prereq))
}
-r.dependencies.of <- function(name=NULL,description=NULL) {
+r_dependencies_of <- function(name=NULL,description=NULL) {
# find the immediate dependencies (children in the dependency graph) of an
# R package
if (!is.null(name) && (name == 'R' || name %in% base_pkgs)) {
}
if (is.null(description)) {
if (!(name %in% rownames(available))) {
- bundle <- r.bundle.of(name)
+ bundle <- r_bundle_of(name)
if (is.na(bundle)) {
stop(paste('package',name,'is not available'))
}
}
new_deps <- lapply(strsplit(chomp(description[1,field])
,'[[:space:]]*,[[:space:]]*')[[1]]
- ,r.parse.dep.field)
+ ,r_parse_dep_field)
deps <- iterate(lapply(new_deps[!is.na(new_deps)],rbind),deps,rbind)
}
return (deps)
}
-r.parse.dep.field <- function(dep) {
+r_parse_dep_field <- function(dep) {
if (is.na(dep)) {
return(NA)
}
version = sub(pat,'\\3',dep)
dep = sub(pat,'\\1',dep)
if (!(dep %in% rownames(available))) {
- depb <- r.bundle.of(dep)
+ depb <- r_bundle_of(dep)
if (!is.na(depb)) {
dep <- depb
}
return(list(name=dep,version=version))
}
-r.dependency.closure <- function(fringe, forward_arcs=T) {
+r_dependency_closure <- function(fringe, forward_arcs=T) {
# find the transitive closure of the dependencies/prerequisites of some R
# packages
closure <- list()
if (is.data.frame(fringe)) {
fringe <- as.list(fringe$name)
}
- fun = function(x) r.dependencies.of(name=x)$name
+ fun = function(x) r_dependencies_of(name=x)$name
if (!forward_arcs) {
- fun = r.requiring
+ fun = r_requiring
}
while(length(fringe) > 0) {
# pop off the top
} else {
fringe <- list()
}
- src <- pkgname.as.debian(top,binary=F)
+ src <- pkgname_as_debian(top,binary=F)
if (src == 'R') {
next
}
return(sub('^[[:space:]]+','',sub('[[:space:]]+$','',x)))
}
-host.arch <- function() {
+host_arch <- function() {
# return the host system architecture
system('dpkg-architecture -qDEB_HOST_ARCH',intern=T)
}
-version.new <- function(rver,debian_revision=1, debian_epoch=0) {
+version_new <- function(rver,debian_revision=1, debian_epoch=0) {
# generate a string representation of the Debian version of an
# R version of a package
pkgver = rver
return(paste(pkgver,'-',debian_revision,sep=''))
}
-version.epoch <- function(pkgver) {
+version_epoch <- function(pkgver) {
# return the Debian epoch of a Debian package version
if (!length(grep(':',pkgver)))
return(0)
return(as.integer(sub('^([0-9]+):.*','\\1',pkgver)))
}
-# version.epoch . version.new(x,y) = id
-# version.epoch(version.new(x,y)) = 0
+# version_epoch . version_new(x,y) = id
+# version_epoch(version_new(x,y)) = 0
-version.revision <- function(pkgver) {
+version_revision <- function(pkgver) {
# return the Debian revision of a Debian package version
return(as.integer(sub('.*-([0-9]+)$','\\1',pkgver)))
}
-# version.revision . version.new(x) = id
-# version.revision(version.new(x)) = 1
+# version_revision . version_new(x) = id
+# version_revision(version_new(x)) = 1
-version.upstream <- function(pkgver) {
+version_upstream <- function(pkgver) {
# return the upstream version of a Debian package version
return(sub('-[0-9]+$','',sub('^[0-9]+:','',pkgver)))
}
-# version.upstream . version.new = id
+# version_upstream . version_new = id
-version.update <- function(rver, prev_pkgver) {
+version_update <- function(rver, prev_pkgver) {
# return the next debian package version
- prev_rver <- version.upstream(prev_pkgver)
+ prev_rver <- version_upstream(prev_pkgver)
if (prev_rver == rver) {
# increment the Debian revision
- return(version.new(rver
- ,debian_revision = version.revision(prev_pkgver)+1
- ,debian_epoch = version.epoch(prev_pkgver)
+ return(version_new(rver
+ ,debian_revision = version_revision(prev_pkgver)+1
+ ,debian_epoch = version_epoch(prev_pkgver)
))
}
# new release
# TODO: implement Debian ordering over version and then autoincrement
# Debian epoch when upstream version does not increment.
- return(version.new(rver
- ,debian_epoch = version.epoch(prev_pkgver)
+ return(version_new(rver
+ ,debian_epoch = version_epoch(prev_pkgver)
))
}
global("changesfile", function(srcname,version='*') {
return(file.path(pbuilder_results
,paste(srcname,'_',version,'_'
- ,host.arch(),'.changes',sep='')))
+ ,host_arch(),'.changes',sep='')))
})
global("maintainer", 'cran2deb buildbot <cran2deb@example.org>')
global("root", system.file(package='cran2deb'))
go <- function(name,extra_deps) {
dir <- setup()
pkg <- try((function() {
- pkg <- prepare.new.debian(prepare.pkg(dir,name),extra_deps)
+ pkg <- prepare_new_debian(prepare_pkg(dir,name),extra_deps)
# XXX: what about building newer versions?
if (pkg$debname %in% debian_pkgs) {
message(paste('N:',pkg$srcname,' exists in Debian (perhaps a different version)'))
# pull in all the R dependencies
message(paste('N: dependencies:',paste(pkg$depends$r,collapse=', ')))
for (dep in pkg$depends$r) {
- if (pkgname.as.debian(dep) %in% debian_pkgs) {
+ if (pkgname_as_debian(dep) %in% debian_pkgs) {
message(paste('N: using Debian package of',dep))
next
}
# otherwise, convert to source package name
- srcdep = pkgname.as.debian(dep,binary=F)
+ srcdep = pkgname_as_debian(dep,binary=F)
message(paste('N: uploading',srcdep))
ret = system(paste('umask 022;dput','-c',shQuote(dput_config),'local'
stop('upload of dependency failed! maybe you did not build it first?')
}
}
- build.debian(pkg)
+ build_debian(pkg)
# upload the package
ret = system(paste('umask 022;dput','-c',shQuote(dput_config),'local'
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=', ')))
+ ,paste(r_dependency_closure(name,forward_arcs=F),collapse=', ')))
stop(call.=F)
}
return(pkg)
}
if (argv[i] == '-R') {
extra_deps$r = c(extra_deps$r,strsplit(chomp(argv[i+1]),',')[[1]])
- extra_deps$deb = c(extra_deps$deb,lapply(extra_deps$r,pkgname.as.debian))
+ extra_deps$deb = c(extra_deps$deb,lapply(extra_deps$r,pkgname_as_debian))
}
}
if (argc == 0) {
err('usage: cran2deb [-D extra_dep1,extra_dep2,...] package package ...')
}
- build_order <- r.dependency.closure(c(extra_deps$r,argv))
+ build_order <- r_dependency_closure(c(extra_deps$r,argv))
message(paste('N: build order',paste(build_order,collapse=', ')))
for (pkg in build_order) {
go(pkg,extra_deps)
return()
}
accept = (argc != 3)
- db.add.license.override(argv[2],accept)
+ db_add_license_override(argv[2],accept)
} else if (cmd == 'file') {
if (argc != 3) {
usage()
}
license = argv[2]
path = argv[3]
- if (is.null(db.license.override.name(license))) {
+ if (is.null(db_license_override_name(license))) {
message(paste('license',license,'is not known'))
return()
}
} else {
stop(paste(path,'does not exist and does not look like an SHA1 hash'))
}
- db.add.license.file(license,file_sha1)
+ db_add_license_file(license,file_sha1)
} else if (cmd == 'ls') {
- for (x in db.license.overrides()) print(x)
+ for (x in db_license_overrides()) print(x)
} else if (cmd == 'help') {
usage()
return()
return()
}
sysreq = paste(argv[3:argc],collapse=' ')
- db.add.sysreq.override(sysreq,argv[2])
+ db_add_sysreq_override(sysreq,argv[2])
} else if (cmd == 'ls') {
- print(db.sysreq.overrides())
+ print(db_sysreq_overrides())
} else if (cmd == 'help') {
usage()
return()
projects / cran2deb.git / commitdiff