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") (bbdb "20140412.1949"))
  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 ;; 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. The exact minimum bbdb version is unknown, something 3+.
  41 ;;
  42 ;;; Basic Usage:
  43 ;;
  44 ;; Back up bbdb by copying `bbdb-file' in case things go wrong.
  45 ;;
  46 ;; Simply M-x `bbdb-csv-import-buffer' or `bbdb-csv-import-file'.
  47 ;; When called interactively, they prompt for file or buffer arguments.
  48
  49 ;;; Advanced usage / notes:
  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 ;; Duplicate contacts (according to email address) are skipped if
  58 ;; bbdb-allow-duplicates is nil (default). Any duplicates found are echoed at
  59 ;; the end of the import.
  60 ;;
  61 ;; If things don't work, you can probably fix it with a custom field mapping
  62 ;; variable. It should not be too hard. Use the existing tables as an
  63 ;; example. By default, we use a combination of most predefined mappings, and
  64 ;; look for all of their fields, but it is probably best to avoid that kind of
  65 ;; table when setting up your own as it is an unnecessary complexity in that
  66 ;; case. If you have a problem with data from a supported export program, start
  67 ;; by testing its specific mapping table instead of the combined one. Here is a
  68 ;; handy template to set each of the predefined mapping tables if you would
  69 ;; rather avoid the configure interface:
  70 ;;
  71 ;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-combined)
  72 ;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-thunderbird)
  73 ;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-gmail)
  74 ;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-gmail-typed-email)
  75 ;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-linkedin)
  76 ;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-outlook-web)
  77 ;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-outlook-typed-email)
  78 ;;
  79 ;; In addition to the examples, the doc string for `bbdb-create-internal' may
  80 ;; also be useful. Please send any new mapping tables to the maintainer listed
  81 ;; in this file. The maintainer should be able to help with any issues and may
  82 ;; create a new mapping table given sample data.
  83 ;;
  84 ;; Misc tips/troubleshooting:
  85 ;; - ASynK looks promising for syncing bbdb/google/outlook.
  86 ;; - The git repo contains a test folder with exactly tested version info and working
  87 ;;   test data.
  88 ;; - bbdb doesn't work if you delete the bbdb database file in
  89 ;;   the middle of an emacs session. If you want to empty the current bbdb database,
  90 ;;   do M-x bbdb then .* then C-u * d on the beginning of a record.
  91 ;; - After changing a mapping table variable, don't forget to re-execute
  92 ;;   (setq bbdb-csv-import-mapping-table ...) so that it propagates.
  93
  94
  95 ;;; Code:
  96 (require 'pcsv)
  97 (require 'dash)
  98 (require 'bbdb-com)
  99 (eval-when-compile (require 'cl))
 100
 101
 102 (defconst bbdb-csv-import-thunderbird
 103   '((:namelist "First Name" "Last Name")
 104     (:name "Display Name")
 105     (:aka "Nickname")
 106     (:mail "Primary Email" "Secondary Email")
 107     (:phone "Work Phone" "Home Phone" "Fax Number" "Pager Number" "Mobile Number")
 108     (:address
 109      (("home address"
 110        (("Home Address" "Home Address 2")
 111         "Home City" "Home State"
 112         "Home ZipCode" "Home Country"))
 113       ("work address"
 114        (("Work Address" "Work Address 2")
 115         "Work City" "Work State"
 116         "Work ZipCode" "Work Country"))))
 117     (:organization "Organization")
 118     (:xfields "Web Page 1" "Web Page 2" "Birth Year" "Birth Month"
 119               "Birth Day" "Department" "Custom 1" "Custom 2" "Custom 3"
 120               "Custom 4" "Notes" "Job Title"))
 121   "Thunderbird csv format")
 122
 123 (defconst bbdb-csv-import-linkedin
 124   '((:namelist "First Name" "Middle Name" "Last Name")
 125     (:affix "Suffix")
 126     (:mail "E-mail Address" "E-mail 2 Address" "E-mail 3 Address")
 127     (:phone
 128      "Assistant's Phone" "Business Fax" "Business Phone"
 129      "Business Phone 2" "Callback" "Car Phone"
 130      "Company Main Phone" "Home Fax" "Home Phone"
 131      "Home Phone 2" "ISDN" "Mobile Phone"
 132      "Other Fax" "Other Phone" "Pager"
 133      "Primary Phone" "Radio Phone" "TTY/TDD Phone" "Telex")
 134     (:address
 135      (("business address"
 136        (("Business Street" "Business Street 2" "Business Street 3")
 137         "Business City" "Business State"
 138         "Business Postal Code" "Business Country"))
 139       ("home address"
 140        (("Home Street" "Home Street 2" "Home Street 3")
 141         "Home City" "Home State"
 142         "Home Postal Code" "Home Country"))
 143       ("other address"
 144        (("Other Street" "Other Street 2" "Other Street 3")
 145         "Other City" "Other State"
 146         "Other Postal Code" "Other Country"))))
 147     (:organization "Company")
 148     (:xfields
 149      "Department" "Job Title" "Assistant's Name"
 150      "Birthday" "Manager's Name" "Notes" "Other Address PO Box"
 151      "Spouse" "Web Page" "Personal Web Page"))
 152   "Linkedin export in the Outlook csv format.")
 153
 154
 155 (defconst bbdb-csv-import-gmail
 156   '((:namelist "Given Name" "Family Name")
 157     (:name "Name")
 158     (:affix "Name Prefix" "Name Suffix")
 159     (:aka "Nickname")
 160     (:mail (repeat "E-mail 1 - Value"))
 161     (:phone (repeat ("Phone 1 - Type" "Phone 1 - Value")))
 162     (:address
 163      (repeat (("Address 1 - Type")
 164               (("Address 1 - Street" "Address 1 - PO Box" "Address 1 - Extended Address")
 165                "Address 1 - City" "Address 1 - Region"
 166                "Address 1 - Postal Code" "Address 1 - Country"))))
 167     (:organization (repeat "Organization 1 - Name"))
 168     (:xfields
 169      "Additional Name" "Yomi Name" "Given Name Yomi"
 170      "Additional Name Yomi" "Family Name Yomi"
 171      "Initials" "Short Name" "Maiden Name" "Birthday"
 172      "Gender" "Location" "Billing Information"
 173      "Directory Server" "Mileage" "Occupation"
 174      "Hobby" "Sensitivity" "Priority"
 175      "Subject" "Notes" "Group Membership"
 176      ;; Gmail wouldn't let me add more than 1 organization in its web interface,
 177      ;; but no harm in looking for multiple since the field name implies the
 178      ;; possibility.
 179      (repeat
 180       "Organization 1 - Type" "Organization 1 - Yomi Name"
 181       "Organization 1 - Title" "Organization 1 - Department"
 182       "Organization 1 - Symbol" "Organization 1 - Location"
 183       "Organization 1 - Job Description")
 184      (repeat ("Relation 1 - Type" "Relation 1 - Value"))
 185      (repeat ("Website 1 - Type" "Website 1 - Value"))
 186      (repeat ("Event 1 - Type" "Event 1 - Value"))
 187      (repeat ("Custom Field 1 - Type" "Custom Field 1 - Value"))))
 188   "Gmail csv export format. Note some fields don't map perfectly,
 189 feel free to modify them as you wish. \"PO Box\" and \"Extended
 190 Address\" are added as additional address street lines if they
 191 exist. Some special name fields are made custom instead of put in
 192 name, which gets a single string. We map Gmail's \"Name Prefix\"
 193 and \"Name Suffix\" to bbdb's affix (a list of strings). We lose
 194 the prefix/suffix label, but those are usually obvious.")
 195
 196
 197 (defconst bbdb-csv-import-gmail-typed-email
 198   (append  (car (last bbdb-csv-import-gmail)) '((repeat "E-mail 1 - Type")))
 199   "Like the first Gmail mapping, but use custom fields to store
 200    Gmail's email labels. This is separate because I assume most
 201    people don't use those labels and using the default labels
 202    would create useless custom fields.")
 203
 204 (defconst bbdb-csv-import-outlook-web
 205   '((:namelist "First Name" "Middle Name" "Last Name")
 206     (:mail "E-mail Address" "E-mail 2 Address" "E-mail 3 Address")
 207     (:affix "Suffix")
 208     (:phone
 209      "Assistant's Phone" "Business Fax" "Business Phone"
 210      "Business Phone 2" "Callback" "Car Phone"
 211      "Company Main Phone" "Home Fax" "Home Phone"
 212      "Home Phone 2" "ISDN" "Mobile Phone"
 213      "Other Fax" "Other Phone" "Pager"
 214      "Primary Phone" "Radio Phone" "TTY/TDD Phone" "Telex")
 215     (:address
 216      (("business address"
 217        (("Business Street")
 218         "Business City" "Business State"
 219         "Business Postal Code" "Business Country"))
 220       ("home address"
 221        (("Home Street")
 222         "Home City" "Home State"
 223         "Home Postal Code" "Home Country"))
 224       ("other address"
 225        (("Other Street")
 226         "Other City" "Other State"
 227         "Other Postal Code" "Other Country"))))
 228     (:organization "Company")
 229     (:xfields
 230      "Anniversary" "Family Name Yomi" "Given Name Yomi"
 231      "Department" "Job Title" "Birthday" "Manager's Name" "Notes"
 232      "Spouse" "Web Page"))
 233   "Hotmail.com, outlook.com, live.com, etc.
 234 Based on 'Export for outlook.com and other services',
 235 not the export for Outlook 2010 and 2013.")
 236
 237 (defconst bbdb-csv-import-outlook-typed-email
 238   (append  (car (last bbdb-csv-import-outlook-web)) '((repeat "E-mail 1 - Type")))
 239   "Like bbdb-csv-import-gmail-typed-email, but for outlook-web.
 240 Adds email labels as custom fields.")
 241
 242
 243 (defun bbdb-csv-import-flatten1 (list)
 244   "Flatten LIST by 1 level."
 245   (--reduce-from (if (consp it)
 246                      (-concat acc it)
 247                    (-snoc acc it))
 248                  nil list))
 249
 250
 251 (defun bbdb-csv-import-merge-map (root)
 252   "Combine two root mappings for making a combined mapping."
 253   (bbdb-csv-import-flatten1
 254    (list root
 255          (-distinct
 256           (append
 257            (cdr (assoc root bbdb-csv-import-thunderbird))
 258            (cdr (assoc root bbdb-csv-import-linkedin))
 259            (cdr (assoc root bbdb-csv-import-gmail))
 260            (cdr (assoc root bbdb-csv-import-outlook-web)))))))
 261
 262
 263 (defconst bbdb-csv-import-combined
 264   (list
 265    ;; manually combined for proper ordering
 266    '(:namelist "First Name" "Given Name" "Middle Name" "Last Name" "Family Name")
 267    (bbdb-csv-import-merge-map :name)
 268    (bbdb-csv-import-merge-map :affix)
 269    (bbdb-csv-import-merge-map :aka)
 270    (bbdb-csv-import-merge-map :mail)
 271    (bbdb-csv-import-merge-map :phone)
 272    ;; manually combined the addresses. Because it was easier.
 273    '(:address
 274      (repeat (("Address 1 - Type")
 275               (("Address 1 - Street" "Address 1 - PO Box" "Address 1 - Extended Address")
 276                "Address 1 - City" "Address 1 - Region"
 277                "Address 1 - Postal Code" "Address 1 - Country")))
 278      (("business address"
 279        (("Business Street" "Business Street 2" "Business Street 3")
 280         "Business City" "Business State"
 281         "Business Postal Code" "Business Country"))
 282       ("home address"
 283        (("Home Street" "Home Street 2" "Home Street 3"
 284          "Home Address" "Home Address 2")
 285         "Home City" "Home State"
 286         "Home Postal Code" "Home ZipCode" "Home Country"))
 287       ("work address"
 288        (("Work Address" "Work Address 2")
 289         "Work City" "Work State"
 290         "Work ZipCode" "Work Country"))
 291       ("other address"
 292        (("Other Street" "Other Street 2" "Other Street 3")
 293         "Other City" "Other State"
 294         "Other Postal Code" "Other Country"))))
 295    (bbdb-csv-import-merge-map :organization)
 296    (bbdb-csv-import-merge-map :xfields)))
 297
 298 (defcustom bbdb-csv-import-mapping-table bbdb-csv-import-combined
 299   "The table which maps bbdb fields to csv fields. The default should work for most cases.
 300 See the commentary section of this file for more details."
 301   :group 'bbdb-csv-import
 302   :type 'symbol)
 303
 304
 305 (defun  bbdb-csv-import-expand-repeats (csv-fields list)
 306   "Return new list where elements from LIST in form (repeat elem1 ...)
 307 become ((elem1 ...) [(elem2 ...)] ...) for as many repeating
 308 numbered fields exist in the csv fields. elem can be a string or
 309 a tree (a list with lists inside it)"
 310   (cl-flet ((replace-num (num string)
 311                          ;; in STRING, replace all groups of numbers with NUM
 312                          (replace-regexp-in-string "[0-9]+"
 313                                                    (number-to-string num)
 314                                                    string)))
 315     (--reduce-from
 316      (if (not (and (consp it) (eq (car it) 'repeat)))
 317          (cons it acc)
 318        (setq it (cdr it))
 319        (let* ((i 1)
 320               (first-field (car (flatten it))))
 321          (setq acc (cons it acc))
 322          ;; use first-field to test if there is another repetition.
 323          (while (member
 324                  (replace-num (setq i (1+ i)) first-field)
 325                  csv-fields)
 326            (cl-labels ((fun (cell)
 327                             (if (consp cell)
 328                                 (mapcar #'fun cell)
 329                               (replace-num i cell))))
 330              (setq acc (cons (fun it) acc))))
 331          acc))
 332      nil list)))
 333
 334 (defun bbdb-csv-import-map-bbdb (csv-fields root)
 335   "ROOT is a root element from bbdb-csv-import-mapping-table. Get
 336 the csv-fields for root in the mapping format, including variably
 337 repeated ones. Flatten by one because repeated fields are put in
 338 sub-lists, but after expanding them, that extra depth is no
 339 longer useful. Small trade off: address mappings without 'repeat need
 340 to be grouped in a list because they contain sublists that we
 341 don't want flattened."
 342   (bbdb-csv-import-flatten1
 343    (bbdb-csv-import-expand-repeats
 344     csv-fields
 345     (cdr (assoc root bbdb-csv-import-mapping-table)))))
 346
 347 ;;;###autoload
 348 (defun bbdb-csv-import-file (filename)
 349   "Parse and import csv file FILENAME to bbdb."
 350   (interactive "fCSV file containg contact data: ")
 351   (bbdb-csv-import-buffer (find-file-noselect filename)))
 352
 353 ;;;###autoload
 354 (defun bbdb-csv-import-buffer (&optional buffer-or-name)
 355   "Parse and import csv BUFFER-OR-NAME to bbdb.
 356 Argument is a buffer or name of a buffer.
 357 Defaults to current buffer."
 358   (interactive "bBuffer containing CSV contact data: ")
 359   (when (null bbdb-csv-import-mapping-table)
 360     (error "error: `bbdb-csv-import-mapping-table' is nil. Please set it and rerun."))
 361   (let* ((csv-data (pcsv-parse-buffer (get-buffer (or buffer-or-name (current-buffer)))))
 362          (csv-fields (car csv-data))
 363          (csv-data (cdr csv-data))
 364          (allow-dupes bbdb-allow-duplicates)
 365          csv-record rd assoc-plus map-bbdb dupes)
 366     ;; convenient function names
 367     (fset 'rd 'bbdb-csv-import-rd)
 368     (fset 'assoc-plus 'bbdb-csv-import-assoc-plus)
 369     (fset 'map-bbdb (-partial 'bbdb-csv-import-map-bbdb csv-fields))
 370     ;; we handle duplicates ourselves
 371     (setq bbdb-allow-duplicates t)
 372     ;; loop over the csv records
 373     (while (setq csv-record (map 'list 'cons csv-fields (pop csv-data)))
 374       (cl-flet*
 375           ((ca (key list) (cdr (assoc key list))) ;; utility function
 376            (rd-assoc (root)
 377                      ;; given ROOT, return a list of data, ignoring empty fields
 378                      (rd (lambda (elem) (assoc-plus elem csv-record)) (map-bbdb root)))
 379            (assoc-expand (e)
 380                          ;; E = data-field-name | (field-name-field data-field)
 381                          ;; get data from the csv-record and return (field-name data) or nil.
 382                          (let ((data-name (if (consp e) (ca (car e) csv-record) e))
 383                                (data (assoc-plus (if (consp e) (cadr e) e) csv-record)))
 384                            (if data (list data-name data)))))
 385         ;; set the arguments to bbdb-create-internal, then call it, the end.
 386         (let ((name (let ((name (rd-assoc :namelist)))
 387                       ;; prioritize any combination of first middle last over :name
 388                       (if (>= (length name) 2)
 389                           (mapconcat 'identity name " ")
 390                         (car (rd-assoc :name)))))
 391               (affix (rd-assoc :affix))
 392               (aka (rd-assoc :aka))
 393               (organization (rd-assoc :organization))
 394               (mail (rd-assoc :mail))
 395               (phone (rd 'vconcat (rd #'assoc-expand (map-bbdb :phone))))
 396               (address (rd (lambda (e)
 397
 398                              (let ((al (rd (lambda (elem) ;; al = address lines
 399                                              (assoc-plus elem csv-record))
 400                                            (caadr e)))
 401                                    ;; to use bbdb-csv-import-combined, we can't mapcar
 402                                    (address-data (--reduce-from (if (member it csv-fields)
 403                                                                     (cons (ca it csv-record) acc)
 404                                                                   acc)
 405                                                                 nil (cdadr e)))
 406                                    (elem-name (car e)))
 407                                (setq al (nreverse al))
 408                                (setq address-data (nreverse address-data))
 409                                ;; make it a list of at least 2 elements
 410                                (setq al (append al
 411                                                 (-repeat (- 2 (length al)) "")))
 412                                (when (consp elem-name)
 413                                  (setq elem-name (ca (car elem-name) csv-record)))
 414
 415                                ;; determine if non-nil and put together the  minimum set
 416                                (when (or (not (--all? (zerop (length it)) address-data))
 417                                          (not (--all? (zerop (length it)) al)))
 418                                  (when (> 2 (length al))
 419                                    (setcdr (max 2 (nthcdr (--find-last-index (not (null it))
 420                                                                              al)
 421                                                           al)) nil))
 422                                  (vconcat (list elem-name) (list al) address-data))))
 423                            (map-bbdb :address)))
 424               (xfields (rd (lambda (list)
 425                              (let ((e (car list)))
 426                                (while (string-match "-" e)
 427                                  (setq e (replace-match "" nil nil e)))
 428                                (while (string-match " +" e)
 429                                  (setq e (replace-match "-" nil nil e)))
 430                                (setq e (make-symbol (downcase e)))
 431                                (cons e (cadr list)))) ;; change from (a b) to (a . b)
 432                            (rd #'assoc-expand (map-bbdb :xfields)))))
 433           ;; we copy and subvert bbdb's duplicate detection instead of catching
 434           ;; errors so that we don't interfere with other errors, and can print
 435           ;; them nicely at the end.
 436           (let (found-dupe)
 437             (dolist (elt mail)
 438               (when (bbdb-gethash elt '(mail))
 439                 (push elt dupes)
 440                 (setq found-dupe t)))
 441             (when (or allow-dupes (not found-dupe))
 442               (bbdb-create-internal name affix aka organization mail phone address xfields t))))))
 443     (when dupes (if allow-dupes
 444                     (message "Warning, contacts with duplicate email addresses were imported:\n%s" dupes)
 445                   (message "Skipped contacts with duplicate email addresses:\n%s" dupes)))
 446     (setq bbdb-allow-duplicates allow-dupes)))
 447
 448 (defun bbdb-csv-import-rd (func list)
 449   "like mapcar but don't build nil results into the resulting list"
 450   (--reduce-from (let ((funcreturn (funcall func it)))
 451                    (if funcreturn
 452                        (cons funcreturn acc)
 453                      acc))
 454                  nil list))
 455
 456 (defun bbdb-csv-import-assoc-plus (key list)
 457   "Like (cdr assoc ...) but turn an empty string result to nil."
 458   (let ((result (cdr (assoc key list))))
 459     (when (not (string= "" result))
 460       result)))
 461
 462 (provide 'bbdb-csv-import)
 463
 464 ;;; bbdb-csv-import.el ends here