;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: REGISTRY; -*-

(in-package :registry)

;;;
;;; Copyright (c) 2010 -- 2010 Stephan Oepen (oe@ifi.uio.no)
;;;
;;; This program is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU Lesser General Public License as published by
;;; the Free Software Foundation; either version 2.1 of the License, or (at
;;; your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful, but WITHOUT
;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
;;; License for more details.
;;; 

(defparameter *registry* nil)

(defstruct component
  id properties)

(defun initialize ()
  (setf *registry* nil)
  (let* ((root (getenv "LOGONROOT"))
         (root (and (stringp root) (not (string= root ""))
                    (namestring (parse-namestring root))))
         (root (and root (make-pathname :directory root)))
         (path (make-pathname :directory "etc")))
    (unless root
      (error "logon-directory(): unable to determine global LOGONROOT."))
    (let* ((file (make-pathname 
                  :host (pathname-host root)
                  :device (pathname-device root)
                  :directory (append
                              (pathname-directory root)
                              (rest (pathname-directory path)))
                  :name "registry")))
      (unless (probe-file file)
        (error "initialize(): unable to open `~a'" (namestring file)))
      (with-open-file (stream file :direction :input)
        (loop
            for line = (read-line stream nil nil)
            with component
            while line do
              (cond
               ((or (= (length line) 0) (ppcre::scan "^[ \\t;]" line)))
               ((ppcre::scan "^\\[[^][ ]+\\]$" line)
                (let* ((id (subseq line 1 (- (length line) 1)))
                       (id (intern (string-upcase id) :keyword)))
                  (setf component
                    (or (find id *registry* :key #'component-id)
                        (make-component :id id)))
                  (push component *registry*)))
               ((and component (ppcre::scan "^[a-z]{2,2}=.+$" line))
                (let* ((key (subseq line 0 2))
                       (key (intern (string-upcase key) :keyword))
                       (value (subseq line 3)))
                  (push (cons key value) (component-properties component))))
               (t
                (format
                 t "registry:initialize(): ignoring entry `~a'.~%" line)))))
      *registry*)))

(defun lookup (id key &rest keys)
  (if (keywordp key)
    (let ((component (find id *registry* :key #'component-id)))
      (when component
        (rest (assoc key (component-properties component)))))
    (let ((values (loop
                      for key in keys
                      when (eq key :ln) collect (logon-directory nil :string)
                      else collect (lookup id key))))
      (apply #'format nil key values))))