From 86055c81b378b4629c33aa1c588deb5637e32975 Mon Sep 17 00:00:00 2001 From: blundellc Date: Sat, 13 Sep 2008 13:16:48 +0000 Subject: [PATCH] cran2deb: make into an R package. not complete. mostly seems to work, but certain parts are broken: e.g., updating the availability lists. git-svn-id: svn://svn.r-forge.r-project.org/svnroot/cran2deb@47 edb9625f-4e0d-4859-8d74-9fd3b1da38cb --- pkg/trunk/DESCRIPTION | 10 + pkg/trunk/R/debcontrol.R | 100 +++ pkg/trunk/R/debiannaming.R | 49 ++ pkg/trunk/R/debianpkg.R | 153 ++++ pkg/trunk/R/getrpkg.R | 68 ++ pkg/trunk/R/license.R | 77 ++ pkg/trunk/R/rdep.R | 152 ++++ pkg/trunk/R/util.R | 17 + pkg/trunk/R/version.R | 70 ++ pkg/trunk/R/zzz.R | 20 + pkg/trunk/cran2deb | 798 ------------------ pkg/trunk/{ => exec}/build_ctv | 0 pkg/trunk/{ => exec}/build_some | 0 pkg/trunk/{ => exec}/copy_find | 0 pkg/trunk/exec/cran2deb | 94 +++ pkg/trunk/{ => exec}/cranpkgs | 4 +- pkg/trunk/{ => exec}/diagnose | 0 pkg/trunk/{ => exec}/diagnose_ctv | 0 pkg/trunk/{ => exec}/setup | 2 +- pkg/trunk/{ => exec}/update_available | 3 +- pkg/trunk/{ => inst}/etc/dput.cf.in | 0 pkg/trunk/{ => inst}/etc/hook/B90lintian | 0 pkg/trunk/{ => inst}/etc/hook/B91dpkg-i | 0 pkg/trunk/{ => inst}/etc/hook/B92test-pkg | 0 pkg/trunk/{ => inst}/etc/hook/D70aptupdate | 0 .../{ => inst}/etc/mini-dinstall.conf.in | 0 pkg/trunk/{ => inst}/etc/pbuilderrc.in | 0 27 files changed, 814 insertions(+), 803 deletions(-) create mode 100644 pkg/trunk/DESCRIPTION create mode 100644 pkg/trunk/R/debcontrol.R create mode 100644 pkg/trunk/R/debiannaming.R create mode 100644 pkg/trunk/R/debianpkg.R create mode 100644 pkg/trunk/R/getrpkg.R create mode 100644 pkg/trunk/R/license.R create mode 100644 pkg/trunk/R/rdep.R create mode 100644 pkg/trunk/R/util.R create mode 100644 pkg/trunk/R/version.R create mode 100644 pkg/trunk/R/zzz.R delete mode 100755 pkg/trunk/cran2deb rename pkg/trunk/{ => exec}/build_ctv (100%) rename pkg/trunk/{ => exec}/build_some (100%) rename pkg/trunk/{ => exec}/copy_find (100%) create mode 100755 pkg/trunk/exec/cran2deb rename pkg/trunk/{ => exec}/cranpkgs (76%) rename pkg/trunk/{ => exec}/diagnose (100%) rename pkg/trunk/{ => exec}/diagnose_ctv (100%) rename pkg/trunk/{ => exec}/setup (84%) rename pkg/trunk/{ => exec}/update_available (77%) rename pkg/trunk/{ => inst}/etc/dput.cf.in (100%) rename pkg/trunk/{ => inst}/etc/hook/B90lintian (100%) rename pkg/trunk/{ => inst}/etc/hook/B91dpkg-i (100%) rename pkg/trunk/{ => inst}/etc/hook/B92test-pkg (100%) rename pkg/trunk/{ => inst}/etc/hook/D70aptupdate (100%) rename pkg/trunk/{ => inst}/etc/mini-dinstall.conf.in (100%) rename pkg/trunk/{ => inst}/etc/pbuilderrc.in (100%) diff --git a/pkg/trunk/DESCRIPTION b/pkg/trunk/DESCRIPTION new file mode 100644 index 0000000..1bfa413 --- /dev/null +++ b/pkg/trunk/DESCRIPTION @@ -0,0 +1,10 @@ +Package: cran2deb +Version: 0.0 +Date: 2008-07-14 +Title: Convert CRAN packages into Debian packages +Author: Charles Blundell , with assistance from Dirk Eddelbuettel <> +Maintainer: Charles Blundell +Depends: ctv, utils +Description: Convert CRAN packages into Debian packages, mostly unassisted, easily + subverting the R package system. +License: GPL-3 diff --git a/pkg/trunk/R/debcontrol.R b/pkg/trunk/R/debcontrol.R new file mode 100644 index 0000000..ea25962 --- /dev/null +++ b/pkg/trunk/R/debcontrol.R @@ -0,0 +1,100 @@ +get.dependencies <- function(pkg,extra_deps) { + if ('SystemRequirements' %in% colnames(pkg$description)) { + stop(paste('Unsupported SystemRequirements:',pkg$description[1,'SystemRequirements'])) + } + + # determine dependencies + dependencies <- r.dependencies.of(description=pkg$description) + depends <- list() + # these are used for generating the Depends fields + as.deb <- function(r,binary) { + return(pkgname.as.debian(paste(dependencies[r,]$name) + ,version=dependencies[r,]$version + ,repopref=pkg$repo + ,binary=binary)) + } + depends$bin <- lapply(rownames(dependencies), as.deb, binary=T) + depends$build <- lapply(rownames(dependencies), as.deb, binary=F) + # add the command line dependencies + depends$bin = c(extra_deps$deb,depends$bin) + depends$build = c(extra_deps$deb,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',binary=F)) + depends$bin = c(depends$bin, pkgname.as.debian('R',version='>= 2.7.0',binary=T)) + } + # also include stuff to allow tcltk to build (suggested by Dirk) + depends$build = c(depends$build,'xvfb','xauth','xfont-base') + + # remove duplicates + depends <- lapply(depends,unique) + + # append the Debian dependencies + depends$build=c(depends$build,'debhelper (>> 4.1.0)','cdbs') + if (pkg$archdep) { + depends$bin=c(depends$bin,'${shlibs:Depends}') + } + + # the names of dependent source packages (to find the .changes file to + # upload via dput). these can be found recursively. + depends$r = lapply(r.dependency.closure(dependencies) + ,tolower) + # append command line dependencies + depends$r = c(extra_deps$r, depends$r) + return(depends) +} + +generate.control <- function(pkg) { + # construct control file + control = data.frame() + control[1,'Source'] = pkg$srcname + control[1,'Section'] = 'math' + control[1,'Priority'] = 'optional' + control[1,'Maintainer'] = maintainer + control[1,'Build-Depends'] = paste(pkg$depends$build,collapse=', ') + control[1,'Standards-Version'] = '3.8.0' + + control[2,'Package'] = pkg$debname + control[2,'Architecture'] = 'all' + if (pkg$archdep) { + control[2,'Architecture'] = 'any' + } + control[2,'Depends'] = paste(pkg$depends$bin,collapse=', ') + + # 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) + ,repopref=pkg$repo + ,binary=T))) + ,collapse=', ') + } + + # generate the description + descr = 'GNU R package "' + if ('Title' %in% colnames(pkg$description)) { + descr = paste(descr,pkg$description[1,'Title'],sep='') + } else { + descr = paste(descr,pkg$name,sep='') + } + if (pkg$is_bundle) { + long_descr <- pkg$description[1,'BundleDescription'] + } else { + long_descr <- pkg$description[1,'Description'] + } + # using \n\n.\n\n is not very nice, but is necessary to make sure + # the longer description does not begin on the synopsis line --- R's + # write.dcf does not appear to have a nicer way of doing this. + descr = paste(descr,'"\n\n', long_descr, sep='') + if ('URL' %in% colnames(pkg$description)) { + descr = paste(descr,'\n\nURL: ',pkg$description[1,'URL'],sep='') + } + control[2,'Description'] = descr + + # Debian policy says 72 char width; indent minimally + write.dcf(control,file=pkg$debfile('control.in'),indent=1,width=72) + write.dcf(control,indent=1,width=72) +} + diff --git a/pkg/trunk/R/debiannaming.R b/pkg/trunk/R/debiannaming.R new file mode 100644 index 0000000..08c3f84 --- /dev/null +++ b/pkg/trunk/R/debiannaming.R @@ -0,0 +1,49 @@ +# sudo pbuilder --execute r -e 'rownames(installed.packages())' +# XXX: has to be a better way of doing this +base_pkgs=c('base', 'datasets','grDevices','graphics','grid', 'methods' + ,'splines','stats', 'stats4', 'tcltk', 'tools','utils') +# found in R source directory: +# 'profile', 'datasets' + +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') + } + if (length(grep('bioc',url))) { + return('bioc') + } + stop(paste('unknown repository',url)) +} + +pkgname.as.debian <- function(name,repopref=NULL,version=NULL,binary=T) { + # generate the debian package name corresponding to the R package name + if (name %in% base_pkgs) { + name = 'R' + } + if (name == 'R') { + # R is special. + if (binary) { + debname='r-base-core' + } else { + debname='r-base-dev' + } + } else { + # XXX: data.frame rownames are unique, so always override repopref for + # now. + if (!(name %in% rownames(available))) { + bundle <- r.bundle.of(name) + if (is.na(bundle)) { + stop(paste('package',name,'is not available')) + } + name <- bundle + } + repopref <- repourl.as.debian(available[name,'Repository']) + debname = paste('r',tolower(repopref),tolower(name),sep='-') + } + if (!is.null(version) && length(version) > 1) { + debname = paste(debname,' (',version,')',sep='') + } + return(debname) +} + diff --git a/pkg/trunk/R/debianpkg.R b/pkg/trunk/R/debianpkg.R new file mode 100644 index 0000000..3b9ca62 --- /dev/null +++ b/pkg/trunk/R/debianpkg.R @@ -0,0 +1,153 @@ +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')) +} + +generate.rules <- function(pkg) { + cat(paste('#!/usr/bin/make -f' + ,paste('debRreposname :=',pkg$repo) + ,'include /usr/share/R/debian/r-cran.mk' + ,'',sep='\n') + ,file=pkg$debfile('rules')) + Sys.chmod(pkg$debfile('rules'),'0700') +} + +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' + ,paste(maintainer,'.',sep='') + ,'' + ,'The original GNU R package is Copyright (C) ' + # TODO: copyright start date, true copyright date + ,format(Sys.time(),'%Y') + ,pkg$description[1,'Author'] + ,'and possibly others.' + ,'' + ,'The original GNU R package is maintained by' + ,pkg$description[1,'Maintainer'],'and was obtained from:' + ,'' + ,pkg$repoURL + ,'' + ,'' + ,'The GNU R package DESCRIPTION offers a' + ,'Copyright licenses under the terms of the',pkg$license + ,'license. On a Debian GNU/Linux system, common' + ,'licenses are included in the directory' + ,'/usr/share/common-licenses/.' + ,'' + ,'The DESCRIPTION file for the original GNU R package ' + ,'can be found in ' + ,file.path('/usr/lib/R/site-library' + ,pkg$debname + ,'DESCRIPTION' + ) + ,sep='\n'), width=72), con=pkg$debfile('copyright.in')) +} + +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 (!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) + + if (!length(grep('\\.tar\\.gz',pkg$archive))) { + stop('archive is not tarball') + } + + # re-pack into a Debian-named archive with a Debian-named directory. + debpath = file.path(dirname(pkg$archive) + ,paste(pkg$srcname,'-' + ,pkg$version + ,sep='')) + file.rename(pkg$path, debpath) + pkg$path = debpath + debarchive = file.path(dirname(pkg$archive) + ,paste(pkg$srcname,'_' + ,pkg$version,'.orig.tar.gz' + ,sep='')) + wd <- getwd() + setwd(dirname(pkg$path)) + # remove them pesky +x files + system(paste('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)))) + setwd(wd) + file.remove(pkg$archive) + pkg$archive = debarchive + + # make the debian/ directory + debdir <- file.path(pkg$path,'debian') + pkg$debfile <- function(x) { file.path(debdir,x) } + unlink(debdir,recursive=T) + dir.create(debdir) + + # see if this is an architecture-dependent package. + # heuristic: if /src/ exists in pkg$path, then this is an + # architecture-dependent package. + # CRAN2DEB.pm is a bit fancier about this but ``Writing R extensions'' + # says: ``The sources and headers for the compiled code are in src, plus + # optionally file Makevars or Makefile.'' It seems unlikely that + # architecture independent code would end up here. + 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)) { + pkg$archdep = file.exists(file.path(pkg$path,pkgname,'src')) + if (pkg$archdep) { + break + } + } + } else { + pkg$archdep = file.exists(file.path(pkg$path,'src')) + } + pkg$arch <- 'all' + if (pkg$archdep) { + 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) + + # TODO: debian/watch from pkg$repoURL + + # 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)) + ,' -t utf8 ' + ,shQuote(pkg$debfile(paste(file,'in',sep='.'))))) + file.remove(pkg$debfile(paste(file,'in',sep='.'))) + } + return(pkg) +} + +build.debian <- function(pkg) { + wd <- getwd() + setwd(pkg$path) + message(paste('N: building Debian package' + ,pkg$debname + ,paste('(',pkg$debversion,')',sep='') + ,'...')) + ret = system(paste('pdebuild --configfile',pbuilder_config)) + setwd(wd) + if (ret != 0) { + stop('Failed to build package.') + } +} + diff --git a/pkg/trunk/R/getrpkg.R b/pkg/trunk/R/getrpkg.R new file mode 100644 index 0000000..45fbe6d --- /dev/null +++ b/pkg/trunk/R/getrpkg.R @@ -0,0 +1,68 @@ + +setup <- function() { + # set up the working directory + tmp <- tempfile('cran2deb') + dir.create(tmp) + return (tmp) +} + +cleanup <- function(dir) { + # remove the working directory + unlink(dir,recursive=T) + invisible() +} + +prepare.pkg <- function(dir, pkgname) { + # download and extract an R package named pkgname + # OR the bundle containing pkgname + + # based loosely on library/utils/R/packages2.R::install.packages + # should do nothing Debian specific + + # 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)) { + stop(paste('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)) + } + wd <- getwd() + setwd(dir) + if (length(grep('\\.zip$',archive))) { + cmd = paste('unzip',shQuote(archive)) + } else if (length(grep('\\.tar\\.gz$',archive))) { + cmd = paste('tar','xzf',shQuote(archive)) + } else { + stop(paste('Type of archive',archive,'is unknown.')) + } + ret = system(cmd) + setwd(wd) + if (ret != 0) { + stop(paste('Extraction of archive',archive,'failed.')) + } + pkg <- pairlist() + pkg$name = pkgname + pkg$archive = archive + pkg$path = sub("_\\.(zip|tar\\.gz)", "" + ,gsub(.standard_regexps()$valid_package_version, "" + ,archive)) + if (!file.info(pkg$path)[,'isdir']) { + stop(paste(pkg$path,'is not a directory and should be.')) + } + pkg$description = read.dcf(file.path(pkg$path,'DESCRIPTION')) + pkg$repoURL = available[pkgname,'Repository'] + pkg$version = pkg$description[1,'Version'] + pkg$is_bundle = 'Bundle' %in% names(pkg$description[1,]) + # 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')) + } + return(pkg) +} + diff --git a/pkg/trunk/R/license.R b/pkg/trunk/R/license.R new file mode 100644 index 0000000..7112572 --- /dev/null +++ b/pkg/trunk/R/license.R @@ -0,0 +1,77 @@ +debian_ok_licenses=c('GPL','LGPL','AGPL','ARTISTIC' #,'UNLIMITED' + ,'BSD','MIT','APACHE','X11','MPL') + +is_acceptable_license <- function(license) { + # determine if license is acceptable + + # compress spaces into a single space + license = gsub('[[:blank:]]+',' ',license) + # make all characters upper case + license = toupper(license) + # don't care about versions of licenses + license = chomp(sub('\\( ?[<=>!]+ ?[0-9.-]+ ?\\)','' + ,sub('-[0-9.-]+','',license))) + if (license %in% debian_ok_licenses) { + return(T) + } + # uninteresting urls + license = gsub('HTTP://WWW.GNU.ORG/[A-Z/._-]*','',license) + license = gsub('HTTP://WWW.X.ORG/[A-Z/._-]*','',license) + license = gsub('HTTP://WWW.OPENSOURCE.ORG/[A-Z/._-]*','',license) + # remove all punctuation + license = gsub('[[:punct:]]+','',license) + # remove any extra space introduced + license = chomp(gsub('[[:space:]]+',' ',license)) + # redundant + license = gsub('THE','',license) + license = gsub('SEE','',license) + license = gsub('STANDARD','',license) + license = gsub('LICEN[SC]E','',license) + license = gsub('(GNU )?(GPL|GENERAL PUBLIC)','GPL',license) + license = gsub('(MOZILLA )?(MPL|MOZILLA PUBLIC)','MPL',license) + # remove any extra space introduced + license = chomp(gsub('[[:space:]]+',' ',license)) + if (license %in% debian_ok_licenses) { + message(paste('W: Accepted wild license as',license,'. FIX THE PACKAGE!')) + return(T) + } + # remove everything that looks like a version specification + license = gsub('(VER?SION|V)? *[0-9.-]+ *(OR *(HIGHER|LATER|NEWER|GREATER|ABOVE))?','' + ,license) + # remove any extra space introduced + license = chomp(gsub('[[:space:]]+',' ',license)) + if (license %in% debian_ok_licenses) { + message(paste('W: Accepted wild license as',license,'. FIX THE PACKAGE!')) + return(T) + } + # TODO: put debian_ok_licenses in DB + # TODO: file {LICENSE,LICENCE} (+ maybe COPYING?) + message(paste('E: Wild license',license,'did not match')) + return(F) +} + +accept.license <- function(pkg) { + # check the license + if (!('License' %in% names(pkg$description[1,]))) { + stop('package has no License: field in description!') + } + accept=NULL + for (license in strsplit(chomp(pkg$description[1,'License']) + ,'[[:space:]]*\\|[[:space:]]*')[[1]]) { + if (is_acceptable_license(license)) { + accept=license + break + } + } + if (is.null(accept)) { + stop(paste('No acceptable license:',pkg$description[1,'License'])) + } else { + message(paste('N: Auto-accepted license',accept)) + } + if (accept == 'Unlimited') { + # definition of Unlimited from ``Writing R extensions'' + accept=paste('Unlimited (no restrictions on distribution or' + ,'use other than those imposed by relevant laws)') + } + return(accept) +} diff --git a/pkg/trunk/R/rdep.R b/pkg/trunk/R/rdep.R new file mode 100644 index 0000000..0af9451 --- /dev/null +++ b/pkg/trunk/R/rdep.R @@ -0,0 +1,152 @@ + +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)) { + return(bundle) + } + } + return(NA) +} + +r.bundle.contains <- function(bundlename) { + return(strsplit(available[bundlename,'Contains'],'[[:space:]]+')[[1]]) +} + +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)) { + stop(paste('package',name,'is not available')) + } + names <- c(names,r.bundle.contains(bundle)) + } + } + # approximately prune first into a smaller availability + candidates <- available[sapply(rownames(available) + ,function(name) + length(grep(paste(names,sep='|') + ,available[name,r_depend_fields])) > 0) + ,r_depend_fields + ,drop=F] + if (length(candidates) == 0) { + return(c()) + } + # find a logical index into available of every package/bundle + # whose dependency field contains at least one element of names. + # (this is not particularly easy to read---sorry---but is much faster than + # the alternatives i could think of) + prereq=c() + dep_matches <- function(dep) chomp(gsub('\\([^\\)]+\\)','',dep)) %in% names + any_dep_matches <- function(name,field=NA) + any(sapply(strsplit(chomp(candidates[name,field]) + ,'[[:space:]]*,[[:space:]]*') + ,dep_matches)) + + for (field in r_depend_fields) { + matches = sapply(rownames(candidates), any_dep_matches, field=field) + if (length(matches) > 0) { + prereq = c(prereq,rownames(candidates[matches,])) + } + } + return(unique(prereq)) +} + +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)) { + return(data.frame()) + } + if (is.null(description) && is.null(name)) { + stop('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')) + } + name <- bundle + } + description <- data.frame() + # keep only the interesting fields + for (field in r_depend_fields) { + if (!(field %in% names(available[name,]))) { + next + } + description[1,field] = available[name,field] + } + } + # extract the dependencies from the description + deps <- data.frame() + for (field in r_depend_fields) { + if (!(field %in% names(description[1,]))) { + next + } + new_deps <- lapply(strsplit(chomp(description[1,field]) + ,'[[:space:]]*,[[:space:]]*')[[1]] + ,r.parse.dep.field) + deps <- iterate(lapply(new_deps[!is.na(new_deps)],rbind),deps,rbind) + } + return (deps) +} + +r.parse.dep.field <- function(dep) { + if (is.na(dep)) { + return(NA) + } + # remove other comments + dep = gsub('(\\(\\)|\\([[:space:]]*[^<=>!].*\\))','',dep) + # squish spaces + dep = chomp(gsub('[[:space:]]+',' ',dep)) + # parse version + pat = '^([^ ()]+) ?(\\( ?([<=>!]+ ?[0-9.-]+) ?\\))?$' + if (!length(grep(pat,dep))) { + stop(paste('R dependency',dep,'does not appear to be well-formed')) + } + version = sub(pat,'\\3',dep) + dep = sub(pat,'\\1',dep) + if (!(dep %in% rownames(available))) { + 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) { + # find the transitive closure of the dependencies/prerequisites of some R + # packages + closure <- list() + if (is.data.frame(fringe)) { + fringe <- levels(fringe$name) + } + fun = function(x) levels(r.dependencies.of(name=x)$name) + if (!forward_arcs) { + fun = r.requiring + } + while(length(fringe) > 0) { + # pop off the top + top <- fringe[[1]] + if (length(fringe) > 1) { + fringe <- fringe[2:length(fringe)] + } else { + fringe <- list() + } + src <- pkgname.as.debian(top,binary=F) + if (!length(grep('^r-',src)) || length(grep('^r-base',src))) { + next + } + newdeps <- fun(top) + closure=c(closure,top) + fringe=c(fringe,newdeps) + } + # build order + return(rev(unique(closure,fromLast=T))) +} + diff --git a/pkg/trunk/R/util.R b/pkg/trunk/R/util.R new file mode 100644 index 0000000..35f6413 --- /dev/null +++ b/pkg/trunk/R/util.R @@ -0,0 +1,17 @@ +iterate <- function(xs,z,fun) { + y <- z + for (x in xs) + y <- fun(y,x) + return(y) +} + +chomp <- function(x) { + # remove leading and trailing spaces + return(sub('^[[:space:]]+','',sub('[[:space:]]+$','',x))) +} + +host.arch <- function() { + # return the host system architecture + system('dpkg-architecture -qDEB_HOST_ARCH',intern=T) +} + diff --git a/pkg/trunk/R/version.R b/pkg/trunk/R/version.R new file mode 100644 index 0000000..29c8c0e --- /dev/null +++ b/pkg/trunk/R/version.R @@ -0,0 +1,70 @@ +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 + + # ``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)) + } + + # 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.')) + } + + # if rver contains a : then the Debian version must also have a colon + if (debian_epoch == 0 && length(grep(':',pkgver))) + debian_epoch = 1 + + # if the epoch is non-zero then include it + if (debian_epoch != 0) + pkgver = paste(debian_epoch,':',pkgver,sep='') + + # always add the '-1' Debian release; nothing is lost and rarely will R + # packages be Debian packages without modification. + return(paste(pkgver,'-',debian_revision,sep='')) +} + +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.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.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.update <- function(rver, prev_pkgver) { + # return the next debian package version + 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) + )) + } + # 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) + )) +} diff --git a/pkg/trunk/R/zzz.R b/pkg/trunk/R/zzz.R new file mode 100644 index 0000000..a57cc3a --- /dev/null +++ b/pkg/trunk/R/zzz.R @@ -0,0 +1,20 @@ + +changesfile <- function(srcname,version='*') { + return(file.path(pbuilder_results + ,paste(srcname,'_',version,'_' + ,host.arch(),'.changes',sep=''))) +} + +maintainer <- 'cran2deb buildbot ' +root <- system.file('') +pbuilder_results <- file.path(root,'var/results') +pbuilder_config <- file.path(root,'etc/pbuilderrc') +dput_config <- file.path(root,'etc/dput.cf') +dinstall_config <- file.path(root,'etc/mini-dinstall.conf') +dinstall_archive <- file.path(root,'var/archive') +r_depend_fields <- c('Depends','Imports') # Suggests, Enhances + +# we cache the list of available packages +# should be pulled in already +#load(file.path(root,'var/cache/available.cache.Rd')) + diff --git a/pkg/trunk/cran2deb b/pkg/trunk/cran2deb deleted file mode 100755 index 821d8a6..0000000 --- a/pkg/trunk/cran2deb +++ /dev/null @@ -1,798 +0,0 @@ -#!/usr/bin/env r - -maintainer <- 'cran2deb buildbot ' -root <- '/home/cb/work/gsoc/cran2deb' -pbuilder_results <- file.path(root,'var/results') -pbuilder_config <- file.path(root,'etc/pbuilderrc') -dput_config <- file.path(root,'etc/dput.cf') -dinstall_config <- file.path(root,'etc/mini-dinstall.conf') -dinstall_archive <- file.path(root,'var/archive') -r_depend_fields <- c('Depends','Imports') # Suggests, Enhances - -# we cache the list of available packages -load(file.path(root,'var/cache/available.cache.Rd')) - -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 - - # ``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)) - } - - # 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.')) - } - - # if rver contains a : then the Debian version must also have a colon - if (debian_epoch == 0 && length(grep(':',pkgver))) - debian_epoch = 1 - - # if the epoch is non-zero then include it - if (debian_epoch != 0) - pkgver = paste(debian_epoch,':',pkgver,sep='') - - # always add the '-1' Debian release; nothing is lost and rarely will R - # packages be Debian packages without modification. - return(paste(pkgver,'-',debian_revision,sep='')) -} - -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.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.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.update <- function(rver, prev_pkgver) { - # return the next debian package version - 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) - )) - } - # 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) - )) -} - -# sudo pbuilder --execute r -e 'rownames(installed.packages())' -# XXX: has to be a better way of doing this -base_pkgs=c('base', 'datasets','grDevices','graphics','grid', 'methods' - ,'splines','stats', 'stats4', 'tcltk', 'tools','utils') -# found in R source directory: -# 'profile', 'datasets' - -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') - } - if (length(grep('bioc',url))) { - return('bioc') - } - stop(paste('unknown repository',url)) -} - -pkgname.as.debian <- function(name,repopref=NULL,version=NULL,binary=T) { - # generate the debian package name corresponding to the R package name - if (name %in% base_pkgs) { - name = 'R' - } - if (name == 'R') { - # R is special. - if (binary) { - debname='r-base-core' - } else { - debname='r-base-dev' - } - } else { - # XXX: data.frame rownames are unique, so always override repopref for - # now. - if (!(name %in% rownames(available))) { - bundle <- r.bundle.of(name) - if (is.na(bundle)) { - stop(paste('package',name,'is not available')) - } - name <- bundle - } - repopref <- repourl.as.debian(available[name,'Repository']) - debname = paste('r',tolower(repopref),tolower(name),sep='-') - } - if (!is.null(version) && length(version) > 1) { - debname = paste(debname,' (',version,')',sep='') - } - return(debname) -} - -setup <- function() { - # set up the working directory - tmp <- tempfile('cran2deb') - dir.create(tmp) - return (tmp) -} - -cleanup <- function(dir) { - # remove the working directory - unlink(dir,recursive=T) - invisible() -} - -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)) { - return(bundle) - } - } - return(NA) -} - -r.bundle.contains <- function(bundlename) { - return(strsplit(available[bundlename,'Contains'],'[[:space:]]+')[[1]]) -} - -prepare.pkg <- function(dir, pkgname) { - # download and extract an R package named pkgname - # OR the bundle containing pkgname - - # based loosely on library/utils/R/packages2.R::install.packages - # should do nothing Debian specific - - # 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)) { - stop(paste('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)) - } - wd <- getwd() - setwd(dir) - if (length(grep('\\.zip$',archive))) { - cmd = paste('unzip',shQuote(archive)) - } else if (length(grep('\\.tar\\.gz$',archive))) { - cmd = paste('tar','xzf',shQuote(archive)) - } else { - stop(paste('Type of archive',archive,'is unknown.')) - } - ret = system(cmd) - setwd(wd) - if (ret != 0) { - stop(paste('Extraction of archive',archive,'failed.')) - } - pkg <- pairlist() - pkg$name = pkgname - pkg$archive = archive - pkg$path = sub("_\\.(zip|tar\\.gz)", "" - ,gsub(.standard_regexps()$valid_package_version, "" - ,archive)) - if (!file.info(pkg$path)[,'isdir']) { - stop(paste(pkg$path,'is not a directory and should be.')) - } - pkg$description = read.dcf(file.path(pkg$path,'DESCRIPTION')) - pkg$repoURL = available[pkgname,'Repository'] - pkg$version = pkg$description[1,'Version'] - pkg$is_bundle = 'Bundle' %in% names(pkg$description[1,]) - # 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')) - } - return(pkg) -} - -debian_ok_licenses=c('GPL','LGPL','AGPL','ARTISTIC' #,'UNLIMITED' - ,'BSD','MIT','APACHE','X11','MPL') - -is_acceptable_license <- function(license) { - # determine if license is acceptable - - # compress spaces into a single space - license = gsub('[[:blank:]]+',' ',license) - # make all characters upper case - license = toupper(license) - # don't care about versions of licenses - license = chomp(sub('\\( ?[<=>!]+ ?[0-9.-]+ ?\\)','' - ,sub('-[0-9.-]+','',license))) - if (license %in% debian_ok_licenses) { - return(T) - } - # uninteresting urls - license = gsub('HTTP://WWW.GNU.ORG/[A-Z/._-]*','',license) - license = gsub('HTTP://WWW.X.ORG/[A-Z/._-]*','',license) - license = gsub('HTTP://WWW.OPENSOURCE.ORG/[A-Z/._-]*','',license) - # remove all punctuation - license = gsub('[[:punct:]]+','',license) - # remove any extra space introduced - license = chomp(gsub('[[:space:]]+',' ',license)) - # redundant - license = gsub('THE','',license) - license = gsub('SEE','',license) - license = gsub('STANDARD','',license) - license = gsub('LICEN[SC]E','',license) - license = gsub('(GNU )?(GPL|GENERAL PUBLIC)','GPL',license) - license = gsub('(MOZILLA )?(MPL|MOZILLA PUBLIC)','MPL',license) - # remove any extra space introduced - license = chomp(gsub('[[:space:]]+',' ',license)) - if (license %in% debian_ok_licenses) { - message(paste('W: Accepted wild license as',license,'. FIX THE PACKAGE!')) - return(T) - } - # remove everything that looks like a version specification - license = gsub('(VER?SION|V)? *[0-9.-]+ *(OR *(HIGHER|LATER|NEWER|GREATER|ABOVE))?','' - ,license) - # remove any extra space introduced - license = chomp(gsub('[[:space:]]+',' ',license)) - if (license %in% debian_ok_licenses) { - message(paste('W: Accepted wild license as',license,'. FIX THE PACKAGE!')) - return(T) - } - # TODO: put debian_ok_licenses in DB - # TODO: file {LICENSE,LICENCE} (+ maybe COPYING?) - message(paste('E: Wild license',license,'did not match')) - return(F) -} - -iterate <- function(xs,z,fun) { - y <- z - for (x in xs) - y <- fun(y,x) - return(y) -} - -chomp <- function(x) { - # remove leading and trailing spaces - return(sub('^[[:space:]]+','',sub('[[:space:]]+$','',x))) -} - -host.arch <- function() { - # return the host system architecture - system('dpkg-architecture -qDEB_HOST_ARCH',intern=T) -} - -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)) { - stop(paste('package',name,'is not available')) - } - names <- c(names,r.bundle.contains(bundle)) - } - } - # approximately prune first into a smaller availability - candidates <- available[sapply(rownames(available) - ,function(name) - length(grep(paste(names,sep='|') - ,available[name,r_depend_fields])) > 0) - ,r_depend_fields - ,drop=F] - if (length(candidates) == 0) { - return(c()) - } - # find a logical index into available of every package/bundle - # whose dependency field contains at least one element of names. - # (this is not particularly easy to read---sorry---but is much faster than - # the alternatives i could think of) - prereq=c() - dep_matches <- function(dep) chomp(gsub('\\([^\\)]+\\)','',dep)) %in% names - any_dep_matches <- function(name,field=NA) - any(sapply(strsplit(chomp(candidates[name,field]) - ,'[[:space:]]*,[[:space:]]*') - ,dep_matches)) - - for (field in r_depend_fields) { - matches = sapply(rownames(candidates), any_dep_matches, field=field) - if (length(matches) > 0) { - prereq = c(prereq,rownames(candidates[matches,])) - } - } - return(unique(prereq)) -} - -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)) { - return(data.frame()) - } - if (is.null(description) && is.null(name)) { - stop('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')) - } - name <- bundle - } - description <- data.frame() - # keep only the interesting fields - for (field in r_depend_fields) { - if (!(field %in% names(available[name,]))) { - next - } - description[1,field] = available[name,field] - } - } - # extract the dependencies from the description - deps <- data.frame() - for (field in r_depend_fields) { - if (!(field %in% names(description[1,]))) { - next - } - new_deps <- lapply(strsplit(chomp(description[1,field]) - ,'[[:space:]]*,[[:space:]]*')[[1]] - ,r.parse.dep.field) - deps <- iterate(lapply(new_deps[!is.na(new_deps)],rbind),deps,rbind) - } - return (deps) -} - -r.parse.dep.field <- function(dep) { - if (is.na(dep)) { - return(NA) - } - # remove other comments - dep = gsub('(\\(\\)|\\([[:space:]]*[^<=>!].*\\))','',dep) - # squish spaces - dep = chomp(gsub('[[:space:]]+',' ',dep)) - # parse version - pat = '^([^ ()]+) ?(\\( ?([<=>!]+ ?[0-9.-]+) ?\\))?$' - if (!length(grep(pat,dep))) { - stop(paste('R dependency',dep,'does not appear to be well-formed')) - } - version = sub(pat,'\\3',dep) - dep = sub(pat,'\\1',dep) - if (!(dep %in% rownames(available))) { - 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) { - # find the transitive closure of the dependencies/prerequisites of some R - # packages - closure <- list() - if (is.data.frame(fringe)) { - fringe <- levels(fringe$name) - } - fun = function(x) levels(r.dependencies.of(name=x)$name) - if (!forward_arcs) { - fun = r.requiring - } - while(length(fringe) > 0) { - # pop off the top - top <- fringe[[1]] - if (length(fringe) > 1) { - fringe <- fringe[2:length(fringe)] - } else { - fringe <- list() - } - src <- pkgname.as.debian(top,binary=F) - if (!length(grep('^r-',src)) || length(grep('^r-base',src))) { - next - } - newdeps <- fun(top) - closure=c(closure,top) - fringe=c(fringe,newdeps) - } - # build order - return(rev(unique(closure,fromLast=T))) -} - -accept.license <- function(pkg) { - # check the license - if (!('License' %in% names(pkg$description[1,]))) { - stop('package has no License: field in description!') - } - accept=NULL - for (license in strsplit(chomp(pkg$description[1,'License']) - ,'[[:space:]]*\\|[[:space:]]*')[[1]]) { - if (is_acceptable_license(license)) { - accept=license - break - } - } - if (is.null(accept)) { - stop(paste('No acceptable license:',pkg$description[1,'License'])) - } else { - message(paste('N: Auto-accepted license',accept)) - } - if (accept == 'Unlimited') { - # definition of Unlimited from ``Writing R extensions'' - accept=paste('Unlimited (no restrictions on distribution or' - ,'use other than those imposed by relevant laws)') - } - return(accept) -} - -get.dependencies <- function(pkg,extra_deps) { - if ('SystemRequirements' %in% colnames(pkg$description)) { - stop(paste('Unsupported SystemRequirements:',pkg$description[1,'SystemRequirements'])) - } - - # determine dependencies - dependencies <- r.dependencies.of(description=pkg$description) - depends <- list() - # these are used for generating the Depends fields - as.deb <- function(r,binary) { - return(pkgname.as.debian(paste(dependencies[r,]$name) - ,version=dependencies[r,]$version - ,repopref=pkg$repo - ,binary=binary)) - } - depends$bin <- lapply(rownames(dependencies), as.deb, binary=T) - depends$build <- lapply(rownames(dependencies), as.deb, binary=F) - # add the command line dependencies - depends$bin = c(extra_deps$deb,depends$bin) - depends$build = c(extra_deps$deb,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',binary=F)) - depends$bin = c(depends$bin, pkgname.as.debian('R',version='>= 2.7.0',binary=T)) - } - # also include stuff to allow tcltk to build (suggested by Dirk) - depends$build = c(depends$build,'xvfb','xauth','xfont-base') - - # remove duplicates - depends <- lapply(depends,unique) - - # append the Debian dependencies - depends$build=c(depends$build,'debhelper (>> 4.1.0)','cdbs') - if (pkg$archdep) { - depends$bin=c(depends$bin,'${shlibs:Depends}') - } - - # the names of dependent source packages (to find the .changes file to - # upload via dput). these can be found recursively. - depends$r = lapply(r.dependency.closure(dependencies) - ,tolower) - # append command line dependencies - depends$r = c(extra_deps$r, depends$r) - return(depends) -} - -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')) -} - -generate.rules <- function(pkg) { - cat(paste('#!/usr/bin/make -f' - ,paste('debRreposname :=',pkg$repo) - ,'include /usr/share/R/debian/r-cran.mk' - ,'',sep='\n') - ,file=pkg$debfile('rules')) - Sys.chmod(pkg$debfile('rules'),'0700') -} - -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' - ,paste(maintainer,'.',sep='') - ,'' - ,'The original GNU R package is Copyright (C) ' - # TODO: copyright start date, true copyright date - ,format(Sys.time(),'%Y') - ,pkg$description[1,'Author'] - ,'and possibly others.' - ,'' - ,'The original GNU R package is maintained by' - ,pkg$description[1,'Maintainer'],'and was obtained from:' - ,'' - ,pkg$repoURL - ,'' - ,'' - ,'The GNU R package DESCRIPTION offers a' - ,'Copyright licenses under the terms of the',pkg$license - ,'license. On a Debian GNU/Linux system, common' - ,'licenses are included in the directory' - ,'/usr/share/common-licenses/.' - ,'' - ,'The DESCRIPTION file for the original GNU R package ' - ,'can be found in ' - ,file.path('/usr/lib/R/site-library' - ,pkg$debname - ,'DESCRIPTION' - ) - ,sep='\n'), width=72), con=pkg$debfile('copyright.in')) -} - -generate.control <- function(pkg) { - # construct control file - control = data.frame() - control[1,'Source'] = pkg$srcname - control[1,'Section'] = 'math' - control[1,'Priority'] = 'optional' - control[1,'Maintainer'] = maintainer - control[1,'Build-Depends'] = paste(pkg$depends$build,collapse=', ') - control[1,'Standards-Version'] = '3.8.0' - - control[2,'Package'] = pkg$debname - control[2,'Architecture'] = 'all' - if (pkg$archdep) { - control[2,'Architecture'] = 'any' - } - control[2,'Depends'] = paste(pkg$depends$bin,collapse=', ') - - # 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) - ,repopref=pkg$repo - ,binary=T))) - ,collapse=', ') - } - - # generate the description - descr = 'GNU R package "' - if ('Title' %in% colnames(pkg$description)) { - descr = paste(descr,pkg$description[1,'Title'],sep='') - } else { - descr = paste(descr,pkg$name,sep='') - } - if (pkg$is_bundle) { - long_descr <- pkg$description[1,'BundleDescription'] - } else { - long_descr <- pkg$description[1,'Description'] - } - # using \n\n.\n\n is not very nice, but is necessary to make sure - # the longer description does not begin on the synopsis line --- R's - # write.dcf does not appear to have a nicer way of doing this. - descr = paste(descr,'"\n\n', long_descr, sep='') - if ('URL' %in% colnames(pkg$description)) { - descr = paste(descr,'\n\nURL: ',pkg$description[1,'URL'],sep='') - } - control[2,'Description'] = descr - - # Debian policy says 72 char width; indent minimally - write.dcf(control,file=pkg$debfile('control.in'),indent=1,width=72) - write.dcf(control,indent=1,width=72) -} - -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 (!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) - - if (!length(grep('\\.tar\\.gz',pkg$archive))) { - stop('archive is not tarball') - } - - # re-pack into a Debian-named archive with a Debian-named directory. - debpath = file.path(dirname(pkg$archive) - ,paste(pkg$srcname,'-' - ,pkg$version - ,sep='')) - file.rename(pkg$path, debpath) - pkg$path = debpath - debarchive = file.path(dirname(pkg$archive) - ,paste(pkg$srcname,'_' - ,pkg$version,'.orig.tar.gz' - ,sep='')) - wd <- getwd() - setwd(dirname(pkg$path)) - # remove them pesky +x files - system(paste('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)))) - setwd(wd) - file.remove(pkg$archive) - pkg$archive = debarchive - - # make the debian/ directory - debdir <- file.path(pkg$path,'debian') - pkg$debfile <- function(x) { file.path(debdir,x) } - unlink(debdir,recursive=T) - dir.create(debdir) - - # see if this is an architecture-dependent package. - # heuristic: if /src/ exists in pkg$path, then this is an - # architecture-dependent package. - # CRAN2DEB.pm is a bit fancier about this but ``Writing R extensions'' - # says: ``The sources and headers for the compiled code are in src, plus - # optionally file Makevars or Makefile.'' It seems unlikely that - # architecture independent code would end up here. - 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)) { - pkg$archdep = file.exists(file.path(pkg$path,pkgname,'src')) - if (pkg$archdep) { - break - } - } - } else { - pkg$archdep = file.exists(file.path(pkg$path,'src')) - } - pkg$arch <- 'all' - if (pkg$archdep) { - 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) - - # TODO: debian/watch from pkg$repoURL - - # 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)) - ,' -t utf8 ' - ,shQuote(pkg$debfile(paste(file,'in',sep='.'))))) - file.remove(pkg$debfile(paste(file,'in',sep='.'))) - } - return(pkg) -} - -build.debian <- function(pkg) { - wd <- getwd() - setwd(pkg$path) - message(paste('N: building Debian package' - ,pkg$debname - ,paste('(',pkg$debversion,')',sep='') - ,'...')) - ret = system(paste('pdebuild --configfile',pbuilder_config)) - setwd(wd) - if (ret != 0) { - stop('Failed to build package.') - } -} - -changesfile <- function(srcname,version='*') { - return(file.path(pbuilder_results - ,paste(srcname,'_',version,'_' - ,host.arch(),'.changes',sep=''))) -} - -go <- function(name,extra_deps) { - dir <- setup() - pkg <- try((function() { - pkg <- prepare.new.debian(prepare.pkg(dir,name),extra_deps) - if (file.exists(changesfile(pkg$srcname,pkg$debversion))) { - message(paste('N: already built',pkg$srcname,'version',pkg$debversion)) - return(pkg) - } - - # delete the current archive (XXX: assumes mini-dinstall) - for (subdir in c('mini-dinstall','unstable')) { - path = file.path(dinstall_archive,subdir) - if (file.exists(path)) { - unlink(path,recursive=T) - } - } - - # delete notes of upload - 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)) - if (ret != 0) { - stop('failed to create archive') - } - - # pull in all the R dependencies - message(paste('N: dependencies:',paste(pkg$depends$r,collapse=', '))) - for (dep in pkg$depends$r) { - message(paste('N: uploading',dep)) - ret = system(paste('umask 022;dput','-c',shQuote(dput_config),'local' - ,changesfile(dep))) - if (ret != 0) { - stop('upload of dependency failed! maybe you did not build it first?') - } - } - build.debian(pkg) - - # upload the package - ret = system(paste('umask 022;dput','-c',shQuote(dput_config),'local' - ,changesfile(pkg$srcname,pkg$debversion))) - if (ret != 0) { - stop('upload failed!') - } - - return(pkg) - })()) - cleanup(dir) - if (inherits(pkg,'try-error')) { - stop(call.=F) - } - return(pkg) -} - -if (exists('argv')) { # check for littler - argc <- length(argv) - extra_deps = list() - extra_deps$deb = c() - extra_deps$r = c() - opts = c('-D','-R') - for (i in 1:argc) { - if (!(argv[i] %in% opts)) { - if (argc >= i) { - argv <- argv[i:argc] - } else { - argv <- list() - } - argc = argc - i + 1 - break - } - if (i == argc) { - message('E: missing argument') - q(save='no') - } - if (argv[i] == '-D') { - extra_deps$deb = c(extra_deps$deb,strsplit(chomp(argv[i+1]),',')[[1]]) - } - 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)) - } - } - if (argc == 0) { - message('E: usage: cran2deb [-D extra_dep1,extra_dep2,...] package package ...') - q(save='no') - } - 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) - } -} diff --git a/pkg/trunk/build_ctv b/pkg/trunk/exec/build_ctv similarity index 100% rename from pkg/trunk/build_ctv rename to pkg/trunk/exec/build_ctv diff --git a/pkg/trunk/build_some b/pkg/trunk/exec/build_some similarity index 100% rename from pkg/trunk/build_some rename to pkg/trunk/exec/build_some diff --git a/pkg/trunk/copy_find b/pkg/trunk/exec/copy_find similarity index 100% rename from pkg/trunk/copy_find rename to pkg/trunk/exec/copy_find diff --git a/pkg/trunk/exec/cran2deb b/pkg/trunk/exec/cran2deb new file mode 100755 index 0000000..fc6c45c --- /dev/null +++ b/pkg/trunk/exec/cran2deb @@ -0,0 +1,94 @@ +#!/usr/bin/env r +library(cran2deb) +go <- function(name,extra_deps) { + dir <- setup() + pkg <- try((function() { + pkg <- prepare.new.debian(prepare.pkg(dir,name),extra_deps) + if (file.exists(changesfile(pkg$srcname,pkg$debversion))) { + message(paste('N: already built',pkg$srcname,'version',pkg$debversion)) + return(pkg) + } + + # delete the current archive (XXX: assumes mini-dinstall) + for (subdir in c('mini-dinstall','unstable')) { + path = file.path(dinstall_archive,subdir) + if (file.exists(path)) { + unlink(path,recursive=T) + } + } + + # delete notes of upload + 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)) + if (ret != 0) { + stop('failed to create archive') + } + + # pull in all the R dependencies + message(paste('N: dependencies:',paste(pkg$depends$r,collapse=', '))) + for (dep in pkg$depends$r) { + message(paste('N: uploading',dep)) + ret = system(paste('umask 022;dput','-c',shQuote(dput_config),'local' + ,changesfile(dep))) + if (ret != 0) { + stop('upload of dependency failed! maybe you did not build it first?') + } + } + build.debian(pkg) + + # upload the package + ret = system(paste('umask 022;dput','-c',shQuote(dput_config),'local' + ,changesfile(pkg$srcname,pkg$debversion))) + if (ret != 0) { + stop('upload failed!') + } + + return(pkg) + })()) + cleanup(dir) + if (inherits(pkg,'try-error')) { + stop(call.=F) + } + return(pkg) +} + +if (exists('argv')) { # check for littler + argc <- length(argv) + extra_deps = list() + extra_deps$deb = c() + extra_deps$r = c() + opts = c('-D','-R') + for (i in 1:argc) { + if (!(argv[i] %in% opts)) { + if (argc >= i) { + argv <- argv[i:argc] + } else { + argv <- list() + } + argc = argc - i + 1 + break + } + if (i == argc) { + message('E: missing argument') + q(save='no') + } + if (argv[i] == '-D') { + extra_deps$deb = c(extra_deps$deb,strsplit(chomp(argv[i+1]),',')[[1]]) + } + 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)) + } + } + if (argc == 0) { + message('E: usage: cran2deb [-D extra_dep1,extra_dep2,...] package package ...') + q(save='no') + } + 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) + } +} diff --git a/pkg/trunk/cranpkgs b/pkg/trunk/exec/cranpkgs similarity index 76% rename from pkg/trunk/cranpkgs rename to pkg/trunk/exec/cranpkgs index 8fbe81f..ba9e727 100755 --- a/pkg/trunk/cranpkgs +++ b/pkg/trunk/exec/cranpkgs @@ -1,8 +1,6 @@ #!/usr/bin/env r -root <- '/home/cb/work/gsoc/cran2deb' -# we cache the list of available packages -load(file.path(root,'var/cache/available.cache.Rd')) +library(cran2deb) if (length(argv) == 0) { writeLines(sample(dimnames(available)[[1]],800)) diff --git a/pkg/trunk/diagnose b/pkg/trunk/exec/diagnose similarity index 100% rename from pkg/trunk/diagnose rename to pkg/trunk/exec/diagnose diff --git a/pkg/trunk/diagnose_ctv b/pkg/trunk/exec/diagnose_ctv similarity index 100% rename from pkg/trunk/diagnose_ctv rename to pkg/trunk/exec/diagnose_ctv diff --git a/pkg/trunk/setup b/pkg/trunk/exec/setup similarity index 84% rename from pkg/trunk/setup rename to pkg/trunk/exec/setup index 03e441e..011bd12 100755 --- a/pkg/trunk/setup +++ b/pkg/trunk/exec/setup @@ -1,6 +1,6 @@ #!/usr/bin/rc umask 022 -root=`pwd +root=`{r -e 'library(cran2deb);cat(system.file('''',package=''cran2deb''),file=stdout())'} for (x in `{find etc -type f -name '*.in'}) { y=`{echo $x | sed -e 's,.in$,,'} sed -e 's:@ROOT@:'^$root^':g' <$x >$y diff --git a/pkg/trunk/update_available b/pkg/trunk/exec/update_available similarity index 77% rename from pkg/trunk/update_available rename to pkg/trunk/exec/update_available index cc99376..11df8b0 100755 --- a/pkg/trunk/update_available +++ b/pkg/trunk/exec/update_available @@ -7,4 +7,5 @@ available <- rbind(available,available.packages(contrib.url('http://www.biocondu message('updating list of available R task views...') library(ctv) ctv.available <- available.views(repo=mirror) -save(available, ctv.available, file='var/cache/available.cache.Rd',eval.promises=T) +library(cran2deb) +save(available, ctv.available, file=system.file('R/sysdata.rda',package='cran2deb'),eval.promises=T) diff --git a/pkg/trunk/etc/dput.cf.in b/pkg/trunk/inst/etc/dput.cf.in similarity index 100% rename from pkg/trunk/etc/dput.cf.in rename to pkg/trunk/inst/etc/dput.cf.in diff --git a/pkg/trunk/etc/hook/B90lintian b/pkg/trunk/inst/etc/hook/B90lintian similarity index 100% rename from pkg/trunk/etc/hook/B90lintian rename to pkg/trunk/inst/etc/hook/B90lintian diff --git a/pkg/trunk/etc/hook/B91dpkg-i b/pkg/trunk/inst/etc/hook/B91dpkg-i similarity index 100% rename from pkg/trunk/etc/hook/B91dpkg-i rename to pkg/trunk/inst/etc/hook/B91dpkg-i diff --git a/pkg/trunk/etc/hook/B92test-pkg b/pkg/trunk/inst/etc/hook/B92test-pkg similarity index 100% rename from pkg/trunk/etc/hook/B92test-pkg rename to pkg/trunk/inst/etc/hook/B92test-pkg diff --git a/pkg/trunk/etc/hook/D70aptupdate b/pkg/trunk/inst/etc/hook/D70aptupdate similarity index 100% rename from pkg/trunk/etc/hook/D70aptupdate rename to pkg/trunk/inst/etc/hook/D70aptupdate diff --git a/pkg/trunk/etc/mini-dinstall.conf.in b/pkg/trunk/inst/etc/mini-dinstall.conf.in similarity index 100% rename from pkg/trunk/etc/mini-dinstall.conf.in rename to pkg/trunk/inst/etc/mini-dinstall.conf.in diff --git a/pkg/trunk/etc/pbuilderrc.in b/pkg/trunk/inst/etc/pbuilderrc.in similarity index 100% rename from pkg/trunk/etc/pbuilderrc.in rename to pkg/trunk/inst/etc/pbuilderrc.in -- 2.39.5