(module sqlid-libpath mzscheme
	(require (lib "getinfo.ss" "setup"))
	(provide set-libpath
	         reset-libpath
		 libpath-module)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define COLLECTION 'sqlid)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define (get-dynamic-require-module-path module-path)

  (define (ups path)
    (define (ups l)
      (if (null? l)
	  (list)
	  (if (or (char=? (car l) #\/)
		  (char=? (car l) #\\))
	      (cons 'up (ups (cdr l)))
	      (ups (cdr l)))))
    (ups (string->list (path->string path))))

  (define (make-relative path)
    (let ((p (path->string path)))
      (if (string=? (substring p 1 2) ":")
	  (make-relative (build-path (substring p 3 (string-length p))))
	  (apply build-path (append (ups (current-directory)) (list path))))))

  (define (get-relative-name name)
    (define (backslash->slash l)
      (if (null? l)
	  (list)
	  (cons
	   (if (char=? (car l) #\\)
	       #\/
	       (car l))
	   (backslash->slash (cdr l)))))
    (list->string 
     (backslash->slash
      (string->list 
       (path->string (make-relative name))))))

					;(get-relative-name (build-path module-path)))
  (build-path module-path))

(define internal-reset-libpath (lambda () #t))
(define internal-set-libpath   (lambda () #t))
(define sqlid-libpath          (lambda () ""))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (libpath-module module-name)
  (get-dynamic-require-module-path (sqlid-libpath module-name)))

(define (win32-libpath path)
  (let ((PATH (getenv "PATH")))
    (set! internal-reset-libpath (lambda () (putenv "PATH" PATH)))
    (putenv "PATH" (string-append PATH ";" (path->string path)))))

(define (unix-libpath path)
  (let ((_LIBPATH (getenv "LIBPATH"))
	(_LD_LIBRARY_PATH (getenv "LD_LIBRARY_PATH")))
    (let ((LIBPATH (if (eq? _LIBPATH #f) "" _LIBPATH))
          (LD_LIBRARY_PATH (if (eq? _LD_LIBRARY_PATH #f) "" _LD_LIBRARY_PATH)))
      (set! internal-reset-libpath (lambda () 
				     (putenv "LIBPATH" LIBPATH)
				     (putenv "LD_LIBRARY_PATH" LD_LIBRARY_PATH)))
      (putenv "LIBPATH" (string-append LIBPATH ":" (path->string path)))
      (putenv "LD_LIBRARY_PATH" (string-append LD_LIBRARY_PATH ":" (path->string path))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (reset-libpath)
  (internal-reset-libpath))

(define (set-libpath)
  (internal-set-libpath))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Set the library path for inclusion of dynamic libraries.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(let ((native-path  (system-library-subpath))
      (collect-path (car (find-relevant-directories (list COLLECTION)))))
  (let ((libpath (build-path collect-path "lib" native-path)))
    (let ((system  (system-type)))
      (set! sqlid-libpath (lambda (mod) (path->string (build-path collect-path mod))))
      (set! internal-set-libpath (lambda ()
				   (cond
				    ((eq? system 'windows) (win32-libpath libpath))
				    ((or
				      (eq? system 'unix)
				      (eq? system 'macosx)) (unix-libpath libpath))
				    (else
				     (error "Cannot set the LIBPATH for this system ('" 'system "'")))))
      #t)))

)