#!/usr/bin/env r

use_pbuilder <- 1
pbuilder_results <- '/var/cache/pbuilder/result'

version.new <- function(rver,debian_revision=1, debian_epoch=0) {
    # generate a string representation of the Debian version of an
    # R version of a package
    pkgver = rver

    # ``Writing R extensions'' says that the version consists of at least two
    # non-negative integers, separated by . or -
    if (!length(grep('^([0-9]+[.-])+[0-9]+$',rver))) {
        stop(paste('Not a valid R package version',rver))
    }

    # Debian policy says that an upstream version should start with a digit and
    # may only contain ASCII alphanumerics and '.+-:~'
    if (!length(grep('^[0-9][A-Za-z0-9.+:~-]*$',rver))) {
        stop(paste('R package version',rver
                  ,'does not obviously translate into a valid Debian version.'))
    }

    # if rver contains a : then the Debian version must also have a colon
    if (debian_epoch == 0 && length(grep(':',pkgver)))
        debian_epoch = 1

    # if the epoch is non-zero then include it
    if (debian_epoch != 0)
        pkgver = paste(debian_epoch,':',pkgver,sep='')

    # always add the '-1' Debian release; nothing is lost and rarely will R
    # packages be Debian packages without modification.
    return(paste(pkgver,'-',debian_revision,sep=''))
}

version.epoch <- function(pkgver) {
    # return the Debian epoch of a Debian package version
    if (!length(grep(':',pkgver)))
        return(0)
    return(as.integer(sub('^([0-9]+):.*','\\1',pkgver)))
}
# version.epoch . version.new(x,y) = id
# version.epoch(version.new(x,y)) = 0

version.revision <- function(pkgver) {
    # return the Debian revision of a Debian package version
    return(as.integer(sub('.*-([0-9]+)$','\\1',pkgver)))
}
# version.revision . version.new(x) = id
# version.revision(version.new(x)) = 1

version.upstream <- function(pkgver) {
    # return the upstream version of a Debian package version
    return(sub('-[0-9]+$','',sub('^[0-9]+:','',pkgver)))
}
# version.upstream . version.new = id

version.update <- function(rver, prev_pkgver) {
    prev_rver <- version.upstream(prev_pkgver)
    if (prev_rver == rver) {
        # increment the Debian revision
        return(version.new(rver
                          ,debian_revision = version.revision(prev_pkgver)+1
                          ,debian_epoch    = version.epoch(prev_pkgver)
                          ))
    }
    # new release
    # TODO: implement Debian ordering over version and then autoincrement
    #       Debian epoch when upstream version does not increment.
    return(version.new(rver
                      ,debian_epoch = version.epoch(prev_pkgver)
                      ))
}

setup <- function() {
    tmp <- tempfile('cran2deb')
    dir.create(tmp)
    return (tmp)
}

cleanup <- function(dir) {
    unlink(dir,recursive=T)
    invisible()
}

prepare.pkg <- function(dir, pkgname,repo='cran',repoURL='http://cran.uk.r-project.org/') {
    # based loosely on library/utils/R/packages2.R::install.packages
    # should do nothing Debian specific
    archive <- download.packages(pkgname, dir, repos=repoURL, type="source")[1,2]
    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 {
        stop(paste('Type of archive',archive,'is unknown.'))
    }
    ret = system(cmd)
    setwd(wd)
    if (ret != 0) {
        stop(paste('Extraction of archive',archive,'failed.'))
    }
    pkg <- pairlist()
    pkg$name = pkgname
    pkg$archive = archive
    pkg$path = sub("_\\.(zip|tar\\.gz)", ""
                  ,gsub(.standard_regexps()$valid_package_version, ""
                  ,archive))
    pkg$description = read.dcf(paste(pkg$path,'DESCRIPTION',sep='/'))
    pkg$repo = repo
    pkg$repoURL = repoURL
    pkg$version = pkg$description[1,'Version']
    # TODO: re-pack into a Debian-named archive with a Debian-named directory.
    return(pkg)
}

debian_ok_licenses=c('GPL','LGPL','AGPL','ARTISTIC','UNLIMITED','BSD')

