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