;; linebase
;; simple module to handle data as a simple traditional base of records as
;; lines and tab-separated fields

(defvar linebase:tab #\tab)		;can be redefined (to string or char)
(defvar linebase:newline #\newline)	;can be redefined (to string or char)
(defvar Item (defstruct Item fields))
(defvar defstruct::tag '#)		;for old defstruct versions

;;AUTOLOAD: linebase:read
;;AUTODOC: linebase:read "loads a linebase in memory"
;; (linebase:read stream-or-string [structure])
;;
;; Given a stream opened on a file or a buffer as a string, parses it and
;; builds a database (vector) of records (structures, i.e. vectors), expecting
;; lines made of tab-separated fields.
;; records are made of the optional Structure arguments, defaults to "Item"
;; which a flexible one
;; Note: linebase:tab is the ascii char of the separator, defaults to 9 (#\tab)

(defun linebase:read (file &optional struct &aux 
    (base (vector))
    line
    fd
    item
    (separator-string (if (typep linebase:tab String) linebase:tab
	(String (list linebase:tab)))
    )
    (record-separator-string (if (typep linebase:newline String) linebase:newline
	(String (list linebase:newline)))
    )
    (re-field (regcomp (+ "^([^" separator-string "]*)[" separator-string "]")))
    offset
    (nil-for-nil-string (lambda (s) (if (= "" s) () s)))
  )
  (if (typep file Stream) (setq fd file)
    (setq fd (open file :type :string))
  )
  (if (= record-separator-string "\n")
    (catch 'EOF
      (while t
	(setq line (read-line fd))
	(setq item (vector defstruct::tag (if struct (1 struct) 'Item)))
	(lappend base item)
	(setq offset 0)
	(while (regexec re-field line offset)
	  (lappend item (nil-for-nil-string (regsub re-field 1)))
	  (setq offset (1 (get re-field 0)))
	)
	(lappend item (nil-for-nil-string (subseq line offset)))
    ))
    (dolist (line (linebase:split 
	  (String fd) 
	  (regcomp (+ "^([^" record-separator-string "]*)[" 
	      record-separator-string "]"))
	  1
      ))
      (setq item (vector defstruct::tag (if struct (1 struct) 'Item)))
      (lappend base item)
      (setq offset 0)
      (while (regexec re-field line offset)
	(lappend item (nil-for-nil-string (regsub re-field 1)))
	(setq offset (1 (get re-field 0)))
      )
      (lappend item (nil-for-nil-string (subseq line offset)))
  ))
  base      
)

(defun linebase:split (s re n &aux 
    (offset 0)
    (l (vector))
  )
  (while (regexec re s offset)
    (lappend l (regsub re-field n))
    (setq offset (1 (get re-field 0)))
  )
  (lappend l (subseq line offset))
  l
)
  

;;AUTOLOAD: linebase:write
;;AUTODOC: linebase:write "writes a linebase to a file"
;; (linebase:write base [stream])
;;
;; Given a database (vector) of records (structures, i.e. vectors), writes
;; lines made of tab-separated fields. Defaults prints to stdout.
;; Note: linebase:tab is the ascii char of the separator, defaults to 9 (#\tab)

(defun linebase:write (base &optional fd &aux 
    (separator-string (if (typep linebase:tab String) linebase:tab
	(String (list linebase:tab)))
    )
    (record-separator-string (if (typep linebase:newline String) linebase:newline
	(String (list linebase:newline)))
    )
    print-tab
  )
  (dolist (item base)
    (setq print-tab ())
    (dolist (field (subseq item 2))
      (if print-tab 
	(write-string separator-string fd)
	(setq print-tab t)
      )
      (if field (write field fd))
    )
    (write-string record-separator-string fd)
  )
)

