(in-package :tsdb)


(defparameter *logon*
  '("jh0" "jh1" "jh2" "jh3" "jh4" "jh5" "jh" "ps" "tg" "jhpstg"
    "jhk" "jhu" "psk" "psu" "tgk" "tgu"))

(defparameter *handon-no*
  '("dnt.aktivitet.no" "dnt.artikkel.no" "dnt.omraade.no" "dnt.rute.no"
    "dnt.turforslag.no" "guide.generelt.no" "guide.omraade.no" "tg+"))

(defparameter *handon-en*
  '("bike.en" "dnt.activity.en" "dnt.article.en" "dnt.cabin.en" "dnt.index.en"
    "dnt.location.en" "dnt.trip.en" "gol.en" "guide.general.en" 
    "guide.location.en" "romsdal.en" "tiltopps.en" "turistveg.en"))

(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 (find-skeleton 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 &key (source "norsk") target shift)
  (let* ((logon (system:getenv "LOGONROOT"))
         (logon (namestring (parse-namestring logon)))
         (file (format nil "~a/uio/data/~a.txt" logon name))
         (suffix (cond
                  ((equal source "norsk") "\.no$")
                  ((equal source "english") "\.en$")))
         (skeleton (subseq name 0 (ppcre:scan suffix name))))
    (when (probe-file file)
      (let ((source (format nil "tmp/~a/~a" source skeleton))
            (target (and target (format nil "tmp/~a/~a" target skeleton))))
        (do-import-items
         file source :format :bitext :target target :shift shift)
        (if target
          (tenure target skeleton)
          (tenure source skeleton))))))

(let* ((root (system:getenv "LOGONROOT"))
       (root (namestring (parse-namestring root))))
  (tsdb 
   :skeleton
   (format nil "~a/lingo/lkb/src/tsdb/skeletons/norsk" %logon%))
  ;;
  ;; _fix_me_
  ;; we should also re-create norwegian skeletons, but they are not exactly
  ;; the same set as the english one (but those are far more likely to change,
  ;; now that the LOGON project is complete).                 (10-jan-09; oe)
  ;;
  (loop
      for name in *handon-no*
      do (create-skeleton name :source "norsk"))
  (tsdb 
   :skeleton
   (format nil "~a/lingo/lkb/src/tsdb/skeletons/english" %logon%))
  (loop
      with shifter = #'(lambda (id) (+ id 3000000))
      for name in *logon*
      do (create-skeleton
          name :source "norsk" :target "english" :shift shifter))
  (loop
      for name in *handon-en*
      do (create-skeleton name :source "english")))