(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)))
         (txt (format nil "~a/uio/wescience/txt/~2,'0d.txt" logon name))
         (gml (format nil "~a/uio/wescience/gml/~2,'0d.gml" logon name))
         (tskeleton (format nil "wescience/ws~2,'0d" name))
         (gskeleton (format nil "wescience/ws2~2,'0d" name)))
    #+:null
    (when (probe-file txt)
      (let ((source (format nil "tmp/~a" tskeleton)))
        (do-import-items txt source)
        (tenure source tskeleton)))
    (when (probe-file gml)
      (let ((source (format nil "tmp/~a" gskeleton)))
        (do-import-items gml source)
        (tenure source gskeleton)))))

(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)))

#+:gisle
(loop
    for i from 1 to 13
    for name = (format nil "gold/erg/ws~2,'0d" i)
    for items = (retrieve nil name)
    do
      (ignore-errors (mkdir (format nil "/tmp/ws~2,'0d" i)))
      (loop
          for item in items
          for id = (get-field :i-id item)
          for file = (format nil "/tmp/ws~2,'0d/~a.tt" i id)
          for input = (get-field :i-input item)
          for repp = (lkb::repp-for-pet
                      input :tnt :repp :tokenizer
                      :calls '(:xml :ascii :wiki :quotes)
                      :format :raw)
          do
            (with-open-file (stream file :direction :output
                             :if-exists :supersede)
              (loop
                  for token in repp
                  do
                    (format
                     stream "~a	~a	~a~{	~a~}~%"
                     (lkb::token-start token) (lkb::token-end token)
                     (lkb::token-form token) (lkb::token-tags token))))))