;;;
;;; gauche.package.build - build a package
;;;  
;;;   Copyright (c) 2004-2007  Shiro Kawai  <shiro@acm.org>
;;;   
;;;   Redistribution and use in source and binary forms, with or without
;;;   modification, are permitted provided that the following conditions
;;;   are met:
;;;   
;;;   1. Redistributions of source code must retain the above copyright
;;;      notice, this list of conditions and the following disclaimer.
;;;  
;;;   2. Redistributions in binary form must reproduce the above copyright
;;;      notice, this list of conditions and the following disclaimer in the
;;;      documentation and/or other materials provided with the distribution.
;;;  
;;;   3. Neither the name of the authors nor the names of its contributors
;;;      may be used to endorse or promote products derived from this
;;;      software without specific prior written permission.
;;;  
;;;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;;;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;;;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;;;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;;;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;;;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;;;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;;;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;  
;;;  $Id: build.scm,v 1.11 2007/03/02 07:39:09 shirok Exp $
;;;

;; *EXPERIMENTAL*
;; gauche.package.build module is intended to automate standard building
;; process (untar+configure+make+make install).

(define-module gauche.package.build
  (use srfi-1)
  (use gauche.package)
  (use gauche.package.util)
  (use gauche.package.fetch)
  (use gauche.parameter)
  (use file.util)
  (use util.list)
  (export gauche-package-build))
(select-module gauche.package.build)

;; Default programs
(define *cat-program*   (find-file-in-paths "cat"))
(define *tar-program*   (find-file-in-paths "tar"))
(define *gzip-program*  (find-file-in-paths "gzip"))
(define *bzip2-program* (find-file-in-paths "bzip2"))
(define *make-program*  (or (find-file-in-paths "gmake")
                            (find-file-in-paths "make")))
(define *sudo-program*  (find-file-in-paths "sudo"))
(define *rm-program*    (find-file-in-paths "rm"))

(define (untar config file)
  (let ((build-dir (assq-ref config 'build-dir "."))
        (cat   (assq-ref config 'cat   *cat-program*))
        (tar   (assq-ref config 'tar   *tar-program*))
        (gzip  (assq-ref config 'gzip  *gzip-program*))
        (bzip2 (assq-ref config 'bzip2 *bzip2-program*)))
    (rxmatch-case (sys-basename file)
      (#/(?:\.tar\.gz|\.tgz|\.taz)$/ (#f)
       (run #`"\",cat\" \",file\" | \",gzip\" -d | \",tar\" xfC - \",build-dir\""))
      (#/(?:\.tar\.bz|\.tar\.bz2|\.tbz|\.tbz2)$/ (#f)
       (run #`"\",cat\" \",file\" | \",bzip2\" -d | \",tar\" xfC - \",build-dir\""))
      (#/\.tar$/ (#f)
       (run #`"\",tar\" xfC \",file\" \",build-dir\""))
      (else
       (error "can't decide the package format of " file)))))

(define (tarball->package-directory file)
  (cond
   ((#/(.*)(?:\.tar\.gz|\.tgz|\.taz|\.tar\.bz|\.tar\.bz2|\.tbz|\.tbz2|\.tar)$/
       (sys-basename file))
    => (lambda (m) (m 1)))
   (else
    (error "can't determine package directory from tarball " file))))

;; when reconfiguring, give package name.
(define (configure config dir package-name configure-options)
  (let1 conf-cmd
      (cond
       (configure-options #`"./configure ,configure-options")
       ((and-let* ((package-name)
                   (gpd (find-gauche-package-description package-name)))
          (ref gpd 'configure)))
       (else "./configure"))
    (run #`"cd \",dir\"; ,conf-cmd")))

(define (make config dir)
  (let ((make (assq-ref config 'make *make-program*)))
    (run #`"cd \",dir\"; \",make\"")))

(define (make-check config dir)
  (let ((make (assq-ref config 'make *make-program*)))
    (run #`"cd \",dir\"; \",make\" check")))

(define (make-install config dir sudo-user sudo-pass)
  (let ((make (assq-ref config 'make *make-program*))
        (sudo (assq-ref config 'sudo *sudo-program*)))
    (if sudo-user
      (run #`"cd \",dir\"; \",sudo\" -u \",sudo-user\" -S \",make\" install"
           :stdin-string sudo-pass)
      (run #`"cd \",dir\"; \",make\" install"))))

(define (clean config dir)
  (let ((rm (assq-ref config 'rm *rm-program*)))
    (run #`"\",rm\" -rf \",dir\"")))

;; extracting package name from directory name (PACKAGE-VERSION)
(define (package-name basename)
  (let1 s (string-split basename #\-)
    (when (or (null? s) (null? (cdr s)))
      (error "weird package directory name:" basename))
    (string-join (drop-right s 1) "-")))

;; get reconfigure options
(define (get-reconf-options package)
  (and-let* ((gpd (find-gauche-package-description package :all-versions #t)))
    (string-scan (ref gpd 'configure) #\space 'after)))

;;;
;;; Driver
;;;

(define (gauche-package-build uri . opts)
  (let-keywords opts ((config  '())
                      (configure-options #f)
                      (install-only? :install-only #f)
                      (dry?          :dry-run #f)
                      (reconfigure?  :reconfigure #f)
                      (check?        :check #t)
                      (install?      :install #f)
                      (clean?        :clean #f)
                      (sudo-user     :sudo-install #f)
                      (sudo-pass     :sudo-password #f))
    (parameterize ((dry-run dry?))
      (let* ((tarball   (gauche-package-ensure uri :config config))
             (build-dir (assq-ref config 'build-dir "."))
             (basename  (tarball->package-directory tarball))
             (dir       (build-path build-dir basename))
             (packname  (package-name basename)))
        (when (and sudo-user (not sudo-pass))
          (set! sudo-pass (get-password)))
        (unless install-only?
          (clean config dir)
          (untar config tarball)
          (configure config dir packname
                     (or configure-options
                         (and reconfigure?
                              (get-reconf-options packname))))
          (make config dir)
          (when check?   (make-check config dir)))
        (when (or install? install-only?)
          (make-install config dir sudo-user sudo-pass))
        (when clean?   (clean config dir))))))

(provide "gauche/package/build")
