;;;===========================================================================
;;;
;;; weblisp.lisp
;;;
;;; Eduardo Muņoz
;;; Time-stamp: "Sunday, 02 January 2005 - 01:41:10"
;;;
;;;===========================================================================

(in-package :cl-user)

(eval-when (:compile-toplevel :load-toplevel :execute)
;;   (require :clsql)
;;   (require :clsql-postgresql)
  (asdf:operate 'asdf:load-op :clsql)
  (asdf:operate 'asdf:load-op :clsql-postgresql)
  )

(defpackage #:weblisp
  (:nicknames #:wl)
  (:use #:cl)
  (:export #:list-apache-addresses
           #:delete-apache-address
           #:test-apache-address
           #:with-apache-address
           #:html
           #:standard-page
           #:page-header
           #:page-index
           #:page-footer
           #:standard-table
           #:compile-weblisp-file
           #:build-web
           #:start-web
           #:restart-web
           #:show-compiled-pages))

(in-package :weblisp)


(defvar *apache-address-table* (make-hash-table :test #'equalp :size 50))
(defvar *apache-document-root* "/home/emf/www")

(setq clsql:*default-caching* nil)

(setf (logical-pathname-translations "weblisp") 
      '(("code;*.*.*" "/home/emf/weblisp/*.LISP.*")
        ("lib;*.*.*" "/home/emf/weblisp/lib/*.LISP.*")
        ("fasl;*.*.*" "/home/emf/weblisp/fasl/*.X86F.*")))

(defvar *weblisp-files*
  '("weblisp:lib;htout"
    "weblisp:code;macros"
    "weblisp:code;utils"
    "weblisp:code;log"
    "weblisp:code;log-errors"
    "weblisp:code;errors"
    "weblisp:lib;mod-lisp"
    "weblisp:code;autocad"
    "weblisp:code;bookmarks"
    "weblisp:code;emacs"
    "weblisp:code;hack"
    "weblisp:code;index"
    "weblisp:code;lisp"
    "weblisp:code;misc"
    "weblisp:code;news"
    "weblisp:code;test"
    "weblisp:code;weblog"
    "weblisp:code;weblog-master"
    "weblisp:code;whois"))

;; (defun compile-weblisp-file (file &optional force-compilation)
;;   (let* ((lisp-file (translate-logical-pathname file))
;;          (fasl-file (translate-logical-pathname
;;                      (merge-pathnames "weblisp:fasl;"
;;                                       (pathname-name file)))))
;;     (print lisp-file)
;;     (print fasl-file)
;;     (if (or force-compilation
;;             (not (probe-file fasl-file))
;;             (< (file-write-date fasl-file)
;;                (file-write-date file)))
;;         (multiple-value-bind (fas warn fail)
;;             (compile-file lisp-file :output-file fasl-file)
;;           (declare (ignorable fas warn))
;;           (print "**")
;;           (print fas)
;;           (if fail
;;               (format t "~&Compilation of ~A failed.~%" lisp-file)
;;               (progn
;;                 (format t "~&-- compile+load ~A~%" fasl-file)
;;                 (load FAS #+nil fasl-file)#+nil)
;;               ))
;;         (load fasl-file)
;;         (format t "~&-- load ~A~%" fasl-file))))

(defun compile-weblisp-file (file &optional force-compilation)
  (let* ((lisp-file (translate-logical-pathname file))
         (fasl-file (translate-logical-pathname
                     (merge-pathnames "weblisp:fasl;"
                                      (pathname-name file)))))
    (if (or force-compilation
            (not (probe-file fasl-file))
            (< (file-write-date fasl-file)
               (file-write-date file)))
        (multiple-value-bind (fas warn fail)
            (compile-file lisp-file :output-file fasl-file)
          (declare (ignorable fas warn))
          (if fail
              (format t "~&Compilation of ~A failed.~%" lisp-file)
              (progn
                (format t "~&-- compile+load ~A~%" fasl-file)
                (load fas #+nil fasl-file))))
        (load fasl-file))))


(defun build-web (&optional (force-compilation nil))
  (dolist (file *weblisp-files*)
    (compile-weblisp-file file force-compilation)))

(defun start-web (&optional (force-compilation nil))
  (build-web force-compilation)
  (start-apache-listener)
  (start-scheduled-full-gc)
  (start-scheduled-explore-unknown-ips))

(defun restart-web ()
  (dolist (proc (butlast (mp:all-processes)))
    (mp:destroy-process proc)))


(defun scheduled-full-gc (&optional (interval (* 12 3600)))
  (loop (sleep interval)
        (format t ";; Running full garbage collection.~%")
        (ext:gc :full t :verbose t)))

(defun start-scheduled-full-gc ()
  (mp:make-process #'scheduled-full-gc :name "Scheduled Full GC"))