(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"))
               (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 (id)
  (let* ((logon (system:getenv "LOGONROOT"))
         (logon (namestring (parse-namestring logon)))
         (file (format nil "~a/uio/wsj/cooked/wsj~2,'0d.txt" logon id))
         (skeleton (format nil "wsj/wsj~2,'0d" id))
         (morsels (format nil "wsj/morsels/wsj~2,'0d" id)))
    (when (probe-file file)
      (let* ((full (format nil "tmp/~a" skeleton))
             (items (do-import-items file full)))
        (tenure full skeleton)
        (loop
            for i from 0
            for suffix = (code-char (+ (char-code #\a) i))
            for morsel = (format nil "~a~c" full suffix)
            for low from 0 by 500
            for high from 500 to (* (ceiling (length items) 500) 500) by 500
            do
              (do-import-items file morsel :low low :high high)
              (tenure morsel (format nil "~a~c" morsels suffix)))))))

(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 0 to 24 do (create-skeleton i)))