is_acceptable_license <- function(license) {
    # compress spaces into a single space
    license = gsub('[[:space:]]+',' ',license)
    # make all characters upper case
    license = toupper(license)
    # don't care about versions of licenses
    license = chomp(sub('\\([<=>!]+[[:space:]]*[0-9.]+\\)',''
                    ,sub('-[0-9.]+','',license)))
    if (license %in% debian_ok_licenses) {
        return(T)
    }
    # remove all punctuation
    license = gsub('[[:punct:]]+','',license)
    # remove everything that looks like a version specification
    license = gsub('(VERSION|V)? *[0-9.]+ *(OR *(LATER|NEWER))?',''
                   ,license)
    # remove any extra space
    license = chomp(gsub('[[:space:]]+',' ',license))
    if (license %in% debian_ok_licenses) {
        message(paste('W: Accepted wild license as',license,'. FIX THE PACKAGE!'))
        return(T)
    }
    # TODO: put debian_ok_licenses in DB
    # TODO: file {LICENSE,LICENCE} (+ maybe COPYING?)
    message(paste('E: Wild license',license,'did not match'))
    return(F)
}

chomp <- function(x) {
    return(sub('^[[:space:]]+','',sub('[[:space:]]+$','',x)))
}

host.arch <- function() {
    system('dpkg-architecture -qDEB_HOST_ARCH',intern=T)
}

prepare.new.debian <- function(pkg) {
    maintainer = 'cran2deb buildbot <cran2deb@example.org>'

    # generate Debian version and name
    pkg$debversion = version.new(pkg$version)
    if (!length(grep('^[A-Za-z0-9][A-Za-z0-9+.-]+$',pkg$name))) {
        stop(paste('Cannot convert package name into a Debian name',pkg$name))
    }
    pkg$srcname = tolower(pkg$name)
    pkg$debname = paste('r',tolower(pkg$repo),pkg$srcname,sep='-')

    # rename package into something Debian-friendly
    if (!length(grep('\\.tar\\.gz',pkg$archive))) {
        stop('archive is not tarball')
    }
    debarchive= paste(dirname(pkg$archive),'/'
                             ,pkg$srcname,'_'
                             ,pkg$version,'.orig.tar.gz'
                             ,sep='')
    file.rename(pkg$archive, debarchive)
    pkg$archive = debarchive

    # make the debian/ directory
    debdir <- paste(pkg$path,'debian',sep='/')
    debfile <- function(x) { paste(debdir,x,sep='/') }
    unlink(debdir,recursive=T)
    dir.create(debdir)

    # check the license
    if (!('License' %in% names(pkg$description[1,]))) {
        stop('package has no License: field in description!')
    }
    accept=NULL
    for (license in strsplit(chomp(pkg$description[1,'License'])
                            ,'[[:space:]]*\\|[[:space:]]*')[[1]]) {
        if (is_acceptable_license(license)) {
            accept=license
            break
        }
    }
    if (is.null(accept)) {
        stop(paste('No acceptable license:',pkg$description[1,'License']))
    } else {
        message(paste('N: Auto-accepted license',accept))
    }
    if (accept == 'Unlimited') {
        # definition of Unlimited from ``Writing R extensions''
        accept=paste('Unlimited (no restrictions on distribution or'
                    ,'use other than those imposed by relevant laws)')
    }

    # construct a dummy changelog
    # TODO: ``Writing R extensions'' mentions that a package may also have
    # {NEWS,ChangeLog} files.
    cat(paste(paste(pkg$srcname,' (',pkg$debversion,') unstable; urgency=low',sep='')
             ,'' ,'  * Initial release.',''
             ,paste(' --',maintainer,'',format(Sys.time(),'%a, %d %b %Y %H:%M:%S %z'))
             ,'',sep='\n'),file=debfile('changelog.in'))
    cat(paste('#!/usr/bin/make -f'
             ,'include /usr/share/R/debian/r-cran.mk'
             ,'',sep='\n')
       ,file=debfile('rules'))
    Sys.chmod(debfile('rules'),'0700')

    # generate copyright file; we trust DESCRIPTION
    writeLines(strwrap(
        paste('This Debian package of the GNU R package',pkg$name
             ,'was generated automatically using cran2deb by'
             ,paste(maintainer,'.',sep='')
             ,''
             ,'The original GNU R package is Copyright (C) '
             # TODO: copyright start date, true copyright date
             ,format(Sys.time(),'%Y')
             ,pkg$description[1,'Author']
             ,'and possibly others.'
             ,''
             ,'The original GNU R package is maintained by'
             ,pkg$description[1,'Maintainer'],'and was obtained from:'
             ,''
             ,pkg$repoURL
             ,''
             ,''
             ,'The GNU R package DESCRIPTION offers a'
             ,'Copyright licenses under the terms of the',accept
             ,'license.  On a Debian GNU/Linux system, common'
             ,'licenses are included in the directory'
             ,'/usr/share/common-licenses/.'
             ,''
             ,'The DESCRIPTION file for the original GNU R package '
             ,'can be found in '
             ,paste('/usr/lib/R/site-library'
                   ,pkg$debname
                   ,'DESCRIPTION'
                   ,sep='/')
             ,sep='\n'), width=72), con=debfile('copyright.in'))

    # see if this is an architecture-dependent package.
    # heuristic: if /src/ exists in pkg$path, then this is an
    #            architecture-dependent package.
    # CRAN2DEB.pm is a bit fancier about this but ``Writing R extensions''
    # says: ``The sources and headers for the compiled code are in src, plus
    # optionally file Makevars or Makefile.'' It seems unlikely that
    # architecture independent code would end up here.
    pkg$archdep = file.exists(paste(pkg$path,'src',sep='/'))
    pkg$arch <- 'all'
    if (pkg$archdep) {
        pkg$arch <- host.arch()
    }

    # construct control file
    shlibdep = ''
    if (pkg$archdep) {
        shlibdep = '${shlibs:Depends}'
    }
    control = data.frame()
    control[1,'Source'] = pkg$srcname
    control[1,'Section'] = 'math'
    control[1,'Priority'] = 'optional'
    control[1,'Maintainer'] = maintainer
    control[1,'Build-Depends'] = paste('debhelper (>> 4.1.0)'
                                      ,'r-base-dev (>= 2.7.0)'
                                      ,'cdbs'
                                      ,sep=', ')
    control[1,'Standards-Version'] = '3.7.3.0'

    control[2,'Package'] = pkg$debname
    control[2,'Architecture'] = 'all'
    if (pkg$archdep) {
        control[2,'Architecture'] = 'any'
    }
    control[2,'Depends'] = paste('r-base-core', shlibdep, sep=', ')
    descr = 'GNU R package "'
    if ('Title' %in% colnames(pkg$description)) {
        descr = paste(descr,pkg$description[1,'Title'],sep='')
    } else {
        descr = paste(descr,pkg$name,sep='')
    }
    control[2,'Description'] = paste(descr,'"\n'
                                    ,pkg$description[1,'Description']
                                    ,sep='')
    # Debian policy says 72 char width; indent minimally
    write.dcf(control,file=debfile('control.in'),indent=1,width=72)
    # TODO: debian/watch

    # convert text to utf8 (who knows what the original character set is --
    # let's hope iconv DTRT).
    for (file in c('control','changelog','copyright')) {
        system(paste('iconv -o ',shQuote(debfile(file))
                    ,' -t utf8 '
                    ,shQuote(debfile(paste(file,'in',sep='.')))))
    }
    return(pkg)
}

