; Handbase utilities

;;; Curried to avoid repeated reading 
;;; of catalog
(define (hb-getrecord db)
  (let ((info (hb-info db)))
    (lambda (rec) 
      (letrec ((getf (lambda (fd) 
	(convert 
	  (if (= (caddr fd) 10)
	    (hb-getlinks db rec (car fd))
	    (hb-getfield db rec (car fd)))
	  (caddr fd)))))
    (if (or (< rec 0) (>= rec (car info)))
	(error "rec out of range")
      (map getf (cdr info)))))))

(define (convert val type)
   (case type 
    ((1 4 12 13 14) val)
    ((2 6) (string->object val))
    ((3 15) (parse-float val))
  ; type 15 could also be date/time !
    ((5) (string=? val "TRUE"))
    ((7) 'image)
    ((8) (parse-date val))
    ((9) (parse-time val))
    ((10) (map (hb-getrecord 
		(car val)) (cdr val)))
    ((11) 'linked)))

;;; Parse a float after replacing
;;; commas by dots
(define (parse-float s) 
  (do ((i 0 (+ i 1))) 
	((>= i (string-length s))
 	(string->object s))
    (if (eq? #\, (string-ref s i))
	(string-set! s i #\.) #n)))

;;; Parse a date string dd.mm.yy
;;; year in range 1951-2050 assumed
(define (parse-date s)
  (let* ((d1 (find s #\. 0))
	(d2 (find s #\. (+ d1 1)))
	(y (string->object 
		(substring s (+ d2 1) 15)))
	(m  (string->object 
		(substring s (+ d1 1) d2)))
	(d (string->object 
		(substring s 0 d1))))
  `(date ,(+ y (if (> y 50) 1900 2000))
	,m ,d)))

;;; Parse a time string hh:mm
(define (parse-time s)
  (if (string=? "No Time" s)
  '(time #n)
  `(time ,(string->object s) 
	,(string->object (substring s 
  	   (+ 1 (find s #\: 0)) 10)))))

;;; Find char c in string s starting at
;;; position p. Returns #f if not found
(define (find s c p)
  (cond ((>= p (string-length s)) #f)
	((eq? c (string-ref s p)) p)
	(else (find s c (+ 1 p)))))