;;; rcd-vcard.el --- RCD vCard functions  -*- lexical-binding: t; -*-

;; Copyright (C) 2016-2021 by Jean Louis

;; Author: Jean Louis <bugs@gnu.support>
;; Version: 0.1
;; Package-Requires: (rcd-utilities rcd-db-init rcd-db rcd-cf)
;; Keywords: 
;; URL: https://gnu.support/gnu-emacs/packages/rcd-vcard.html

;; This file is not part of GNU Emacs.

;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; These are the RCD vCard functions
;;
;; RCD is acronym for Reach, Connect, Deliver, my personal
;; principle and formula for Wealth.

;;; Change Log:

;;; Code:

(require 'rcd-utilities)
(require 'rcd-db-init)
(require 'rcd-db)
(require 'rcd-cf)

(defvar *rcd-vcard-version* "2.1")
(defvar *rcd-vcard-output* "~/tmp/rcd-vcards/")

(defun rcd-vcard-jabber (xmpp)
  (if (rcd-string-not-empty-p xmpp)
      (format "X-JABBER:%s\nX-JABBER;WORK:%s\n" xmpp xmpp)
    ""))

(defun rcd-vcard-tel (tel &optional type)
  (if (rcd-string-not-empty-p tel)
      (let* ((type (or type "CELL"))
	     (type (upcase type)))
	(format "TEL;%s:%s\n" type tel))
    ""))

(defun rcd-vcard-address (address1 city1 zip1 state1 country1 address2 city2 zip2 state2 country2)
  (with-output-to-string
    (princ "ADR;DOM;HOME;:")
    (princ city1)
    (princ ";")
    (princ country1)
    (princ "\n"))) ;; TODO

(defun rcd-vcard-phones (office mobile home other fax &optional other-2 other-3 other-4)
  (with-output-to-string
    (when office
      (princ (rcd-vcard-tel office "WORK")))
    (when mobile
      (princ (rcd-vcard-tel mobile "CELL")))
    (when home
      (princ (rcd-vcard-tel home "HOME")))
    (when other
      (princ (rcd-vcard-tel other "OTHER")))
    (when fax
      (princ (rcd-vcard-tel fax "FAX")))
    (when other-2
      (princ (rcd-vcard-tel other-2 "OTHER")))
    (when other-3
      (princ (rcd-vcard-tel other-3 "OTHER")))
    (when other-3
      (princ (rcd-vcard-tel other-3 "OTHER")))))

(defun rcd-vcard-title (title)
  (if (rcd-string-not-empty-p title)
      (format "TITLE:%s\n" title)
    ""))

(defun rcd-vcard-organization (org &optional unit)
  (if (rcd-string-not-empty-p org)
      (let ((unit (or unit "")))
	(format "ORG:%s;%s\n" org unit))
    ""))

;; (defun rcd-vcard-note (note)
;;   (if (rcd-string-not-empty-p note)
;;       (format "NOTE:ENCODING=BASE64;:%s\n" (base64-encode-string note))
;;     ""))

(defun rcd-vcard-note (id note)
  (with-output-to-string
    ;;     (princ (format "NOTE;ENCODING=BIT8;:Contact ID %s; " id))
    (princ (format "NOTE:Contact ID %s" id))
    (if (rcd-string-not-empty-p note)
	(princ (format "%s\n" "")) ;; place note instead of ""
      "")))

(defun rcd-vcard-begin ()
  (format "BEGIN:VCARD\nVERSION:%s\n" *rcd-vcard-version*))

(defun rcd-vcard-end ()
  (format "END:VCARD\n"))

(defun rcd-vcard-email (email &optional type)
  (if (rcd-string-not-empty-p email)
      (let* ((type (or type "HOME"))
	     (type (upcase type)))
	(format "EMAIL;%s:%s\n" type email))
  ""))

(defun rcd-vcard-url (url)
  (if (rcd-string-not-empty-p url)
      (format "URL:%s\n" url)
    ""))

(defun rcd-vcard-birthday (bday)
  (if (rcd-string-not-empty-p bday)
      (format "BDAY:%s\n" bday)
    ""))

(defun rcd-vcard-formatted-name (fn)
  (if (rcd-string-not-empty-p fn)
      (format "FN:%s\n" fn)
    ""))

(defun rcd-vcard-name (last &optional first middle prefix suffix)
  (if (rcd-string-not-empty-p last)
      (let ((first (or first ""))
	    (middle (or middle ""))
	    (prefix (or prefix ""))
	    (suffix (or suffix "")))
	(format "N;CHARSET=UTF-8:%s;%s;%s;%s;%s;\n" last first middle prefix suffix))
    ""))

(defun cf-contact-geo-location (id)
  (let* ((sql (format "SELECT locations_latitude, locations_longitude FROM locations WHERE locations_contacts = %s" id))
	 (geo (car (rcd-sql-list sql *cf*)))
	 (latitude (car geo))
	 (longitude (cadr geo)))
    (if geo
	(format "geo:%s,%s" latitude longitude)
      nil)))

(defun rcd-cf-contact-vcard-list (id)
  (let* ((hash (rcd-db-table-id-hash-values "people" id *cf*))
	 (prefix (gethash 'people_prefix hash))
	 (first (gethash 'people_firstname hash))
	 (middle (gethash 'people_middlenames hash))
	 (last (gethash 'people_lastname hash))
	 (suffix (gethash 'people_suffix hash))
	 (account (gethash 'people_account1 hash))
	 (company (gethash 'people_account2 hash))
	 (member (gethash 'people_account3 hash))
	 (title (gethash 'people_title hash))
	 (department (gethash 'people_department hash))
	 (birthday (gethash 'people_birthdate hash))
	 (office (gethash 'people_officephone hash))
	 (mobile (gethash 'people_mobilephone hash))
	 (home (gethash 'people_homephone hash))
	 (other (gethash 'people_otherphone hash))
	 (fax (gethash 'people_fax hash))
	 (email1 (gethash 'people_email1 hash))
	 (email2 (gethash 'people_email2 hash))
	 (email3 (gethash 'people_email3 hash))
	 (website (gethash 'people_website1 hash))
	 (blog (gethash 'people_website2 hash))
	 (address1 (gethash 'people_address1 hash))
	 (city1 (gethash 'people_city1 hash))
	 (zip1 (gethash 'people_zip1 hash))
	 (state1 (gethash 'people_state1 hash))
	 (country1 (gethash 'people_country1 hash))
	 (address2 (gethash 'people_address2 hash))
	 (city2 (gethash 'people_city2 hash))
	 (zip2 (gethash 'people_zip2 hash))
	 (state2 (gethash 'people_state2 hash))
	 (country2 (gethash 'people_country2 hash))
	 (note (gethash 'people_description hash))
	 (geo (cf-contact-geo-location id))
	 (geo (if geo (upcase geo) ""))
	 (contact (list prefix first middle last suffix account company member title department birthday office mobile home other fax email1 email2 email3 website blog address1 city1 zip1 state1 country1 address2 city2 zip2 state2 country2 note geo)))
    (mapcar 'string-blank-nil contact)))

(defun rcd-cf-contact-vcard (id)
  (let* ((contact (rcd-cf-contact-vcard-list id))
	 (full-name (cf-get-full-name id))
	 (vcard (rcd-vcard-begin))
	 (prefix (elt contact 0))
	 (first (elt contact 1))
	 (middle (elt contact 2))
	 (last (elt contact 3))
	 (suffix (elt contact 4))
	 (n (rcd-vcard-name last first middle prefix suffix))
	 (vcard (concat vcard n))
	 (fn (concat prefix " " first " " middle " " last " " suffix))
	 (fn (replace-regexp-in-string " +" " " fn))
	 (fn (rcd-vcard-formatted-name fn))
	 (vcard (concat vcard fn))
	 (account (elt contact 5))
	 (company (elt contact 6))
	 (member (elt contact 7))
	 (title (elt contact 8))
	 (department (elt contact 9))
	 (org (rcd-vcard-organization company department))
	 (vcard (concat vcard org))
	 (account-org (rcd-vcard-organization account "Account"))
	 (vcard (concat vcard account-org))
	 (member-org (rcd-vcard-organization member "Member"))
	 (vcard (concat vcard member-org))
	 (vcard (concat vcard (rcd-vcard-title title)))
	 (birthday (elt contact 10))
	 (vcard (concat vcard (rcd-vcard-birthday birthday)))
	 (office (elt contact 11))
	 (mobile (elt contact 12))
	 (home (elt contact 13))
	 (other (elt contact 14))
	 (fax (elt contact 15))
	 (phones (rcd-vcard-phones office mobile home other fax))
	 (vcard (concat vcard phones))
	 (email1 (elt contact 16))
	 (email2 (elt contact 17))
	 (email3 (elt contact 18))
	 (vcard (concat vcard (rcd-vcard-email email1)))
	 (vcard (concat vcard (rcd-vcard-email email2)))
	 (vcard (concat vcard (rcd-vcard-email email3)))
	 (website (elt contact 19))
	 (vcard (concat vcard (rcd-vcard-url website)))
	 (blog (elt contact 20))
	 (vcard (concat vcard (rcd-vcard-url blog)))
	 (address1 (elt contact 21))
	 (city1 (elt contact 22))
	 (zip1 (elt contact 23))
	 (state1 (elt contact 24))
	 (country1 (elt contact 25))
	 (address2 (elt contact 26))
	 (city2 (elt contact 27))
	 (zip2 (elt contact 28))
	 (state2 (elt contact 29))
	 (country2 (elt contact 30))
	 (address (rcd-vcard-address address1 city1 zip1 state1 country1 address2 city2 zip2 state2 country2))
	 (vcard (concat vcard address))
	 (note (elt contact 31))
	 (note (rcd-vcard-note id note))
	 (vcard (concat vcard note))
	 (geo (elt contact 32))
	 (geo (if geo (concat geo "\n") ""))
	 (vcard (concat vcard geo))
	 ;;(vcard (concat vcard note))
	 (vcard (concat vcard (rcd-vcard-end))))
    vcard))

(defun rcd-vcard-mobile-1 ()
  "Exports all vCards for mobile phone #1"
  (interactive)
  (make-directory *rcd-vcard-output* t)
  (let* ((ids (rcd-sql "SELECT addressbookentries_people FROM addressbookentries" *cf*)))
    (string-to-file-force
     (with-output-to-string
       (dolist (id ids)
	 (princ (rcd-cf-contact-vcard id))))
     (concat *rcd-vcard-output* "rcd-people.vcf"))))

(defun cf-contact-vcard-export (id)
  "Export vCard for contact ID"
  (let ((vcard (rcd-cf-contact-vcard id))
	(file (format "%s%08d.vcf" *rcd-vcard-output* id)))
    (string-to-file-force vcard file)
    (message (concat "vCard exported to: " file))))

(provide 'rcd-vcard)
;;; rcd-vcard.el ends here