build.debian <- function(pkg) {
    wd <- getwd()
    setwd(pkg$path)
    message(paste('N: building Debian package'
                 ,pkg$debname
                 ,paste('(',pkg$debversion,')',sep='')
                 ,'...'))
    if (use_pbuilder) {
        # resulting files are in
        # /var/cache/pbuilder/result/
        ret = system('pdebuild')
    } else {
        # results not kept
        ret = system('debuild -us -uc -b')
    }
    setwd(wd)
    if (ret != 0) {
        stop('Failed to build package.')
    }
}


go <- function(name) {
    dir <- setup()
    pkg <- try((function() {
        pkg <- prepare.new.debian(prepare.pkg(dir,name))
        build.debian(pkg)
        message('N: running lintian')
        upfiles=c(
                paste(pkg$srcname,'_',pkg$debversion,'.dsc',sep='')
               ,paste(pkg$srcname,'_',pkg$debversion,'_',host.arch(),'.changes',sep='')
               ,paste(pkg$debname,'_',pkg$debversion,'_',pkg$arch,'.deb',sep=''))
        if (use_pbuilder) {
            rp = pbuilder_results
        } else {
            rp = paste(pkg$path,'/..',sep='')
        }
        for (file in upfiles) {
            ret = system(paste('lintian -v ',rp,'/',file,sep=''))
            if (ret != 0) {
                break
            }
        }
        message('N: lintian done')
        if (ret != 0) {
            stop('lintian failed!')
        }
        return(pkg)
    })())
    cleanup(dir)
    if (inherits(pkg,'try-error')) {
        stop(call.=F)
    }
    return(pkg)
}

if (exists('argv')) { # check for littler
    for (arg in argv) {
        go(arg)
    }
}