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 ;; Importer of csv (comma separated value) text into Emacs’s bbdb database,
  26 ;; version 3+. Programs such as Thunderbird and Outlook allow for exporting
  27 ;; 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 as this may be a one time usage:
  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 ;; Assign bbdb3-csv-import-mapping-table to a mapping table. Some are predefined
  46 ;; below, ie. bbdb3-csv-import-thunderbird.
  47 ;;
  48 ;; Simply call `bbdb3-csv-import-buffer' or
  49 ;; `bbdb3-csv-import-file'. Interactively they prompt for file/buffer. Use
  50 ;; non-interactively for no prompts.
  51 ;;
  52 ;; Thunderbird csv data works out of the box. Otherwise you will need to create
  53 ;; a mapping table to suit your data and assign it to
  54 ;; bbdb3-csv-import-mapping-table. Note that variable's doc string and perhaps
  55 ;; the test data within this project for more details. Please send any new
  56 ;; mapping tables upstream so I can add it to this file for other's benefit. I,
  57 ;; Ian Kelling, am willing to help with any issues including creating a mapping
  58 ;; table given sample data.
  59 ;;
  60 ;; Tips for testing: bbdb doesn't work if you delete the bbdb database file in
  61 ;; the middle of an emacs session. If you want to empty the current bbdb database,
  62 ;; do M-x bbdb then .* then C-u * d on the beginning of a record.
  63
  64 (require 'pcsv)
  65 (require 'dash)
  66 (require 'bbdb-com)
  67 (eval-when-compile (require 'cl))
  68
  69 (defconst bbdb3-csv-import-thunderbird
  70   '(("firstname" "First Name")
  71     ("lastname" "Last Name")
  72     ("name" "Display Name")
  73     ("aka" "Nickname")
  74     ("mail" "Primary Email" "Secondary Email")
  75     ("phone" "Work Phone" "Home Phone" "Fax Number" "Pager Number" "Mobile Number")
  76     ("address"
  77      ("home address" (("Home Address"
  78                        "Home Address 2")
  79                       "Home City"
  80                       "Home State"
  81                       "Home ZipCode"
  82                       "Home Country"))
  83      ("work address" (("Work Address"
  84                        "Work Address 2")
  85                       "Work City"
  86                       "Work State"
  87                       "Work ZipCode"
  88                       "Work Country")))
  89     ("organization" "Organization")
  90     ("xfields" "Web Page 1" "Web Page 2" "Birth Year" "Birth Month"
  91      "Birth Day" "Department" "Custom 1" "Custom 2" "Custom 3"
  92      "Custom 4" "Notes" "Job Title"))
  93   "Thunderbird csv format")
  94
  95 (defconst bbdb3-csv-import-linkedin
  96   '(("firstname" "First Name")
  97     ("lastname" "Last Name")
  98     ("middlename" "Middle Name")
  99     ("mail" "E-mail Address" "E-mail 2 Address" "E-mail 3 Address")
 100     ("phone" "Assistant's Phone" "Business Fax" "Business Phone" "Business Phone 2" "Callback" "Car Phone" "Company Main Phone" "Home Fax" "Home Phone" "Home Phone 2" "ISDN" "Mobile Phone" "Other Fax" "Other Phone" "Pager" "Primary Phone" "Radio Phone" "TTY/TDD Phone" "Telex")
 101     ("address"
 102      ("business address" (("Business Street"
 103                            "Business Street 2"
 104                            "Business Street 3")
 105                           "Business City"
 106                           "Business State"
 107                           "Business Postal Code"
 108                           "Business Country"))
 109      ("home address" (("Home Street"
 110                        "Home Street 2"
 111                        "Home Street 3")
 112                       "Home City"
 113                       "Home State"
 114                       "Home Postal Code"
 115                       "Home Country"))
 116      ("other address" (("Other Street"
 117                         "Other Street 2"
 118                         "Other Street 3")
 119                        "Other City"
 120                        "Other State"
 121                        "Other Postal Code"
 122                        "Other Country")))
 123     ("organization" "Company")
 124     ("xfields" "Suffix" "Department" "Job Title" "Assistant's Name" "Birthday" "Manager's Name" "Notes" "Other Address PO Box" "Spouse" "Web Page" "Personal Web Page"))
 125   "Linkedin export in the Outlook csv format.")
 126
 127
 128 (defvar bbdb3-csv-import-mapping-table nil
 129   "The table which maps bbdb3 fields to csv fields.
 130 Use the default as an example to map non-thunderbird data.
 131 Name used is firstname + lastname or name.
 132 After the car, all names should map to whatever csv
 133 field names are used in the first row of csv data.
 134 Many fields are optional. If you aren't sure if one is,
 135 best to just try it. The doc string for `bbdb-create-internal'
 136 may be useful for determining which fields are required.")
 137
 138 ;;;###autoload
 139 (defun bbdb3-csv-import-file (filename)
 140   "Parse and import csv file FILENAME to bbdb3."
 141   (interactive "fCSV file containg contact data: ")
 142   (bbdb3-csv-import-buffer (find-file-noselect filename)))
 143
 144
 145 ;;;###autoload
 146 (defun bbdb3-csv-import-buffer (&optional buffer-or-name)
 147   "Parse and import csv BUFFER-OR-NAME to bbdb3.
 148 Argument is a buffer or name of a buffer.
 149 Defaults to current buffer."
 150   (interactive "bBuffer containing CSV contact data: ")
 151   (let* ((csv-fields (pcsv-parse-buffer (get-buffer (or buffer-or-name (current-buffer)))))
 152          (csv-contents (cdr csv-fields))
 153          (csv-fields (car csv-fields))
 154          (initial-duplicate-value bbdb-allow-duplicates)
 155          csv-record)
 156     ;; Easier to allow duplicates and handle them post import vs failing as
 157     ;; soon as we find one.
 158     (setq bbdb-allow-duplicates t)
 159     (while (setq csv-record (map 'list 'cons csv-fields (pop csv-contents)))
 160       (cl-flet*
 161           ((rd (func list) (bbdb3-csv-import-reduce func list)) ;; just a local defalias
 162            (assoc-plus (key list) (bbdb3-csv-import-assoc-plus key list)) ;; defalias
 163            (rd-assoc (list) (rd (lambda (elem) (assoc-plus elem csv-record)) list))
 164            (mapcar-assoc (list) (mapcar (lambda (elem) (cdr (assoc elem csv-record))) list))
 165            (field-map (field) (cdr (assoc field bbdb3-csv-import-mapping-table)))
 166            (map-assoc (field) (assoc-plus (car (field-map field)) csv-record)))
 167
 168         (let ((name (let ((first (map-assoc "firstname"))
 169                           (middle (map-assoc "middlename"))
 170                           (last (map-assoc "lastname"))
 171                           (name (map-assoc "name")))
 172                       ;; prioritize any combination of first middle last over just "name"
 173                       (if (or (and first last) (and first middle) (and middle last))
 174                           ;; purely historical note.
 175                           ;; it works exactly the same but I don't use (cons first last) due to a bug
 176                           ;; http://www.mail-archive.com/bbdb-info%40lists.sourceforge.net/msg06388.html
 177                           (concat (or first middle) " " (or middle last) (when (and first middle) (concat " " last) ))
 178                         (or name first middle last ""))))
 179               (phone (rd (lambda (mapping-elem)
 180                            (let ((data (assoc-plus mapping-elem csv-record)))
 181                              (if data (vconcat (list mapping-elem data)))))
 182                          (field-map "phone")))
 183               (xfields (rd (lambda (mapping-elem)
 184                              (let ((value (assoc-plus mapping-elem csv-record)))
 185                                (when value
 186                                  (while (string-match " " mapping-elem)
 187                                    ;; turn csv field names into symbols for extra fields
 188                                    (setq mapping-elem (replace-match "" nil nil mapping-elem)))
 189                                  (cons (make-symbol (downcase mapping-elem)) value))))
 190                            (field-map "xfields")))
 191               (address (rd (lambda (mapping-elem)
 192                              (let ((address-lines (mapcar-assoc (caadr mapping-elem)))
 193                                    (address-data (mapcar-assoc (cdadr mapping-elem))))
 194                                ;; determine if non-nil and put together the  minimum set
 195                                (when (or (not (-all? '(lambda (arg) (zerop (length arg))) address-data))
 196                                          (not (-all? '(lambda (arg) (zerop (length arg))) address-lines)))
 197                                  (when (> 2 (length address-lines))
 198                                    (setcdr (max 2 (nthcdr (-find-last-index (lambda (mapping-elem) (not (null mapping-elem)))
 199                                                                             address-lines)
 200                                                           address-lines)) nil))
 201                                  (vconcat (list (car mapping-elem)) (list address-lines) address-data))))
 202                            (field-map "address")))
 203               (mail (rd-assoc (field-map "mail")))
 204               (organization (rd-assoc (field-map "organization")))
 205               (affix (map-assoc "affix"))
 206               (aka (rd-assoc (field-map "aka"))))
 207           (bbdb-create-internal name affix aka organization mail
 208                                 phone address xfields t))))
 209     (setq bbdb-allow-duplicates initial-duplicate-value)))
 210
 211
 212 ;;;###autoload
 213 (defun bbdb3-csv-import-reduce (func list)
 214   "like mapcar but don't build nil results into the resulting list"
 215   (-reduce-from (lambda (acc elem)
 216                   (let ((funcreturn (funcall func elem)))
 217                     (if funcreturn
 218                         (cons funcreturn acc)
 219                       acc)))
 220                 nil list))
 221
 222 ;;;###autoload
 223 (defun bbdb3-csv-import-assoc-plus (key list)
 224   "Like `assoc' but turn an empty string result to nil."
 225   (let ((result (cdr (assoc key list))))
 226     (when (not (string= "" result))
 227       result)))
 228
 229 (provide 'bbdb3-csv-import)
 230
 231 ;;; bbdb3-csv-import.el ends here
 232