(in-package :tsdb)

(defun tenure (profile skeleton &key absolute (verbose t) (stream *tsdb-io*))
  (let ((source 
         (if absolute (namestring profile) (find-tsdb-directory profile)))
        (target (find-skeleton-directory skeleton)))
    (if (and source
               (probe-file (make-pathname :directory source :name "relations"))
               (probe-file target)
               (let* ((command (format
                                nil 
                                "~a -home='~a' -verify -quiet -pager=null"
                                *tsdb-application* source))
                      (status (run-process command :wait t)))
                 (zerop status)))
        (if (probe-file target)
          (loop
              for name in *tsdb-core-files*
              for old = (make-pathname :directory source :name name)
              for new = (make-pathname :directory target :name name)
              for size = (file-size old)
              when (and (numberp size) (> size 0)) do
                (when verbose
                  (let ((name (string-strip
                               (namestring *tsdb-skeleton-directory*)
                               (namestring new))))
                    (format stream "tenure(): --> `~a'~%" name)))
                (cp old new))
          (when verbose
            (format
             stream
             "tenure(): invalid target skeleton `~a'.~%" skeleton)))
      (when verbose
        (format
         stream
         "tenure(): invalid source profile `~a'.~%" profile)))))
                   
(defun create-skeleton (name)
  (let* ((logon (system:getenv "LOGONROOT"))
         (logon (namestring (parse-namestring logon)))
         (file (format nil "~a/uio/wescience/txt/~2,'0d.txt" logon name))
         (skeleton (format nil "wescience/ws~2,'0d" name)))
    (when (probe-file file)
      (let ((source (format nil "tmp/~a" skeleton)))
        (do-import-items file source)
        (tenure source skeleton)))))

(let* ((root (system:getenv "LOGONROOT"))
       (root (namestring (parse-namestring root))))
  (tsdb 
   :skeleton
   (format nil "~a/lingo/lkb/src/tsdb/skeletons/english" %logon%))
  (loop
      for i from 1 to 16 do (create-skeleton i)))