trunk/R/version.R

   1 version_new <- function(rver, debian_revision=1, debian_epoch=db_get_base_epoch(), verbose=FALSE) {
   2     if (verbose) {cat("rver:",rver," debian_revision:",debian_revision," debian_epoch:",debian_epoch,"\n")}
   3     # generate a string representation of the Debian version of an
   4     # R version of a package
   5     pkgver = rver
   6
   7     # ``Writing R extensions'' says that the version consists of at least two
   8     # non-negative integers, separated by . or -
   9     if (!length(grep('^([0-9]+[.-])+[0-9]+$',rver))) {
  10         fail(paste("Not a valid R package version: '",rver,"'",sep=""))
  11     }
  12
  13     # Debian policy says that an upstream version should start with a digit and
  14     # may only contain ASCII alphanumerics and '.+-:~'
  15     if (!length(grep('^[0-9][A-Za-z0-9.+:~-]*$',rver))) {
  16         fail('R package version',rver
  17                   ,'does not obviously translate into a valid Debian version.')
  18     }
  19
  20     # if rver contains a : then the Debian version must also have a colon
  21     if (debian_epoch == 0 && length(grep(':',pkgver)))
  22         debian_epoch = 1
  23
  24     # if the epoch is non-zero then include it
  25     if (debian_epoch != 0)
  26         pkgver = paste(debian_epoch,':',pkgver,sep='')
  27
  28     # always add the '-1' Debian release; nothing is lost and rarely will R
  29     # packages be Debian packages without modification.
  30     return(paste(pkgver,'-',version_suffix_step,version_suffix,debian_revision,sep=''))
  31 }
  32
  33 version_epoch <- function(pkgver) {
  34     # return the Debian epoch of a Debian package version
  35     if (!length(grep(':',pkgver)))
  36         return(0)
  37     return(as.integer(sub('^([0-9]+):.*$','\\1',pkgver)))
  38 }
  39 # version_epoch . version_new(x,y) = id
  40 # version_epoch(version_new(x,y)) = base_epoch
  41
  42 version_revision <- function(pkgver) {
  43     # return the Debian revision of a Debian package version
  44     return(as.integer(sub(paste('.*-([0-9]+',version_suffix,')?([0-9]+)$',sep=''),'\\2',pkgver)))
  45 }
  46 # version_revision . version_new(x) = id
  47 # version_revision(version_new(x)) = 1
  48
  49 version_upstream <- function(pkgver, verbose=FALSE) {
  50     if (verbose) {cat("version_upstream:"," pkgver:",pkgver,"\n")}
  51     # return the upstream version of a Debian package version
  52     return(sub('-[a-zA-Z0-9+.~]+$','',sub('^[0-9]+:','',pkgver)))
  53 }
  54 # version_upstream . version_new = id
  55
  56 version_update <- function(rver, prev_pkgver, prev_success, verbose=TRUE) {
  57     if (verbose) cat("version_update:"," rver:",rver," prev_pkgver:",prev_pkgver," prev_success:",prev_success,"\n")
  58     # return the next debian package version
  59     prev_rver <- version_upstream(prev_pkgver)
  60     if (prev_rver == rver) {
  61         # increment the Debian revision if the previous build was successful
  62         inc = 0
  63         if (prev_success) {
  64             inc = 1
  65         }
  66         return(version_new(rver
  67                           ,debian_revision = version_revision(prev_pkgver)+inc
  68                           ,debian_epoch    = version_epoch(prev_pkgver)
  69                           ))
  70     }
  71     # new release
  72     # TODO: implement Debian ordering over version and then autoincrement
  73     #       Debian epoch when upstream version does not increment.
  74     return(version_new(rver
  75                       ,debian_epoch = version_epoch(prev_pkgver)
  76                       ))
  77 }
  78
  79 new_build_version <- function(pkgname, verbose=FALSE) {
  80     cat("new_build_version: "," pkgname:",pkgname,"\n")
  81     if (!(pkgname %in% rownames(available))) {
  82         fail('tried to discover new version of',pkgname,'but it does not appear to be available')
  83     }
  84     db_ver <- db_latest_build_version(pkgname)
  85     if (verbose) {cat("db_ver: '",db_ver,"'\n",sep="")}
  86     db_succ <- db_latest_build_status(pkgname)[[1]]
  87     if (verbose) {cat("db_succ: '",db_succ,"'\n",sep="")}
  88     latest_r_ver <- available[pkgname,'Version']
  89     if (verbose) {cat("latest_r_ver: '",latest_r_ver,"'\n",sep="")}
  90     if (!is.null(db_ver)) {
  91         return(version_update(latest_r_ver, db_ver, db_succ))
  92     }
  93     return(version_new(latest_r_ver))
  94 }
  95