pkg/trunk/R/getrpkg.R

   1
   2 setup <- function() {
   3     # set up the working directory
   4     tmp <- tempfile('cran2deb')
   5     dir.create(tmp)
   6     return (tmp)
   7 }
   8
   9 cleanup <- function(dir) {
  10     # remove the working directory
  11     unlink(dir,recursive=T)
  12     invisible()
  13 }
  14
  15 prepare_pkg <- function(dir, pkgname) {
  16     # download and extract an R package named pkgname
  17     # OR the bundle containing pkgname
  18
  19     # based loosely on library/utils/R/packages2.R::install.packages
  20     # should do nothing Debian specific
  21
  22     # first a little trick; change pkgname if pkgname is contained in a bundle
  23     if (!(pkgname %in% rownames(available))) {
  24         bundle <- r_bundle_of(pkgname)
  25         if (is.na(bundle)) {
  26             fail('package',pkgname,'is unavailable')
  27         }
  28         pkgname <- bundle
  29     }
  30     # use this instead of download.packages as it is more resilient to
  31     # dodgy network connections (hello BT 'OpenWorld', bad ISP)
  32     fn <- paste(pkgname, '_', available[pkgname,'Version'], '.tar.gz', sep='')
  33     url <- paste(available[pkgname,'Repository'], fn, sep='/')
  34     archive <- file.path(dir, fn)
  35     # don't log the output -- we don't care!
  36     ret <- system(paste('curl','-o',shQuote(archive),'-m 60 --retry 5',shQuote(url)))
  37     if (ret != 0) {
  38         fail('failed to download',url)
  39     }
  40     # end of download.packages replacement
  41 #    archive <- download.packages(pkgname, dir, available=available, repos='', type="source")[1,2]
  42     if (length(grep('\\.\\.',archive)) || normalizePath(archive) != archive) {
  43         fail('funny looking path',archive)
  44     }
  45     wd <- getwd()
  46     setwd(dir)
  47     if (length(grep('\\.zip$',archive))) {
  48         cmd = paste('unzip',shQuote(archive))
  49     } else if (length(grep('\\.tar\\.gz$',archive))) {
  50         cmd = paste('tar','xzf',shQuote(archive))
  51     } else {
  52         fail('Type of archive',archive,'is unknown.')
  53     }
  54     ret = log_system(cmd)
  55     setwd(wd)
  56     if (ret != 0) {
  57         fail('Extraction of archive',archive,'failed.')
  58     }
  59     pkg <- pairlist()
  60     pkg$name = pkgname
  61     pkg$archive = archive
  62     pkg$path = sub("_\\.(zip|tar\\.gz)", ""
  63                   ,gsub(.standard_regexps()$valid_package_version, ""
  64                   ,archive))
  65     if (!file.info(pkg$path)[,'isdir']) {
  66         fail(pkg$path,'is not a directory and should be.')
  67     }
  68     pkg$description = read.dcf(file.path(pkg$path,'DESCRIPTION'))
  69     pkg$repoURL = available[pkgname,'Repository']
  70     pkg$version = pkg$description[1,'Version']
  71     pkg$is_bundle = 'Bundle' %in% names(pkg$description[1,])
  72     # note subtly of short circuit operators (no absorption)
  73     if ((!pkg$is_bundle && pkg$description[1,'Package'] != pkg$name) ||
  74         ( pkg$is_bundle && pkg$description[1,'Bundle'] != pkg$name)) {
  75         fail('package name mismatch')
  76     }
  77     return(pkg)
  78 }
  79