;#!/usr/bin/env clisp
;;; vcard.lisp -- VCARD address data utilities
;;; 2010/6/22 David Meyer papa@freeshell.org
;;; +JMJ

(setq *block-begin-st* "BEGIN:VCARD")
(setq *block-end-st* "END:VCARD")

(setq  *cards* '()) ; *cards* not reset on load?
(defvar *curr-card*)

(defun aval (key assoc) (cdr (assoc key assoc)))

(defun parse-vcards (INF)
  (do ((line (read-line INF nil)))
      ((not line))
    (cond
      ((string= line *block-begin-st*) (start-card))
      ((string= line *block-end-st*) (end-card))
      (t (parse-attribute line)))
    (setq line (read-line INF nil))))

(defun start-card () (setq *curr-card* '()))

(defun end-card ()
  (setq *cards*
	(cons
	 (first-last-name *curr-card*)
	 *cards*)))

(defun parse-attribute (string)
  (let ((pos (position #\: string)))
    (if pos
	(let
	    ((key (subseq string 0 pos))
	     (val (subseq string (1+ pos))))
	  (setq *curr-card*
		(acons (intern key "KEYWORD") val *curr-card*))))))

(defun first-last-name (card)
  (let ((name-a (assoc :n card)))
    (if (not name-a)
	card
	(let*
	    ((name (cdr name-a))
	     (pos (position #\; name)))
	  (if pos
	      (pairlis
	       '(:x-lastn :x-firstn)
	       (list (subseq name 0 pos) (subseq name (1+ pos)))
	       card)
	      (pairlis
	       '(:x-lastn :x-firstn)
	       (list name "")
	       card))))))
	  
(defun key-list (cards)
  (let ((keys '()))
    (dolist (record cards keys)
      (dolist (attrib record)
	(let ((key (car attrib)))
	  (if (not (member key keys))
	      (setq keys (cons key keys))))))))

(defun format-html (keys cards outf)
  (format outf "<TABLE BORDER=1>~%<THEAD><TR>") ; table header
  (dolist (key keys)
    (format outf "<TH>~e</TH>" key))
  (format outf "</TR></THEAD>~%")

  (format outf "<TBODY>~%") ; table body
  (dolist (vcard cards) ; table row per vcard
    (format outf "<TR>")
    (dolist (key keys)
      (format outf "<TD>~e</TD>" (aval key vcard)))
    (format outf "</TR>~%"))

  (format outf "</TBODY>~%</TABLE>~%")) ; table footer
      
(defun format-csv (keys cards outf)
  (format outf "~e" (car keys)) ; header line
  (dolist (key (cdr keys))
    (format outf ",~e" key))
  (format outf "~%")

  (dolist (vcard cards) ; data line per vcard
    (format outf "\"~e\"" (aval (car keys) vcard))
    (dolist (key (cdr keys))
      (format outf ",\"~e\"" (aval key vcard)))
    (format outf "~%")))


(defun main ()
  (let
      ((INF (open "~/cave/green/vcard/examples.vcf"))
       (OUTF (open "test.csv" :direction :output)))
    (parse-vcards INF)
    (close INF)
    (format-csv '(:fn :org) *cards* OUTF)
    (close OUTF)))

(main)