(module config mzscheme
        (require "hwikireq.scm")
        (require (lib "getinfo.ss" "setup"))
        (provide TEMPLATE-PATH
                 DOCUMENT-PATH
                 IMAGE-PATH
                 FILE-PATH
                 ADMIN-PATH
                 DEFAULT-PAGE
                 HTML-PATH
                 WIKI-PATH
                 SERVLET-PATH
                 DOCUMENT-ROOT
                 MAX-UPLOAD-SIZE
                 HWIKI-VERSION
                 cfile
                 sqli-provider
                 sqli-closer
                 menu-timeout
                 edit-timeout
                 form-timeout
                 expire-shortly-timeout
                 )

        (define HWIKI-VERSION (let ((f (get-info/full (car (find-relevant-directories '(hwiki))))))
                                (f 'version)))

        (define HWIKI-DATA  (if (eq? (getenv "HWIKI_DATA") #f)
                                "d:/hwiki"
                                (getenv "HWIKI_DATA")))

        (define TEMPLATE-PATH "templates")
        (define CSS-PATH      "css")
        (define DOCUMENT-PATH "documents")
        (define PAGE-PATH     "pages")
        (define IMAGE-PATH    "images")
        (define FILE-PATH     "files")
        (define ADMIN-PATH    "admin")
        (define DEFAULT-PAGE  "index")
        (define DATA-PATH     "data")
        (define HTML-PATH     "")
        (define WIKI-PATH     "/servlets/hwiki.scm")
        (define SERVLET-PATH  "/servlets")
        (define DOCUMENT-ROOT (if (eq? (getenv "HWIKI_HTDOCS") #f)
                                  "d:/build/web-root/htdocs"
                                  (getenv "HWIKI_HTDOCS")))
        (define MAX-UPLOAD-SIZE (if (eq? (getenv "HWIKI_MAX_UPLOAD_SIZE") #f)
                                    "10000000"
                                    (getenv "HWIKI_MAX_UPLOAD_SIZE")))
        
        (define (bp . args)
          (apply build-path (map (lambda (x) (format "~a" x)) args)))
        
        (define (sr s x)
          (string-ref s x))

        (def-class
         (this (cfile context))
         (supers)
         (private
          
          (define re-colon (pregexp "[:]"))
          
          (define (create-dir-and-return-filename base name)
            (if (not (directory-exists? base))
                (make-directory* base))
            (if (string? name)
                (set! name (pregexp-replace* re-colon name "_")))
            (path->string (build-path base name)))
                     
;            (let ((B (let ((L (string-length name)))
;                       (letrec ((g (lambda (i)
;                                     (if (or (>= i L) (>= i 8))
;                                         '()
;                                         (cons (sr name i) (g (+ i 1)))))))
;                         (apply bp (cons base (g 0)))))))
;              (if (not (directory-exists? B))
;                  (make-directory* B))
;              (path->string (build-path B name))))

          (define (mkpath p)
            (let ((_path (format "~a/~a~a"
                                 HWIKI-DATA
                                 (let ((c (-> context context)))
                                   (if (or (not (string? c)) (string=? c ""))
                                       ""
                                       (format "~a/" c)))
                                 p)))
              (if (not (directory-exists? _path))
                  (make-directory* _path))
              _path))

          (define (mkdocroot)
            (let ((_path (format "~a~a"
                                 DOCUMENT-ROOT
                                 (let ((c (-> context context)))
                                   (if (or (not (string? c)) (string=? c ""))
                                       ""
                                       (format "/~a" c))))))
              (if (not (directory-exists? _path))
                  (make-directory* _path))
              _path))

          )
         (public
          (define (get-path type)
            (cond ((eq? type 'admin)    (admin-path))
                  ((eq? type 'file)     (file-path))
                  ((eq? type 'image)    (image-path))
                  ((eq? type 'page)     (page-path))
                  ((eq? type 'css)      (css-path))
                  ((eq? type 'template) (template-path))
                  ((eq? type 'document) (document-path))
                  ((eq? type 'data)     (data-path))
                  (else (error "Wrong type"))))
            
          
          (define (filename type f)
            (create-dir-and-return-filename (get-path type) f))
          
          (define (file-list type)
            (directory-list (get-path type)))

          (define (htdocfile type f)
            (let ((ext (cond
                        ((eq? type 'css) ".css")
                        ((eq? type 'page) ".html")
                        (else (format ".~a" type)))))
              (format "~a/~a" (document-root) (format "~a~a" f ext))))
;              (create-dir-and-return-filename (document-root) (format "~a~a" f ext))))
              
;            (htmllink type f (format "~a~a"
;                                     DOCUMENT-ROOT
;                                     (let ((c (-> context context)))
;                                       (if (or (not (string? c)) (string=? c ""))
;                                           ""
;                                           (format "/~a" c))))))

          (define (htmllink type f . base)
            (let ((C   (-> context context))
                  (F   (-> context from-where))
                  (ext (cond ((eq? type 'css) ".css")
                             ((eq? type 'page) ".html")
                             (else (error "Unknown type for htmllink")))))
              (display (format "htmllink:~a ~a ~a ~a ~a~%" type f base C ext))
              (let ((_base (if (null? base)
                               #f
                               (regexp-replace "[/][^.]+[.]html.*" (car base) ""))))
                (format "~a/~a~a~a"
                        (if (eq? _base #f)
                            (cond
                             ((eq? type 'page) WIKI-PATH)
                             ((eq? type 'css)  "")
                             )
                            _base)
                        f
                        ext
                        (if (eq? type 'page)
                            (format "?context=~a;from-where=~a" C F)
                            ""))
                )))
          
          (define (htmllink-with-keys type f . keyvals)
            (let ((l (htmllink type f)))
              (apply string-append l (map (lambda (kv) (format ";~a=~a" (car kv) (cdr kv))) keyvals))))
          
          (define (htmllink-full-with-keys base type f . keyvals)
            (let ((l (htmllink type f base)))
              (apply string-append l (map (lambda (kv) (format ";~a=~a" (car kv) (cdr kv))) keyvals))))

          (define (template-path)
            (mkpath TEMPLATE-PATH))

          (define (css-path)
            (mkpath CSS-PATH))

          (define (document-path)
            (mkpath DOCUMENT-PATH))

          (define (page-path)
            (mkpath PAGE-PATH))

          (define (image-path)
            (mkpath IMAGE-PATH))

          (define (file-path)
            (mkpath FILE-PATH))

          (define (admin-path)
            (mkpath ADMIN-PATH))

          (define (data-path)
            (mkpath DATA-PATH))

          (define (document-root)
            (mkdocroot))

          )
         (constructor
          (if (not (directory-exists? (mkpath TEMPLATE-PATH)))
              (for-each (lambda (D)
                          (mkpath D))
                        (list TEMPLATE-PATH CSS-PATH DOCUMENT-PATH PAGE-PATH
                              IMAGE-PATH FILE-PATH ADMIN-PATH)))
          )
         )
        
        ;;;;;;;;; Database connections
        
        (define PROVIDER #f)
        (define POOL-SEM (make-semaphore 1))
        (define POOL     '())
        
        (define (sqli-provider)
          (if (eq? PROVIDER #f)
              (begin
                (copy-to (build-path (getenv "HWIKI_SQLI"))
                         (build-path (current-directory) "hwiki-sqli.scm"))
                (set! PROVIDER (with-handlers ((exn:fail? (lambda (exn)
                                                            (hlog (format "ERROR CANNOT LOAD hwiki-sqli.scm: ~a" (exn-message exn)))
                                                            (lambda () #f))))
                                 (dynamic-require "hwiki-sqli.scm" 'sqli-provider)))))
          (semaphore-wait POOL-SEM)
          (if (null? POOL)
              (begin
                (semaphore-post POOL-SEM)
                (PROVIDER))
              (let ((R (car POOL)))
                (set! POOL (cdr POOL))
                (semaphore-post POOL-SEM)
                R)))
        
        (define (sqli-closer sqli)
          (semaphore-wait POOL-SEM)
          (set! POOL (cons sqli POOL))
          (semaphore-post POOL-SEM))
        
        ;;;;;;;;; timeouts

        (define (menu-timeout)
          (if (getenv "HWIKI_MENU_TIMEOUT")
              (string->number (getenv "HWIKI_MENU_TIMEOUT"))
              600))
        
        (define (edit-timeout)
          (if (getenv "HWIKI_EDIT_TIMEOUT")
              (string->number (getenv "HWIKI_EDIT_TIMEOUT"))
              (* 3 3600)))
        
        (define (form-timeout)
          (if (getenv "HWIKI_FORM_TIMEOUT")
              (string->number (getenv "HWIKI_FORM_TIMEOUT"))
              1800))
        
        (define (expire-shortly-timeout)
          (if (getenv "HWIKI_EXPIRE_TIMEOUT")
              (string->number (getenv "HWIKI_EXPIRE_TIMEOUT"))
              10))
        
        )