pkg: push more of the responsibility for the source archive into getrpkg.

in particular this allows us to use a previous source archive for a new
build of the same upstream version.  the factorisation is much simpler
this way too.

git-svn-id: svn://svn.r-forge.r-project.org/svnroot/cran2deb@114 edb9625f-4e0d-4859-8d74-9fd3b1da38cb

diff --git a/pkg/trunk/R/debianpkg.R b/pkg/trunk/R/debianpkg.R
index a4f8d04eec33fc376dd67ed33f55ad8ee18f5cbd..017dbfab234cc6da956d77d63aae8c6f17e26008 100644 (file)
--- a/pkg/trunk/R/debianpkg.R
+++ b/pkg/trunk/R/debianpkg.R
@@ -75,47 +75,7 @@ generate_copyright <- function(pkg) {
 
 prepare_new_debian <- function(pkg,extra_deps) {
     # generate Debian version and name
-    pkg$date_stamp = format(Sys.time(),'%a, %d %b %Y %H:%M:%S %z')
-    pkg$repo = repourl_as_debian(pkg$repoURL)
-    if (pkg$version != available[pkg$name,'Version']) {
-        # should never happen since available is the basis upon which the
-        # package is retrieved.
-        error('available version:',available[pkg$name,'Version'])
-        error('package version:',pkg$version)
-        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))) {
-        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))) {
-        fail('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
-    log_system('find',shQuote(basename(pkg$path))
-                ,'-type f -exec chmod -x {} \\;')
-    # tar it all back up
-    log_system('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')
@@ -154,8 +114,6 @@ prepare_new_debian <- function(pkg,extra_deps) {
     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')) {

diff --git a/pkg/trunk/R/getrpkg.R b/pkg/trunk/R/getrpkg.R
index 90e266d477f71ad85bc495eaeaa6e4db5c6750c2..3c7e0af2cfb5b02f023a50bf5262ebc5bf43ab9e 100644 (file)
--- a/pkg/trunk/R/getrpkg.R
+++ b/pkg/trunk/R/getrpkg.R
@@ -1,4 +1,3 @@
-
 setup <- function() {
     # set up the working directory
     tmp <- tempfile('cran2deb')
@@ -12,12 +11,94 @@ cleanup <- function(dir) {
     invisible()
 }
 
+download_pkg <- function(dir, pkgname) {
+    # download pkgname into dir, and construct some metadata
+
+    # record some basic information
+    pkg <- pairlist()
+    pkg$date_stamp = format(Sys.time(),'%a, %d %b %Y %H:%M:%S %z')
+    pkg$name = pkgname
+    pkg$repoURL = available[pkgname,'Repository']
+    pkg$repo = repourl_as_debian(pkg$repoURL)
+    if (!length(grep('^[A-Za-z0-9][A-Za-z0-9+.-]+$',pkg$name))) {
+        fail('Cannot convert package name into a Debian name',pkg$name)
+    }
+    pkg$srcname = pkgname_as_debian(pkg$name,binary=F)
+    pkg$debname = pkgname_as_debian(pkg$name,repo=pkg$repo)
+    pkg$version <- available[pkgname,'Version']
+
+    # see if we have already built this release and uploaded it.
+    debfn <- file.path(pbuilder_results, paste(pkg$srcname, '_', pkg$version, '.orig.tar.gz', sep=''))
+    pkg$need_repack = FALSE
+    if (file.exists(debfn)) {
+        # if so, use the existing archive. this is good for three reasons:
+        # 1. it saves downloading the archive again
+        # 2. the repacking performed below changes the MD5 sum of the archive
+        #    which upsets some Debian archive software.
+        # 3. why repack more than once?
+        pkg$archive <- file.path(dir, basename(debfn))
+        file.copy(debfn,pkg$archive)
+        pkg$path = file.path(dir, paste(pkg$srcname ,pkg$version ,sep='-'))
+    } else {
+        # use this instead of download.packages as it is more resilient to
+        # dodgy network connections (hello BT 'OpenWorld', bad ISP)
+        fn <- paste(pkgname, '_', pkg$version, '.tar.gz', sep='')
+        url <- paste(available[pkgname,'Repository'], fn, sep='/')
+        archive <- file.path(dir, fn)
+        # don't log the output -- we don't care!
+        ret <- system(paste('curl','-o',shQuote(archive),'-m 720 --retry 5',shQuote(url)))
+        if (ret != 0) {
+            fail('failed to download',url)
+        }
+        # end of download.packages replacement
+
+        if (length(grep('\\.\\.',archive)) || normalizePath(archive) != archive) {
+            fail('funny looking path',archive)
+        }
+        pkg$path = sub("_\\.(zip|tar\\.gz)", ""
+                      ,gsub(.standard_regexps()$valid_package_version, ""
+                      ,archive))
+        pkg$archive = archive
+        # this is not a Debian conformant archive
+        pkg$need_repack = TRUE
+    }
+    return(pkg)
+}
+
+repack_pkg <- function(pkg) {
+    # 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
+    # BUT EXCLUDE configure and cleanup
+    log_system('find',shQuote(basename(pkg$path))
+                ,'-type f -a '
+                ,   '! \\( -name configure -o -name cleanup \\)'
+                ,'-exec chmod -x {} \\;')
+    # tar it all back up
+    log_system('tar -czf',shQuote(debarchive),shQuote(basename(pkg$path)))
+    setwd(wd)
+    file.remove(pkg$archive)
+    pkg$archive = debarchive
+    pkg$need_repack = FALSE
+    return(pkg)
+}
+
 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))) {
@@ -27,47 +108,44 @@ prepare_pkg <- function(dir, pkgname) {
         }
         pkgname <- bundle
     }
-    # use this instead of download.packages as it is more resilient to
-    # dodgy network connections (hello BT 'OpenWorld', bad ISP)
-    fn <- paste(pkgname, '_', available[pkgname,'Version'], '.tar.gz', sep='')
-    url <- paste(available[pkgname,'Repository'], fn, sep='/')
-    archive <- file.path(dir, fn)
-    # don't log the output -- we don't care!
-    ret <- system(paste('curl','-o',shQuote(archive),'-m 720 --retry 5',shQuote(url)))
-    if (ret != 0) {
-        fail('failed to download',url)
-    }
-    # end of download.packages replacement
-#    archive <- download.packages(pkgname, dir, available=available, repos='', type="source")[1,2]
-    if (length(grep('\\.\\.',archive)) || normalizePath(archive) != archive) {
-        fail('funny looking path',archive)
+
+    # grab the archive and some metadata
+    pkg <- download_pkg(dir, pkgname)
+
+    # now extract the archive
+    if (!length(grep('\\.tar\\.gz',pkg$archive))) {
+        fail('archive is not tarball')
     }
     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 {
-        fail('Type of archive',archive,'is unknown.')
-    }
-    ret = log_system(cmd)
+    ret = log_system('tar','xzf',shQuote(pkg$archive))
     setwd(wd)
     if (ret != 0) {
-        fail('Extraction of archive',archive,'failed.')
+        fail('Extraction of archive',pkg$archive,'failed.')
+    }
+
+    # if necessary, repack the archive into Debian-conformant format
+    if (pkg$need_repack) {
+        pkg <- repack_pkg(pkg)
     }
-    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']) {
         fail(pkg$path,'is not a directory and should be.')
     }
+
+    # extract the DESCRIPTION file, which contains much metadata
     pkg$description = read.dcf(file.path(pkg$path,'DESCRIPTION'))
-    pkg$repoURL = available[pkgname,'Repository']
-    pkg$version = pkg$description[1,'Version']
+
+    # ensure consistency of version numbers
+    if ('Version' %in% names(pkg$description[1,])) {
+        if (pkg$description[1,'Version'] != available[pkg$name,'Version']) {
+            # should never happen since available is the basis upon which the
+            # package is retrieved.
+            error('available version:',available[pkg$name,'Version'])
+            error('package version:',pkg$description[1,'Version'])
+            fail('inconsistency between R package version and cached R 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) ||