X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=branch%2Fpatch%2FR%2Fgetrpkg.R;fp=branch%2Fpatch%2FR%2Fgetrpkg.R;h=0000000000000000000000000000000000000000;hb=21489018a9c733dc99bb8899ef53088166d0f189;hp=5273a1fc601124da080b5dfe00c6061d06e905c5;hpb=49b44dc25b2664f0b2cbbed14a444d77c4d0ca07;p=cran2deb.git diff --git a/branch/patch/R/getrpkg.R b/branch/patch/R/getrpkg.R deleted file mode 100644 index 5273a1f..0000000 --- a/branch/patch/R/getrpkg.R +++ /dev/null @@ -1,172 +0,0 @@ -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() -} - -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 { - # see if we have a local mirror in /srv/R - use_local = FALSE - if (pkg$repo == 'cran') { - localfn = file.path('/srv/R/Repositories/CRAN/src/contrib',paste(pkg$name,'_',pkg$version,'.tar.gz',sep='')) - use_local = file.exists(localfn) - } else if (pkg$repo == 'bioc') { - localfn = file.path('/srv/R/Repositories/Bioconductor/release/bioc/src/contrib',paste(pkg$name,'_',pkg$version,'.tar.gz',sep='')) - use_local = file.exists(localfn) - } - - fn <- paste(pkgname, '_', pkg$version, '.tar.gz', sep='') - archive <- file.path(dir, fn) - - if (use_local) { - file.copy(localfn, archive) - } else { - # use this instead of download.packages as it is more resilient to - # 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))) - 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 - - # 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) - - # now extract the archive - if (!length(grep('\\.tar\\.gz',pkg$archive))) { - fail('archive is not tarball') - } - wd <- getwd() - setwd(dir) - ret = log_system('tar','xzf',shQuote(pkg$archive)) - setwd(wd) - if (ret != 0) { - fail('Extraction of archive',pkg$archive,'failed.') - } - - # if necessary, repack the archive into Debian-conformant format - if (pkg$need_repack) { - pkg <- repack_pkg(pkg) - } - 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')) - - # 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) || - ( pkg$is_bundle && pkg$description[1,'Bundle'] != pkg$name)) { - fail('package name mismatch') - } - return(pkg) -} -