;; $Id: deb.jl,v 1.8 2002/09/24 19:34:19 hip Exp $
;; rep verion of deb
(require 'stdlib)

(define status-file "/var/lib/dpkg/status")
(define cache "deb.cache")
;; pool structure:
;; ((package-name (version "1.2") (depends (x y z)))
;;  (package-name (version "1.2") (depends (x y z))))
(define pool '(packages))

(define (pool-size)
  (length (rest pool)))

(define (pool-reset)
  (setq pool '(packages)))

;;----------------------------------------------------------------------
;; pool test
;;(define pool
;;  '((sawfish (version "1.1") (depends (a b c)))
;;    (librep (version "2.3") (section libs))))

(define (package-add package)
  (nconc pool (list (list package))))

(define (package-record package)
  (assoc package pool))

(define (package-attr package attribute)
  (second (assoc attribute (rest (package-record package)))))

(define (package-add-attr package attribute value)
  (nconc (package-record package) (list (list attribute value))))

;;(puts (package-record 'sawfish))
;;(puts (package-attr 'sawfish 'version))
;;(package-add-attr 'sawfish 'test "42")
;;(puts (package-record 'sawfish))
;;(puts (package-attr 'sawfish 'test))
;;(package-add 'foo)
;;(package-add-attr 'foo 'test 32)
;;(puts pool)
;;----------------------------------------------------------------------

;; TODO move these into stdlib
(define (peek . form)
  (printf ";;; %s\n" form)
  (last form))

(define (read-pool)
  (define (split-depends txt)
    ;; FIXME handle more intricate cases
    (let ((deps (string-split ",\\s*" txt)))
      (mapcar (lambda (dep)
                (if (string-match "(.*?) \\((.*?) (.*?)\\)" dep)
                    (list (sym (expand-last-match "\\1"))
                          (sym (expand-last-match "\\2"))
                          (expand-last-match "\\3"))
                  (list (sym dep) (sym "=") "*")))
              deps)))

  (define (sym name)
    ;; TODO make own OBARRAY?
    (intern name))

  (define (parse-package record)
    (let ((result '()))
      (define (add field)
        (nconc result (list field)))
      (dolist (line (string-split "\n" record))
        (when (string-match "^(\\w+): (.*)$" line)
          (let ((attr (sym (expand-last-match "\\1")))
                (value (expand-last-match "\\2")))
            (case attr
              ((Package) (setq result (list (sym value))))
              ;; FIXME 3 elements
              ;;(add `((status ,(string-split " " value)))))
              ((Status) (add `(status ,value)))
              ((Priority) (add `(priority ,(sym value))))
              ;; FIXME split on possible /'s
              ((Section) (add `(section ,(sym value))))
              ((Installed-Size) (add `(installed-size ,value)))
              ((Maintainer) (add `(maintainer ,value)))
              ((Source) (add `(source ,value)))
              ((Version) (add `(version ,value)))
              ((Provides) (add `(provides ,@(string-split ",\\s*" value))))
              ((Recommends) (add `(recommends ,value)))
              ((Suggests) (add `(suggests ,value)))
              ((Conflicts) (add `(conflicts ,value)))
              ((Essential) (add `(essential ,value)))
              ((Conffiles) (add `(conffiles ,value)))
              ((Replaces) (add `(replaces ,value)))
              ((Depends) (add `(depends ,@(split-depends value))))
              ((Description) (add `(description ,value)))
              (t (add `(UNKNOWN ,value)))
              ))))
      result))

  (let* ((f (open-file status-file 'read))
         (fsize (file-size status-file))
         (rawtext (read-chars f fsize))
         (records (string-split "\n\n" rawtext)))
    (close-file f)
    (time
     (dolist (lines records)
       (let ((rec (parse-package lines)))
         (when (= (second (assoc 'status rec)) "install ok installed")
           (nconc pool (list rec))))))))

(define (read-pool-from-disk)
  (when (file-exists-p cache)
    (let ((f (open-file cache 'read)))
      (setq pool (read f))
      (close-file f))))

(define (write-pool-to-disk)
  (let ((f (open-file cache 'write)))
    (print pool f)
    (close-file f)))

(define (write-pool-to-gdbm)
  (require 'rep.io.db.gdbm)
  (let ((db (gdbm-open "deb.db" 'write)))
    (dolist (rec (cdr pool))
      ;; FIXME convert rec into read syntax
      (gdbm-store db (symbol-name (first rec)) (format nil "%s" rec)))
    (gdbm-close db)))

(require 'compiler)
(compile-function read-pool)
(read-pool)
(printf "installed packages: %s\n" (pool-size))
;;(puts pool)
(puts (package-record 'librep-local))
(puts (package-record 'bash))
;;(puts (package-attr 'libc6 'maintainer))

;; TODO next: start adding dependency calculations

(when nil
  (require 'rep.util.repl)
  (repl))