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

   1 ;;; bbdb-csv-import.el --- import csv to bbdb version 3+
   2
   3 ;; Copyright (C) 2014 by Ian Kelling
   4
   5 ;; Maintainer: Ian Kelling <ian@iankelling.org>
   6 ;; Author: Ian Kelling <ian@iankelling.org>
   7 ;; Created: 1 Apr 2014
   8 ;; Version: 1.1
   9 ;; Package-Requires: ((pcsv "1.3.3") (dash "2.5.0"))
  10 ;; Keywords: csv, util, bbdb
  11 ;; Homepage: https://gitlab.com/iankelling/bbdb-csv-import
  12
  13 ;; This program is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;; Importer of csv (comma separated value) text into Emacs’s bbdb database,
  29 ;; version 3+. Works out of the box with csv exported from Thunderbird, Gmail,
  30 ;; Linkedin, Outlook.com/hotmail, and probably others.
  31 ;; Easily extensible to handle new formats.
  32
  33 ;;; Installation:
  34 ;;
  35 ;; Install bbdb. If you installed this file with a package manager, just
  36 ;;
  37 ;; (require 'bbdb-csv-import)
  38 ;;
  39 ;; Else, note the min versions of dependencies above in "Package-Requires:",
  40 ;; and load this file. I don't know the exact minimum bbdb version.
  41
  42 ;;; Usage:
  43 ;;
  44 ;; You may want to back up existing data in ~/.bbdb and ~/.emacs.d/bbdb in case
  45 ;; you don't like the newly imported data.
  46 ;;
  47 ;; Simply M-x `bbdb-csv-import-buffer' or `bbdb-csv-import-file'.
  48 ;; When called interactively, they prompt for file or buffer arguments.
  49 ;;
  50 ;; Tested to work with thunderbird, gmail, linkedin, outlook.com/hotmail.com For
  51 ;; those programs, if it's exporter has an option of what kind of csv format,
  52 ;; choose it's own native format if available, if not, choose an outlook
  53 ;; compatible format. If you're exporting from some other program, and its csv
  54 ;; exporter claims outlook compatibility, there is a good chance it will work
  55 ;; out of the box.
  56 ;;
  57 ;; If things don't work, you can probably fix it with a field mapping variable.
  58 ;; By default, we use a combination of all predefined mappings, and look for
  59 ;; every known field.  If you have data that is from something we've already
  60 ;; tested, try using it's specific mapping table in case that works better.
  61 ;; Here is a handy template to set each of the predefined mapping tables:
  62 ;;
  63 ;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-combined)
  64 ;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-thunderbird)
  65 ;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-gmail)
  66 ;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-linkedin)
  67 ;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-outlook-web)
  68 ;;
  69 ;; If you need to define your own mapping table, it should not be too hard. Use
  70 ;; the existing tables as an example. Probably best to ignore the combined table
  71 ;; as it is an unnecessary complexity when working on a new table. The doc
  72 ;; string for `bbdb-create-internal' may also be useful. Please send any
  73 ;; new mapping tables to the maintainer listed in this file. The maintainer
  74 ;; should be able to help with any issues and may create a new mapping table
  75 ;; given sample data.
  76 ;;
  77 ;; Misc tips/troubleshooting:
  78 ;; - ASynK looks promising for syncing bbdb/google/outlook.
  79 ;; - The git repo contains a test folder with exactly tested version info and working
  80 ;;   test data.
  81 ;; - bbdb doesn't work if you delete the bbdb database file in
  82 ;;   the middle of an emacs session. If you want to empty the current bbdb database,
  83 ;;   do M-x bbdb then .* then C-u * d on the beginning of a record.
  84 ;; - After changing a mapping table, don't forget to re-execute
  85 ;;   (setq bbdb-csv-import-mapping-table ...) so that it propagates.
  86
  87
  88 ;;; Code:
  89
  90 (require 'pcsv)
  91 (require 'dash)
  92 (require 'bbdb-com)
  93 (eval-when-compile (require 'cl))
  94
  95
  96 (defconst bbdb-csv-import-thunderbird
  97   '(("namelist" "First Name" "Last Name")
  98     ("name" "Display Name")
  99     ("aka" "Nickname")
 100     ("mail" "Primary Email" "Secondary Email")
 101     ("phone" "Work Phone" "Home Phone" "Fax Number" "Pager Number" "Mobile Number")
 102     ("address"
 103      (("home address"
 104        (("Home Address" "Home Address 2")
 105         "Home City" "Home State"
 106         "Home ZipCode" "Home Country"))
 107       ("work address"
 108        (("Work Address" "Work Address 2")
 109         "Work City" "Work State"
 110         "Work ZipCode" "Work Country"))))
 111     ("organization" "Organization")
 112     ("xfields" "Web Page 1" "Web Page 2" "Birth Year" "Birth Month"
 113      "Birth Day" "Department" "Custom 1" "Custom 2" "Custom 3"
 114      "Custom 4" "Notes" "Job Title"))
 115   "Thunderbird csv format")
 116
 117 (defconst bbdb-csv-import-linkedin
 118   '(("namelist" "First Name" "Middle Name" "Last Name")
 119     ("mail" "E-mail Address" "E-mail 2 Address" "E-mail 3 Address")
 120     ("phone"
 121      "Assistant's Phone" "Business Fax" "Business Phone"
 122      "Business Phone 2" "Callback" "Car Phone"
 123      "Company Main Phone" "Home Fax" "Home Phone"
 124      "Home Phone 2" "ISDN" "Mobile Phone"
 125      "Other Fax" "Other Phone" "Pager"
 126      "Primary Phone" "Radio Phone" "TTY/TDD Phone" "Telex")
 127     ("address"
 128      (("business address"
 129        (("Business Street" "Business Street 2" "Business Street 3")
 130         "Business City" "Business State"
 131         "Business Postal Code" "Business Country"))
 132       ("home address"
 133        (("Home Street" "Home Street 2" "Home Street 3")
 134         "Home City" "Home State"
 135         "Home Postal Code" "Home Country"))
 136       ("other address"
 137        (("Other Street" "Other Street 2" "Other Street 3")
 138         "Other City" "Other State"
 139         "Other Postal Code" "Other Country"))))
 140     ("organization" "Company")
 141     ("xfields"
 142      "Suffix" "Department" "Job Title" "Assistant's Name"
 143      "Birthday" "Manager's Name" "Notes" "Other Address PO Box"
 144      "Spouse" "Web Page" "Personal Web Page"))
 145   "Linkedin export in the Outlook csv format.")
 146
 147
 148 ;; note. PO Box and Extended Address are added as additional address street lines if they exist.
 149 ;; If you don't like this, just delete them from this fiel.
 150 ;; If you want some other special handling, it will need to be coded.
 151 (defconst bbdb-csv-import-gmail
 152   '(("namelist" "Given Name" "Family Name")
 153     ("name" "Name")
 154     ("mail" (repeat "E-mail 1 - Value"))
 155     ("phone" (repeat ("Phone 1 - Type" "Phone 1 - Value")))
 156     ("address"
 157      (repeat (("Address 1 - Type")
 158               (("Address 1 - Street" "Address 1 - PO Box" "Address 1 - Extended Address")
 159                "Address 1 - City" "Address 1 - Region"
 160                "Address 1 - Postal Code" "Address 1 - Country"))))
 161     ("organization" (repeat "Organization 1 - Name"))
 162     ("xfields"
 163      "Additional Name" "Yomi Name" "Given Name Yomi"
 164      "Additional Name Yomi" "Family Name Yomi" "Name Prefix"
 165      "Name Suffix" "Initials" "Nickname"
 166      "Short Name" "Maiden Name" "Birthday"
 167      "Gender" "Location" "Billing Information"
 168      "Directory Server" "Mileage" "Occupation"
 169      "Hobby" "Sensitivity" "Priority"
 170      "Subject" "Notes" "Group Membership"
 171      ;; Gmail wouldn't let me add more than 1 organization, but no harm in
 172      ;; looking for multiple since the field name implies the possibility.
 173      (repeat
 174       "Organization 1 - Type" "Organization 1 - Yomi Name"
 175       "Organization 1 - Title" "Organization 1 - Department"
 176       "Organization 1 - Symbol" "Organization 1 - Location"
 177       "Organization 1 - Job Description")
 178      (repeat ("Relation 1 - Type" "Relation 1 - Value"))
 179      (repeat ("Website 1 - Type" "Website 1 - Value"))
 180      (repeat ("Event 1 - Type" "Event 1 - Value"))
 181      (repeat ("Custom Field 1 - Type" "Custom Field 1 - Value"))))
 182   "Gmail csv export format")
 183
 184
 185 (defconst bbdb-csv-import-gmail-typed-email
 186   (append  (car (last bbdb-csv-import-gmail)) '((repeat "E-mail 1 - Type")))
 187   "Like the first Gmail mapping, but use custom fields to store
 188    Gmail's email labels. This is separate because I assume most
 189    people don't use those labels and using the default labels
 190    would create useless custom fields.")
 191
 192 (defconst bbdb-csv-import-outlook-web
 193   '(("namelist" "First Name" "Middle Name" "Last Name")
 194     ("mail" "E-mail Address" "E-mail 2 Address" "E-mail 3 Address")
 195     ("phone"
 196      "Assistant's Phone" "Business Fax" "Business Phone"
 197      "Business Phone 2" "Callback" "Car Phone"
 198      "Company Main Phone" "Home Fax" "Home Phone"
 199      "Home Phone 2" "ISDN" "Mobile Phone"
 200      "Other Fax" "Other Phone" "Pager"
 201      "Primary Phone" "Radio Phone" "TTY/TDD Phone" "Telex")
 202     ("address"
 203      (("business address"
 204        (("Business Street")
 205         "Business City" "Business State"
 206         "Business Postal Code" "Business Country"))
 207       ("home address"
 208        (("Home Street")
 209         "Home City" "Home State"
 210         "Home Postal Code" "Home Country"))
 211       ("other address"
 212        (("Other Street")
 213         "Other City" "Other State"
 214         "Other Postal Code" "Other Country"))))
 215     ("organization" "Company")
 216     ("xfields"
 217      "Anniversary" "Family Name Yomi" "Given Name Yomi"
 218      "Suffix" "Department" "Job Title" "Birthday" "Manager's Name" "Notes"
 219      "Spouse" "Web Page"))
 220   "Hotmail.com, outlook.com, live.com, etc.
 221 Based on 'Export for outlook.com and other services',
 222 not the export for Outlook 2010 and 2013.")
 223
 224 (defconst bbdb-csv-import-outlook-typed-email
 225   (append  (car (last bbdb-csv-import-outlook-web)) '((repeat "E-mail 1 - Type")))
 226   "Like the previous var, but for outlook-web.
 227 Adds email labels as custom fields.")
 228
 229
 230 (defun bbdb-csv-import-flatten1 (list)
 231   "flatten LIST by 1 level."
 232   (--reduce-from (if (consp it)
 233                      (-concat acc it)
 234                    (-snoc acc it))
 235                  nil list))
 236
 237
 238 (defun bbdb-csv-import-merge-map (root)
 239   "Combine two root mappings."
 240   (bbdb-csv-import-flatten1
 241    (list root
 242          (-distinct
 243           (append
 244            (cdr (assoc root bbdb-csv-import-thunderbird))
 245            (cdr (assoc root bbdb-csv-import-linkedin))
 246            (cdr (assoc root bbdb-csv-import-gmail))
 247            (cdr (assoc root bbdb-csv-import-outlook-web)))))))
 248
 249
 250 (defconst bbdb-csv-import-combined
 251   (list
 252    ;; manually combined for proper ordering
 253    '("namelist" "First Name" "Given Name" "Middle Name" "Last Name" "Family Name")
 254    (bbdb-csv-import-merge-map "name")
 255    (bbdb-csv-import-merge-map "aka")
 256    (bbdb-csv-import-merge-map "mail")
 257    (bbdb-csv-import-merge-map "phone")
 258    ;; manually combined the addresses. Because it was easier.
 259    '("address"
 260      (repeat (("Address 1 - Type")
 261               (("Address 1 - Street" "Address 1 - PO Box" "Address 1 - Extended Address")
 262                "Address 1 - City" "Address 1 - Region"
 263                "Address 1 - Postal Code" "Address 1 - Country")))
 264      (("business address"
 265        (("Business Street" "Business Street 2" "Business Street 3")
 266         "Business City" "Business State"
 267         "Business Postal Code" "Business Country"))
 268       ("home address"
 269        (("Home Street" "Home Street 2" "Home Street 3"
 270          "Home Address" "Home Address 2")
 271         "Home City" "Home State"
 272         "Home Postal Code" "Home ZipCode" "Home Country"))
 273       ("work address"
 274        (("Work Address" "Work Address 2")
 275         "Work City" "Work State"
 276         "Work ZipCode" "Work Country"))
 277       ("other address"
 278        (("Other Street" "Other Street 2" "Other Street 3")
 279         "Other City" "Other State"
 280         "Other Postal Code" "Other Country"))))
 281    (bbdb-csv-import-merge-map "organization")
 282    (bbdb-csv-import-merge-map "xfields")))
 283
 284 (defvar bbdb-csv-import-mapping-table bbdb-csv-import-combined
 285   "The table which maps bbdb fields to csv fields. The default should work for most cases.
 286 See the commentary section of this file for more details.")
 287
 288
 289 ;;;###autoload
 290 (defun bbdb-csv-import-file (filename)
 291   "Parse and import csv file FILENAME to bbdb."
 292   (interactive "fCSV file containg contact data: ")
 293   (bbdb-csv-import-buffer (find-file-noselect filename)))
 294
 295 ;;;###autoload
 296 (defun bbdb-csv-import-buffer (&optional buffer-or-name)
 297   "Parse and import csv BUFFER-OR-NAME to bbdb.
 298 Argument is a buffer or name of a buffer.
 299 Defaults to current buffer."
 300   (interactive "bBuffer containing CSV contact data: ")
 301   (when (null bbdb-csv-import-mapping-table)
 302     (error "error: `bbdb-csv-import-mapping-table' is nil. Please set it and rerun."))
 303   (let* ((csv-fields (pcsv-parse-buffer (get-buffer (or buffer-or-name (current-buffer)))))
 304          (csv-contents (cdr csv-fields))
 305          (csv-fields (car csv-fields))
 306          (initial-duplicate-value bbdb-allow-duplicates)
 307          csv-record rd assoc-plus flatten1)
 308     ;; convenient function names
 309     (fset 'rd 'bbdb-csv-import-rd)
 310     (fset 'assoc-plus 'bbdb-csv-import-assoc-plus)
 311     ;; Easier to allow duplicates and handle them post import vs failing as
 312     ;; soon as we find one.
 313     (setq bbdb-allow-duplicates t)
 314     ;; loop over the csv records
 315     (while (setq csv-record (map 'list 'cons csv-fields (pop csv-contents)))
 316       (cl-flet*
 317           ((replace-num (num string)
 318                         ;; in STRING, replace all groups of numbers with NUM
 319                         (replace-regexp-in-string "[0-9]+" (number-to-string num) string))
 320            (expand-repeats (list)
 321                            ;; return new list where elements from LIST in form
 322                            ;; (repeat elem1 ...) become ((elem1 ...) [(elem2 ...)] ...)
 323                            ;; For as many repeating numbered fields exist in the csv fields.
 324                            ;; elem can be a string or a tree (a list with possibly lists inside it)
 325                            (--reduce-from
 326                             (if (not (and (consp it) (eq (car it) 'repeat)))
 327                                 (cons it acc)
 328                               (setq it (cdr it))
 329                               (let* ((i 1)
 330                                      (first-field (car (flatten it))))
 331                                 (setq acc (cons it acc))
 332                                 ;; use first-field to test if there is another repetition.
 333                                 (while (member
 334                                         (replace-num (setq i (1+ i)) first-field)
 335                                         csv-fields)
 336                                   (cl-labels ((fun (cell)
 337                                                    (if (consp cell)
 338                                                        (mapcar #'fun cell)
 339                                                      (replace-num i cell))))
 340                                     (setq acc (cons (fun it) acc))))
 341                                 acc))
 342                             nil list))
 343            (map-bbdb (root)
 344                      ;; ROOT = a root element from bbdb-csv-import-mapping-table.
 345                      ;; Get the actual csv-fields, including variably repeated ones. flattened
 346                      ;; by one because repeated fields are put in sub-lists, but
 347                      ;; after expanding them, that extra depth is no longer
 348                      ;; useful. Small quirk: address mappings without 'repeat
 349                      ;; need to be grouped in a list because they contain sublists that we
 350                      ;; don't want flattened. Better this than more complex code.
 351                      (bbdb-csv-import-flatten1
 352                       (expand-repeats (cdr (assoc root bbdb-csv-import-mapping-table)))))
 353            (rd-assoc (root)
 354                      ;; given ROOT, return a list of data, ignoring empty fields
 355                      (rd (lambda (elem) (assoc-plus elem csv-record)) (map-bbdb root)))
 356            (assoc-expand (e)
 357                          ;; E = data-field-name | (field-name-field data-field)
 358                          ;; get data from the csv-record and return
 359                          ;; (field-name data) or nil.
 360                          (let ((data-name (if (consp e) (cdr (assoc (car e) csv-record)) e))
 361                                (data (assoc-plus (if (consp e) (cadr e) e) csv-record)))
 362                            (if data (list data-name data))))
 363            (map-assoc (field)
 364                       ;; For simple mappings, get a single result
 365                       (car (rd-assoc field))))
 366
 367         (let ((name (let ((name (rd-assoc "namelist")))
 368                       ;; prioritize any combination of first middle last over "name"
 369                       (if (>= (length name) 2)
 370                           (mapconcat 'identity name " ")
 371                         (map-assoc "name"))))
 372               (phone (rd 'vconcat (rd #'assoc-expand (map-bbdb "phone"))))
 373               (mail (rd-assoc "mail"))
 374               (xfields (rd (lambda (list)
 375                              (let ((e (car list)))
 376                                (while (string-match "-" e)
 377                                  (setq e (replace-match "" nil nil e)))
 378                                (while (string-match " +" e)
 379                                  (setq e (replace-match "-" nil nil e)))
 380                                (setq e (make-symbol (downcase e)))
 381                                (cons e (cadr list)))) ;; change from (a b) to (a . b)
 382                            (rd #'assoc-expand (map-bbdb "xfields"))))
 383               (address (rd (lambda (e)
 384
 385                              (let ((address-lines (rd (lambda (elem)
 386                                                         (assoc-plus elem csv-record))
 387                                                       (caadr e)))
 388                                    ;; little bit of special handling so we can
 389                                    ;; use the combined mapping
 390                                    (address-data (--reduce-from (if (member it csv-fields)
 391                                                                     (cons (cdr (assoc it csv-record)) acc)
 392                                                                   acc)
 393                                                                 nil (cdadr e)))
 394                                    (elem-name (car e)))
 395                                (setq address-lines (nreverse address-lines))
 396                                (setq address-data (nreverse address-data))
 397                                ;; make it a list of at least 2 elements
 398                                (setq address-lines (append address-lines
 399                                                            (-repeat (- 2 (length address-lines)) "")))
 400                                (when (consp elem-name)
 401                                  (setq elem-name (cdr (assoc (car elem-name) csv-record))))
 402
 403                                ;; determine if non-nil and put together the  minimum set
 404                                (when (or (not (--all? (zerop (length it)) address-data))
 405                                          (not (--all? (zerop (length it)) address-lines)))
 406                                  (when (> 2 (length address-lines))
 407                                    (setcdr (max 2 (nthcdr (--find-last-index (not (null it))
 408                                                                              address-lines)
 409                                                           address-lines)) nil))
 410                                  (vconcat (list elem-name) (list address-lines) address-data))))
 411                            (map-bbdb "address")))
 412               (organization (rd-assoc "organization"))
 413               (affix (map-assoc "affix"))
 414               (aka (rd-assoc "aka")))
 415           (bbdb-create-internal name affix aka organization mail phone address xfields t))))
 416     (setq bbdb-allow-duplicates initial-duplicate-value)))
 417
 418
 419 (defun bbdb-csv-import-rd (func list)
 420   "like mapcar but don't build nil results into the resulting list"
 421   (--reduce-from (let ((funcreturn (funcall func it)))
 422                    (if funcreturn
 423                        (cons funcreturn acc)
 424                      acc))
 425                  nil list))
 426
 427 (defun bbdb-csv-import-assoc-plus (key list)
 428   "Like (cdr assoc ...) but turn an empty string result to nil."
 429   (let ((result (cdr (assoc key list))))
 430     (when (not (string= "" result))
 431       result)))
 432
 433
 434
 435 (provide 'bbdb-csv-import)
 436
 437 ;;; bbdb-csv-import.el ends here