initial version

diff --git a/bbdb3-csv-import.el b/bbdb3-csv-import.el
new file mode 100644 (file)
index 0000000..da817cf
--- /dev/null
+++ b/bbdb3-csv-import.el
@@ -0,0 +1,182 @@
+;;; bbdb3-csv-import.el  --- import csv to bbdb version 3+ -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014 by Ian Kelling
+
+;; Author: Ian Kelling <ian@iankelling.org>
+;; Created: 1 Apr 2014
+;; Version: 1.0
+;; Keywords: csv, util, bbdb
+
+;; 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:
+
+;; Some tools such as Thunderbird and Outlook allow for exporting contact data as
+;; CSV (Comma Separated Value) files.  This package, `bbdb3-csv-import.el', allows
+;; for importing such files into Emacs's bbdb database, version 3+.
+
+;;; Installation:
+;;
+;; dependencies. Available in marmalade/melpa or via the internet
+;; pcsv.el, dash.el, bbdb
+;; 
+;; (load-file FILENAME-OF-THIS-FILE)
+;; or
+;; (add-to-list 'load-path DIRECTORY-CONTAINING-THIS-FILE)
+;; (require 'bbdb3-csv-import)
+
+;;; Usage:
+;;
+;; Backup or rename ~/.bbdb while testing that the import works correctly
+;;
+;; Simply call `bbdb3-csv-import-buffer' or `bbdb3-csv-import-file'. Interactively
+;; they prompt for file/buffer. Use non-interactively for no prompts.
+;;
+;; Thunderbird csv data works out of the box. Otherwise you will need to create
+;; a mapping table to suit your data and assign it to
+;; bbdb3-csv-import-mapping-table. Please send any new mapping tables upstream so
+;; I can add it to this file for other's benefit. Ian Kelling is willing to help
+;; if any issues arise.
+;;
+
+(require 'pcsv)
+(require 'bbdb)
+(require 'dash)
+
+
+(defvar bbdb3-csv-import-mapping-table bbdb3-csv-import-thunderbird
+  "The table which maps bbdb3 fields to csv fields.
+Use the default as an example to map non-thunderbird data.
+Name used is firstname + lastname or name.
+After the car, all names should map to whatever csv
+field names are used in the first row of csv data.
+Many fields are optional. If you aren't sure if one is,
+best to just try it. The doc string for `bbdb-create-internal'
+may be useful for determining which fields are required.")
+
+(defconst bbdb3-csv-import-thunderbird
+      '(("firstname" "First Name")
+        ("lastname" "Last Name")
+        ("name" "Display Name")
+        ("aka" "Nickname")
+        ("mail" "Primary Email" "Secondary Email")
+        ("phone" "Work Phone" "Home Phone" "Fax Number" "Pager Number" "Mobile Number")
+        ("address"
+         ("home address" (("Home Address"
+                           "Home Address 2")
+                          "Home City"
+                          "Home State"
+                          "Home ZipCode"
+                          "Home Country"))
+         ("work address" (("Work Address"
+                           "Work Address 2")
+                          "Work City"
+                          "Work State"
+                          "Work ZipCode"
+                          "Work Country")))
+        ("organization" ("Organization"))
+        ("xfields" "Web Page 1" "Web Page 2" "Birth Year" "Birth Month"
+         "Birth Day" "Department" "Custom 1" "Custom 2" "Custom 3"
+         "Custom 4" "Notes" "Job Title")))
+
+
+;;;###autoload
+(defun bbdb3-csv-import-file (filename)
+  "Parse and import csv file FILENAME to bbdb3."
+  (interactive "fCSV file containg contact data: ")
+  (bbdb3-csv-import-buffer (find-file-noselect filename)))
+
+
+;;;###autoload
+(defun bbdb3-csv-import-buffer (&optional buffer-or-name) 
+  "Parse and import csv BUFFER-OR-NAME to bbdb3.
+Argument is a buffer or name of a buffer.
+Defaults to current buffer."
+  (interactive "bBuffer containing CSV contact data: ")
+  (let* ((csv-fields (pcsv-parse-buffer (get-buffer (or buffer-or-name (current-buffer)))))
+         (csv-contents (cdr csv-fields))
+         (csv-fields (car csv-fields))
+         (initial-duplicate-value bbdb-allow-duplicates)
+         csv-record)
+    ;; Easier to allow duplicates and handle them post import vs failing as
+    ;; soon as we find one.
+    (setq bbdb-allow-duplicates t)
+    (while (setq csv-record (map 'list 'cons csv-fields (pop csv-contents)))
+      (cl-flet* 
+          ((rd-assoc (list) (rd (lambda (elem) (assoc-plus elem csv-record)) list))
+           (mapcar-assoc (list) (mapcar (lambda (elem) (cdr (assoc elem csv-record))) list))
+           (field-map (field) (cdr (assoc field bbdb3-csv-import-mapping-table)))
+           (map-assoc (field) (assoc-plus (car (field-map field)) csv-record))
+           ;; EPA compliance (Emacs pollution agency)
+           (rd bbdb3-csv-import-reduce)
+           (assoc-plus bbdb3-csv-import-assoc-plus))
+        (let ((name (let ((first (map-assoc "firstname"))
+                          (last (map-assoc "lastname"))
+                          (name (map-assoc "name")))
+                      (if (and first last)
+                          (cons first last)
+                        (or name first last ""))))
+              (phone (rd (lambda (elem)
+                           (let ((data (assoc-plus elem csv-record)))
+                             (if data (vconcat (list elem data)))))
+                         (field-map "phone")))
+              (xfields (rd (lambda (field)
+                             (let ((value (assoc-plus field csv-record)))
+                               (when value
+                                 (while (string-match " " field)
+                                   ;; turn csv field names into symbols for extra fields
+                                   (setq field (replace-match "" nil nil field)))
+                                 (cons (make-symbol (downcase field)) value))))
+                           (field-map "xfields")))
+              (address (rd (lambda (x)
+                             (let ((address-lines (mapcar-assoc (caadr x)))
+                                   (address-data (mapcar-assoc (cdadr x))))
+                               ;; determine if non-nil and put together the  minimum set
+                               (when (or (not (-all? '(lambda (arg) (zerop (length arg))) address-data))
+                                         (not (-all? '(lambda (arg) (zerop (length arg))) address-lines)))
+                                 (when (> 2 (length address-lines))
+                                   (setcdr (max 2 (nthcdr (-find-last-index (lambda (x) (not (null x)))
+                                                                            address-lines)
+                                                          address-lines)) nil))
+                                 (vconcat (list (car x)) (list address-lines) address-data))))
+                           (cdr (assoc "address" bbdb3-csv-import-mapping-table))))
+              (mail (rd-assoc (field-map "mail")))
+              (organization (rd-assoc (field-map "organization")))
+              (affix (map-assoc "affix"))
+              (aka (rd-assoc (field-map "aka"))))
+          (bbdb-create-internal name affix aka organization mail
+                                phone address xfields t)))))
+  (setq bbdb-allow-duplicates initial-duplicate-value))
+
+
+;;;###autoload
+(defun bbdb3-csv-import-reduce (func list)
+  "like mapcar but don't build nil results into the resulting list"
+  (-reduce-from (lambda (acc elem)
+                  (let ((funcreturn (funcall func elem)))
+                    (if funcreturn
+                        (cons funcreturn acc)
+                      acc)))
+                nil list))
+
+;;;###autoload
+(defun bbdb3-csv-import-assoc-plus (key list)
+  "Like `assoc' but turn an empty string result to nil."
+  (let ((result (cdr (assoc key list))))
+    (when (not (string= "" result))
+      result)))
+
+(provide 'bbdb3-csv-import)
+
+;;; bbdb3-csv-import.el ends here