fix repack to never repack

[cran2deb.git] / trunk / R / getrpkg.R

diff --git a/trunk/R/getrpkg.R b/trunk/R/getrpkg.R
index b5e990f0bcc856275672fb44e41bff53b8b4456a..266ee195a8cc7a3bd6044d8223ef18eed520aa56 100644 (file)
--- a/trunk/R/getrpkg.R
+++ b/trunk/R/getrpkg.R
@@ -1,3 +1,7 @@
+
+curl.maxtime<-60*60  # 60 minutes max download time (some bioconductor packages are truly big and take time)
+curl.retries<-0             # No retries (connections are commonly good enough)
+
 setup <- function() {
     # set up the working directory
     tmp <- tempfile('cran2deb')
@@ -11,7 +15,7 @@ cleanup <- function(dir) {
     invisible()
 }
 
-download_pkg <- function(dir, pkgname) {
+download_pkg <- function(dir, pkgname, repacking=0) {
     # download pkgname into dir, and construct some metadata
 
     # record some basic information
@@ -61,7 +65,9 @@ download_pkg <- function(dir, pkgname) {
             # dodgy network connections (hello BT 'OpenWorld', bad ISP)
             url <- paste(available[pkgname,'Repository'], fn, sep='/')
             # don't log the output -- we don't care!
-            ret <- system(paste('curl','-o',shQuote(archive),'-m 720 --retry 5',shQuote(url)))
+            ret <- system(paste('curl','-o',shQuote(archive),
+                          paste('-m',curl.maxtime,'--retry',curl.retries,sep=' '),
+                          shQuote(url)))
             if (ret != 0) {
                 fail('failed to download',url)
             }
@@ -76,7 +82,8 @@ download_pkg <- function(dir, pkgname) {
                       ,archive))
         pkg$archive = archive
         # this is not a Debian conformant archive
-        pkg$need_repack = TRUE
+        ## we basically should never repack
+        ## pkg$need_repack = TRUE
     }
     return(pkg)
 }
@@ -117,19 +124,9 @@ repack_pkg <- function(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
 
-    # 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.null(bundle)) {
-            fail('package',pkgname,'is unavailable')
-        }
-        pkgname <- bundle
-    }
-
     # grab the archive and some metadata
     pkg <- download_pkg(dir, pkgname)
 
@@ -148,6 +145,12 @@ prepare_pkg <- function(dir, pkgname) {
     # if necessary, repack the archive into Debian-conformant format
     if (pkg$need_repack) {
         pkg <- repack_pkg(pkg)
+    } else {
+        log_system('ln','-sf',shQuote(pkg$archive),
+                   shQuote(file.path(dirname(pkg$archive)
+                                     ,paste(pkg$srcname,'_'
+                                            ,pkg$version,'.orig.tar.gz'
+                                            ,sep=''))))
     }
     if (!file.info(pkg$path)[,'isdir']) {
         fail(pkg$path,'is not a directory and should be.')
@@ -167,10 +170,8 @@ prepare_pkg <- function(dir, pkgname) {
         }
     }
 
-    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)) {
+    if (pkg$description[1,'Package'] != pkg$name) {
         fail('package name mismatch')
     }
     return(pkg)