iankelling.org Git - bbdb-csv-import/blob - bbdb3-csv-import.el

   1 ;;; bbdb3-csv-import.el  --- import csv to bbdb version 3+ -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2014 by Ian Kelling
   4
   5 ;; Author: Ian Kelling <ian@iankelling.org>
   6 ;; Created: 1 Apr 2014
   7 ;; Version: 1.0
   8 ;; Keywords: csv, util, bbdb
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; This package imports CSV (Comma Separated Value) text files into Emacs's bbdb
  26 ;; database, version 3+.  Programs such as Thunderbird and Outlook allow for
  27 ;; exporting contact data as csv files.
  28
  29 ;;; Installation:
  30 ;;
  31 ;; dependencies: pcsv.el, dash.el, bbdb
  32 ;; These are available via marmalade/melpa or the internet
  33 ;;
  34 ;; Add to init file or execute manually:
  35 ;; (load-file FILENAME-OF-THIS-FILE)
  36 ;; or
  37 ;; (add-to-list 'load-path DIRECTORY-CONTAINING-THIS-FILE)
  38 ;; (require 'bbdb3-csv-import)
  39
  40 ;;; Usage:
  41 ;;
  42 ;; Backup or rename any existing ~/.bbdb and ~/.emacs.d/bbdb while testing that
  43 ;; the import works correctly.
  44 ;;
  45 ;; Simply call `bbdb3-csv-import-buffer' or
  46 ;; `bbdb3-csv-import-file'. Interactively they prompt for file/buffer. Use
  47 ;; non-interactively for no prompts.
  48 ;;
  49 ;; Thunderbird csv data works out of the box. Otherwise you will need to create
  50 ;; a mapping table to suit your data and assign it to
  51 ;; bbdb3-csv-import-mapping-table. Please send any new mapping tables upstream
  52 ;; so I can add it to this file for other's benefit. I, Ian Kelling, am willing
  53 ;; to help with any issues including creating a mapping table given sample data.
  54 ;;
  55 ;; Tips for testing: bbdb doesn't work if you delete the bbdb database file in
  56 ;; the middle of an emacs session. If you want to empty the current bbdb database,
  57 ;; do M-x bbdb then .* then C-u * d on the beginning of a record.
  58
  59 (require 'pcsv)
  60 (require 'dash)
  61 (require 'bbdb-com)
  62 (eval-when-compile (require 'cl))
  63
  64 (defconst bbdb3-csv-import-thunderbird
  65   '(("firstname" "First Name")
  66     ("lastname" "Last Name")
  67     ("name" "Display Name")
  68     ("aka" "Nickname")
  69     ("mail" "Primary Email" "Secondary Email")
  70     ("phone" "Work Phone" "Home Phone" "Fax Number" "Pager Number" "Mobile Number")
  71     ("address"
  72      ("home address" (("Home Address"
  73                        "Home Address 2")
  74                       "Home City"
  75                       "Home State"
  76                       "Home ZipCode"
  77                       "Home Country"))
  78      ("work address" (("Work Address"
  79                        "Work Address 2")
  80                       "Work City"
  81                       "Work State"
  82                       "Work ZipCode"
  83                       "Work Country")))
  84     ("organization" ("Organization"))
  85     ("xfields" "Web Page 1" "Web Page 2" "Birth Year" "Birth Month"
  86      "Birth Day" "Department" "Custom 1" "Custom 2" "Custom 3"
  87      "Custom 4" "Notes" "Job Title")))
  88
  89 (defvar bbdb3-csv-import-mapping-table bbdb3-csv-import-thunderbird
  90   "The table which maps bbdb3 fields to csv fields.
  91 Use the default as an example to map non-thunderbird data.
  92 Name used is firstname + lastname or name.
  93 After the car, all names should map to whatever csv
  94 field names are used in the first row of csv data.
  95 Many fields are optional. If you aren't sure if one is,
  96 best to just try it. The doc string for `bbdb-create-internal'
  97 may be useful for determining which fields are required.")
  98
  99 ;;;###autoload
 100 (defun bbdb3-csv-import-file (filename)
 101   "Parse and import csv file FILENAME to bbdb3."
 102   (interactive "fCSV file containg contact data: ")
 103   (bbdb3-csv-import-buffer (find-file-noselect filename)))
 104
 105
 106 ;;;###autoload
 107 (defun bbdb3-csv-import-buffer (&optional buffer-or-name)
 108   "Parse and import csv BUFFER-OR-NAME to bbdb3.
 109 Argument is a buffer or name of a buffer.
 110 Defaults to current buffer."
 111   (interactive "bBuffer containing CSV contact data: ")
 112   (let* ((csv-fields (pcsv-parse-buffer (get-buffer (or buffer-or-name (current-buffer)))))
 113          (csv-contents (cdr csv-fields))
 114          (csv-fields (car csv-fields))
 115          (initial-duplicate-value bbdb-allow-duplicates)
 116          csv-record)
 117     ;; Easier to allow duplicates and handle them post import vs failing as
 118     ;; soon as we find one.
 119     (setq bbdb-allow-duplicates t)
 120     (while (setq csv-record (map 'list 'cons csv-fields (pop csv-contents)))
 121       (cl-flet*
 122           ((rd (func list) (bbdb3-csv-import-reduce func list)) ;; just a local defalias
 123            (assoc-plus (key list) (bbdb3-csv-import-assoc-plus key list)) ;; defalias
 124            (rd-assoc (list) (rd (lambda (elem) (assoc-plus elem csv-record)) list))
 125            (mapcar-assoc (list) (mapcar (lambda (elem) (cdr (assoc elem csv-record))) list))
 126            (field-map (field) (cdr (assoc field bbdb3-csv-import-mapping-table)))
 127            (map-assoc (field) (assoc-plus (car (field-map field)) csv-record)))
 128
 129         (let ((name (let ((first (map-assoc "firstname"))
 130                           (last (map-assoc "lastname"))
 131                           (name (map-assoc "name")))
 132                       (if (and first last)
 133                           ;; purely historical note.
 134                           ;; it works exactly the same but I don't use (cons first last) due to a bug
 135                           ;; http://www.mail-archive.com/bbdb-info%40lists.sourceforge.net/msg06388.html
 136                           (concat first " " last)
 137                         (or name first last ""))))
 138               (phone (rd (lambda (elem)
 139                            (let ((data (assoc-plus elem csv-record)))
 140                              (if data (vconcat (list elem data)))))
 141                          (field-map "phone")))
 142               (xfields (rd (lambda (field)
 143                              (let ((value (assoc-plus field csv-record)))
 144                                (when value
 145                                  (while (string-match " " field)
 146                                    ;; turn csv field names into symbols for extra fields
 147                                    (setq field (replace-match "" nil nil field)))
 148                                  (cons (make-symbol (downcase field)) value))))
 149                            (field-map "xfields")))
 150               (address (rd (lambda (x)
 151                              (let ((address-lines (mapcar-assoc (caadr x)))
 152                                    (address-data (mapcar-assoc (cdadr x))))
 153                                ;; determine if non-nil and put together the  minimum set
 154                                (when (or (not (-all? '(lambda (arg) (zerop (length arg))) address-data))
 155                                          (not (-all? '(lambda (arg) (zerop (length arg))) address-lines)))
 156                                  (when (> 2 (length address-lines))
 157                                    (setcdr (max 2 (nthcdr (-find-last-index (lambda (x) (not (null x)))
 158                                                                             address-lines)
 159                                                           address-lines)) nil))
 160                                  (vconcat (list (car x)) (list address-lines) address-data))))
 161                            (cdr (assoc "address" bbdb3-csv-import-mapping-table))))
 162               (mail (rd-assoc (field-map "mail")))
 163               (organization (rd-assoc (field-map "organization")))
 164               (affix (map-assoc "affix"))
 165               (aka (rd-assoc (field-map "aka"))))
 166           (bbdb-create-internal name affix aka organization mail
 167                                 phone address xfields t))))
 168     (setq bbdb-allow-duplicates initial-duplicate-value)))
 169
 170
 171 ;;;###autoload
 172 (defun bbdb3-csv-import-reduce (func list)
 173   "like mapcar but don't build nil results into the resulting list"
 174   (-reduce-from (lambda (acc elem)
 175                   (let ((funcreturn (funcall func elem)))
 176                     (if funcreturn
 177                         (cons funcreturn acc)
 178                       acc)))
 179                 nil list))
 180
 181 ;;;###autoload
 182 (defun bbdb3-csv-import-assoc-plus (key list)
 183   "Like `assoc' but turn an empty string result to nil."
 184   (let ((result (cdr (assoc key list))))
 185     (when (not (string= "" result))
 186       result)))
 187
 188 (provide 'bbdb3-csv-import)
 189
 190 ;;; bbdb3-csv-import.el ends here