X-Git-Url: https://iankelling.org/git/?p=bbdb-csv-import;a=blobdiff_plain;f=bbdb-csv-import.el;h=b234bd6066eeae900d9e2caa123b4a53f75dabbb;hp=59e6b94a089e1d3e8bdd2df4a8f9d59ebd913021;hb=HEAD;hpb=070a2490fc544397e603f3bbe9d199add023d6c5 diff --git a/bbdb-csv-import.el b/bbdb-csv-import.el index 59e6b94..b234bd6 100644 --- a/bbdb-csv-import.el +++ b/bbdb-csv-import.el @@ -9,6 +9,7 @@ ;; Package-Requires: ((pcsv "1.3.3") (dash "2.5.0") (bbdb "20140412.1949")) ;; Keywords: csv, util, bbdb ;; Homepage: https://gitlab.com/iankelling/bbdb-csv-import +;; Mailing-List: https://lists.iankelling.org/listinfo/bbdb-csv-import ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -24,7 +25,7 @@ ;; along with this program. If not, see . ;;; Commentary: - +;; ;; Importer of csv (comma separated value) text into Emacs’s bbdb database, ;; version 3+. Works out of the box with csv exported from Thunderbird, Gmail, ;; Linkedin, Outlook.com/hotmail, and probably others. @@ -38,61 +39,102 @@ ;; ;; Else, note the min versions of dependencies above in "Package-Requires:", ;; and load this file. The exact minimum bbdb version is unknown, something 3+. - -;;; Usage: ;; -;; You may want to back up existing data in ~/.bbdb and ~/.emacs.d/bbdb in case -;; you don't like the newly imported data. +;;; Basic Usage: +;; +;; Back up bbdb by copying `bbdb-file' in case things go wrong. ;; ;; Simply M-x `bbdb-csv-import-buffer' or `bbdb-csv-import-file'. ;; When called interactively, they prompt for file or buffer arguments. ;; -;; Tested to work with thunderbird, gmail, linkedin, outlook.com/hotmail.com For -;; those programs, if it's exporter has an option of what kind of csv format, -;; choose it's own native format if available, if not, choose an outlook -;; compatible format. If you're exporting from some other program, and its csv -;; exporter claims outlook compatibility, there is a good chance it will work -;; out of the box. +;; Then view your bbdb records: M-x bbdb .* RET +;; If the import looks good save the bbdb database: C-x s (bbdb-save) + +;;; Advanced usage / notes: ;; -;; If things don't work, you can probably fix it with a custom field mapping -;; variable. It should not be too hard. Use the existing tables as an -;; example. By default, we use a combination of all predefined mappings, and -;; look for every known field, but it is probably best to avoid that kind of -;; table when setting up your own as it is an unnecessary complexity in this -;; case. If you have a problem with data from a supported export program, start -;; by testing its specific mapping table instead of the combined one. Here is a -;; handy template to set each of the predefined mapping tables: +;; Tested to work with thunderbird, gmail, linkedin, +;; outlook.com/hotmail.com. For those programs, if it's exporter has an option +;; of what kind of csv format, choose it's own native format if available, if +;; not, choose an outlook compatible format. If you're exporting from some other +;; program and its csv exporter claims outlook compatibility, there is a good +;; chance it will work out of the box. If it doesn't, you can try to fix it as +;; described below, or the maintainer will be happy to help, just anonymize your +;; csv data using the M-x bbdb-csv-anonymize-current-buffer (make sure csv +;; buffer is the current one) and attach it to an email to the mailing list. +;; +;; Duplicate contacts (according to email address) are skipped if +;; bbdb-allow-duplicates is nil (default). Any duplicates found are echoed at +;; the end of the import. + +;;; Custom mapping of csv fields +;; +;; If a field is handled wrong or you want to extend the program to handle a new +;; kind of csv format, you need to setup a custom field mapping variable. Use +;; the existing tables as an example. By default, we use a combination of most +;; predefined mappings, and look for all of their fields, but it is probably +;; best to avoid that kind of table when setting up your own as it is an +;; unnecessary complexity in that case. If you have a problem with data from a +;; supported export program, start by testing its specific mapping table instead +;; of the combined one. Here is a handy template to set each of the predefined +;; mapping tables if you would rather avoid the configure interface: ;; ;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-combined) ;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-thunderbird) ;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-gmail) +;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-gmail-typed-email) ;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-linkedin) ;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-outlook-web) +;; (setq bbdb-csv-import-mapping-table bbdb-csv-import-outlook-typed-email) ;; -;; In addition to the examples, the doc string for `bbdb-create-internal' may -;; also be useful. Please send any new mapping tables to the maintainer listed -;; in this file. The maintainer should be able to help with any issues and may -;; create a new mapping table given sample data. +;; The doc string for `bbdb-create-internal' may also be useful when creating a +;; mapping table. If you create a table for a program not not already supported, +;; please share it with the mailing list so it can be added to this program. +;; The maintainer should be able to help with any issues and may create a new +;; mapping table given sample data. +;; +;; Mapping table tips: +;; * The repeat keyword expands numbered field names, based on the first +;; field, as many times as they exist in the csv data. +;; * All mapping fields are optional. A simple mapping table could be +;; (setq bbdb-csv-import-mapping-table '((:mail "Primary Email"))) +;; * :xfields uses the csv field name to create custom fields in bbdb. It downcases +;; the field name, and replaces spaces with "-", and repeating dashes with a +;; single one . For example, if you had a csv named "Mail Alias" or "Mail - alias", +;; you could add it to :xfields in a mapping table and it would become "mail-alias" +;; in bbdb. + +;;; Misc tips/troubleshooting: ;; -;; Misc tips/troubleshooting: ;; - ASynK looks promising for syncing bbdb/google/outlook. ;; - The git repo contains a test folder with exactly tested version info and working -;; test data. +;; test data. Software, and especially online services are prone to changing how they +;; export. Please send feedback if you run into problems. ;; - bbdb doesn't work if you delete the bbdb database file in ;; the middle of an emacs session. If you want to empty the current bbdb database, ;; do M-x bbdb then .* then C-u * d on the beginning of a record. -;; - After changing a mapping table, don't forget to re-execute +;; - After changing a mapping table variable, don't forget to re-execute ;; (setq bbdb-csv-import-mapping-table ...) so that it propagates. +;; - :namelist is used instead of :name if 2 or more non-empty fields from :namelist are +;; found in a record. If :name is empty, we try a single non-empty field from :namelist +;; This sounds a bit strange, but it's to try and deal with Thunderbird idiosyncrasies. +;;; Bugs, patches, discussion, feedback +;; +;; Patches and bugs are very welcome via https://gitlab.com/iankelling/bbdb-csv-import +;; +;; Questions, feedback, or anything is very welcome at to the bbdb-csv-import mailing list +;; https://lists.iankelling.org/listinfo/bbdb-csv-import, no subscription needed to post via +;; bbdb-csv-import@lists.iankelling.org. The maintainer would probably be happy +;; to work on new features if something is missing. -;;; Code: + +;;; Code: (require 'pcsv) (require 'dash) (require 'bbdb-com) (eval-when-compile (require 'cl)) - (defconst bbdb-csv-import-thunderbird '((:namelist "First Name" "Last Name") (:name "Display Name") @@ -110,12 +152,13 @@ "Work ZipCode" "Work Country")))) (:organization "Organization") (:xfields "Web Page 1" "Web Page 2" "Birth Year" "Birth Month" - "Birth Day" "Department" "Custom 1" "Custom 2" "Custom 3" - "Custom 4" "Notes" "Job Title")) + "Birth Day" "Department" "Custom 1" "Custom 2" "Custom 3" + "Custom 4" "Notes" "Job Title")) "Thunderbird csv format") (defconst bbdb-csv-import-linkedin '((:namelist "First Name" "Middle Name" "Last Name") + (:affix "Suffix") (:mail "E-mail Address" "E-mail 2 Address" "E-mail 3 Address") (:phone "Assistant's Phone" "Business Fax" "Business Phone" @@ -139,18 +182,17 @@ "Other Postal Code" "Other Country")))) (:organization "Company") (:xfields - "Suffix" "Department" "Job Title" "Assistant's Name" + "Department" "Job Title" "Assistant's Name" "Birthday" "Manager's Name" "Notes" "Other Address PO Box" "Spouse" "Web Page" "Personal Web Page")) "Linkedin export in the Outlook csv format.") -;; note. PO Box and Extended Address are added as additional address street lines if they exist. -;; If you don't like this, just delete them from this fiel. -;; If you want some other special handling, it will need to be coded. (defconst bbdb-csv-import-gmail '((:namelist "Given Name" "Family Name") (:name "Name") + (:affix "Name Prefix" "Name Suffix") + (:aka "Nickname") (:mail (repeat "E-mail 1 - Value")) (:phone (repeat ("Phone 1 - Type" "Phone 1 - Value"))) (:address @@ -161,15 +203,15 @@ (:organization (repeat "Organization 1 - Name")) (:xfields "Additional Name" "Yomi Name" "Given Name Yomi" - "Additional Name Yomi" "Family Name Yomi" "Name Prefix" - "Name Suffix" "Initials" "Nickname" - "Short Name" "Maiden Name" "Birthday" + "Additional Name Yomi" "Family Name Yomi" + "Initials" "Short Name" "Maiden Name" "Birthday" "Gender" "Location" "Billing Information" "Directory Server" "Mileage" "Occupation" "Hobby" "Sensitivity" "Priority" "Subject" "Notes" "Group Membership" - ;; Gmail wouldn't let me add more than 1 organization, but no harm in - ;; looking for multiple since the field name implies the possibility. + ;; Gmail wouldn't let me add more than 1 organization in its web interface, + ;; but no harm in looking for multiple since the field name implies the + ;; possibility. (repeat "Organization 1 - Type" "Organization 1 - Yomi Name" "Organization 1 - Title" "Organization 1 - Department" @@ -179,7 +221,13 @@ (repeat ("Website 1 - Type" "Website 1 - Value")) (repeat ("Event 1 - Type" "Event 1 - Value")) (repeat ("Custom Field 1 - Type" "Custom Field 1 - Value")))) - "Gmail csv export format") + "Gmail csv export format. Note some fields don't map perfectly, +feel free to modify them as you wish. \"PO Box\" and \"Extended +Address\" are added as additional address street lines if they +exist. Some special name fields are made custom instead of put in +name, which gets a single string. We map Gmail's \"Name Prefix\" +and \"Name Suffix\" to bbdb's affix (a list of strings). We lose +the prefix/suffix label, but those are usually obvious.") (defconst bbdb-csv-import-gmail-typed-email @@ -192,6 +240,7 @@ (defconst bbdb-csv-import-outlook-web '((:namelist "First Name" "Middle Name" "Last Name") (:mail "E-mail Address" "E-mail 2 Address" "E-mail 3 Address") + (:affix "Suffix") (:phone "Assistant's Phone" "Business Fax" "Business Phone" "Business Phone 2" "Callback" "Car Phone" @@ -215,7 +264,7 @@ (:organization "Company") (:xfields "Anniversary" "Family Name Yomi" "Given Name Yomi" - "Suffix" "Department" "Job Title" "Birthday" "Manager's Name" "Notes" + "Department" "Job Title" "Birthday" "Manager's Name" "Notes" "Spouse" "Web Page")) "Hotmail.com, outlook.com, live.com, etc. Based on 'Export for outlook.com and other services', @@ -223,12 +272,12 @@ not the export for Outlook 2010 and 2013.") (defconst bbdb-csv-import-outlook-typed-email (append (car (last bbdb-csv-import-outlook-web)) '((repeat "E-mail 1 - Type"))) - "Like the previous var, but for outlook-web. + "Like bbdb-csv-import-gmail-typed-email, but for outlook-web. Adds email labels as custom fields.") (defun bbdb-csv-import-flatten1 (list) - "flatten LIST by 1 level." + "Flatten LIST by 1 level." (--reduce-from (if (consp it) (-concat acc it) (-snoc acc it)) @@ -236,7 +285,7 @@ Adds email labels as custom fields.") (defun bbdb-csv-import-merge-map (root) - "Combine two root mappings." + "Combine two root mappings for making a combined mapping." (bbdb-csv-import-flatten1 (list root (-distinct @@ -252,6 +301,7 @@ Adds email labels as custom fields.") ;; manually combined for proper ordering '(:namelist "First Name" "Given Name" "Middle Name" "Last Name" "Family Name") (bbdb-csv-import-merge-map :name) + (bbdb-csv-import-merge-map :affix) (bbdb-csv-import-merge-map :aka) (bbdb-csv-import-merge-map :mail) (bbdb-csv-import-merge-map :phone) @@ -281,141 +331,174 @@ Adds email labels as custom fields.") (bbdb-csv-import-merge-map :organization) (bbdb-csv-import-merge-map :xfields))) -(defvar bbdb-csv-import-mapping-table bbdb-csv-import-combined +(defcustom bbdb-csv-import-mapping-table bbdb-csv-import-combined "The table which maps bbdb fields to csv fields. The default should work for most cases. -See the commentary section of this file for more details.") - +See the commentary section of this file for more details." + :group 'bbdb-csv-import + :type 'symbol) + + +(defun bbdb-csv-import-expand-repeats (csv-fields list) + "Return new list where elements from LIST in form (repeat elem1 +...) become ((elem1 ...) [(elem2 ...)] ...) for as many fields +exist in the csv fields. elem can be a string or a tree (a list +with lists inside it). We use the first element as a template, +and increase its number by one, and check if it exists, and then +increment any other elements from the repeat list which have +numbers in them." + (cl-flet ((replace-num (num string) + ;; in STRING, replace all groups of numbers with NUM + (replace-regexp-in-string "[0-9]+" + (number-to-string num) + string))) + (--reduce-from + (if (not (and (consp it) (eq (car it) 'repeat))) + (cons it acc) + (setq it (cdr it)) + (let* ((i 1) + (first-field (car (-flatten it)))) + (setq acc (cons it acc)) + ;; use first-field to test if there is another repetition. + (while (member + (replace-num (setq i (1+ i)) first-field) + csv-fields) + (cl-labels ((fun (cell) + (if (consp cell) + (mapcar #'fun cell) + (replace-num i cell)))) + (setq acc (cons (fun it) acc)))) + acc)) + nil list))) + +(defun bbdb-csv-import-map-bbdb (csv-fields root) + "ROOT is a root element from bbdb-csv-import-mapping-table. Get +the csv-fields for root in the mapping format, including variably +repeated ones. Flatten by one because repeated fields are put in +sub-lists, but after expanding them, that extra depth is no +longer useful. Small trade off: address mappings without 'repeat need +to be grouped in a list because they contain sublists that we +don't want flattened." + (bbdb-csv-import-flatten1 + (bbdb-csv-import-expand-repeats + csv-fields + (cdr (assoc root bbdb-csv-import-mapping-table))))) ;;;###autoload (defun bbdb-csv-import-file (filename) - "Parse and import csv file FILENAME to bbdb." + "Parse and import csv file FILENAME to bbdb. +The file will be saved to disk with blank lines and aberrant characters removed." (interactive "fCSV file containg contact data: ") (bbdb-csv-import-buffer (find-file-noselect filename))) ;;;###autoload (defun bbdb-csv-import-buffer (&optional buffer-or-name) - "Parse and import csv BUFFER-OR-NAME to bbdb. -Argument is a buffer or name of a buffer. -Defaults to current buffer." + "Parse and import csv buffer to bbdb. Interactively, it prompts for a buffer. +The buffer will be saved to disk with blank lines and aberrant characters removed. +BUFFER-OR-NAME is a buffer or name of a buffer, or the current buffer if nil." (interactive "bBuffer containing CSV contact data: ") (when (null bbdb-csv-import-mapping-table) (error "error: `bbdb-csv-import-mapping-table' is nil. Please set it and rerun.")) - (let* ((csv-fields (pcsv-parse-buffer (get-buffer (or buffer-or-name (current-buffer))))) - (csv-contents (cdr csv-fields)) - (csv-fields (car csv-fields)) - (initial-duplicate-value bbdb-allow-duplicates) - csv-record rd assoc-plus flatten1) + (let* ((csv-buffer (get-buffer (or buffer-or-name (current-buffer)))) + (csv-data (save-excursion + (set-buffer csv-buffer) + ;; deal with blank lines and ^M from linkedin + (flush-lines "^\\s-*$") + (goto-char (point-min)) + ;; remove ^M aka ret characters + (while (re-search-forward (char-to-string 13) nil t) + (replace-match "")) + (basic-save-buffer) + (pcsv-parse-file buffer-file-name))) + (csv-fields (car csv-data)) + (csv-data (cdr csv-data)) + (allow-dupes bbdb-allow-duplicates) + csv-record rd assoc-plus map-bbdb dupes) ;; convenient function names (fset 'rd 'bbdb-csv-import-rd) (fset 'assoc-plus 'bbdb-csv-import-assoc-plus) - ;; Easier to allow duplicates and handle them post import vs failing as - ;; soon as we find one. + (fset 'map-bbdb (-partial 'bbdb-csv-import-map-bbdb csv-fields)) + ;; we handle duplicates ourselves (setq bbdb-allow-duplicates t) ;; loop over the csv records - (while (setq csv-record (map 'list 'cons csv-fields (pop csv-contents))) + (while (setq csv-record (map 'list 'cons csv-fields (pop csv-data))) (cl-flet* ((ca (key list) (cdr (assoc key list))) ;; utility function - (replace-num (num string) - ;; in STRING, replace all groups of numbers with NUM - (replace-regexp-in-string "[0-9]+" (number-to-string num) string)) - (expand-repeats (list) - ;; return new list where elements from LIST in form - ;; (repeat elem1 ...) become ((elem1 ...) [(elem2 ...)] ...) - ;; For as many repeating numbered fields exist in the csv fields. - ;; elem can be a string or a tree (a list with possibly lists inside it) - (--reduce-from - (if (not (and (consp it) (eq (car it) 'repeat))) - (cons it acc) - (setq it (cdr it)) - (let* ((i 1) - (first-field (car (flatten it)))) - (setq acc (cons it acc)) - ;; use first-field to test if there is another repetition. - (while (member - (replace-num (setq i (1+ i)) first-field) - csv-fields) - (cl-labels ((fun (cell) - (if (consp cell) - (mapcar #'fun cell) - (replace-num i cell)))) - (setq acc (cons (fun it) acc)))) - acc)) - nil list)) - (map-bbdb (root) - ;; ROOT = a root element from bbdb-csv-import-mapping-table. - ;; Get the actual csv-fields, including variably repeated ones. flattened - ;; by one because repeated fields are put in sub-lists, but - ;; after expanding them, that extra depth is no longer - ;; useful. Small quirk: address mappings without 'repeat - ;; need to be grouped in a list because they contain sublists that we - ;; don't want flattened. Better this than more complex code. - (bbdb-csv-import-flatten1 - (expand-repeats (ca root bbdb-csv-import-mapping-table)))) (rd-assoc (root) ;; given ROOT, return a list of data, ignoring empty fields (rd (lambda (elem) (assoc-plus elem csv-record)) (map-bbdb root))) (assoc-expand (e) ;; E = data-field-name | (field-name-field data-field) - ;; get data from the csv-record and return - ;; (field-name data) or nil. + ;; get data from the csv-record and return (field-name data) or nil. (let ((data-name (if (consp e) (ca (car e) csv-record) e)) (data (assoc-plus (if (consp e) (cadr e) e) csv-record))) - (if data (list data-name data)))) - (map-assoc (field) - ;; For simple mappings, get a single result - (car (rd-assoc field)))) - - (let ((name (let ((name (rd-assoc :namelist))) - ;; prioritize any combination of first middle last over :name - (if (>= (length name) 2) - (mapconcat 'identity name " ") - (map-assoc :name)))) - (phone (rd 'vconcat (rd #'assoc-expand (map-bbdb :phone)))) + (if data (list data-name data))))) + ;; set the arguments to bbdb-create-internal, then call it, the end. + (let ((name (let ((namelist (rd-assoc :namelist)) + (let-name (car (rd-assoc :name)))) + ;; priority: 2 or more from :namelist, then non-empty :name, then + ;; any single element of :namelist + (cond ((>= (length namelist) 2) + (mapconcat 'identity namelist " ")) + ((not (null let-name)) + let-name) + (t + (mapconcat 'identity namelist " "))))) + (affix (rd-assoc :affix)) + (aka (rd-assoc :aka)) + (organization (rd-assoc :organization)) (mail (rd-assoc :mail)) - (xfields (rd (lambda (list) - (let ((e (car list))) - (while (string-match "-" e) - (setq e (replace-match "" nil nil e))) - (while (string-match " +" e) - (setq e (replace-match "-" nil nil e))) - (setq e (make-symbol (downcase e))) - (cons e (cadr list)))) ;; change from (a b) to (a . b) - (rd #'assoc-expand (map-bbdb :xfields)))) + (phone (rd 'vconcat (rd #'assoc-expand (map-bbdb :phone)))) (address (rd (lambda (e) - (let ((address-lines (rd (lambda (elem) - (assoc-plus elem csv-record)) - (caadr e))) - ;; little bit of special handling so we can - ;; use the combined mapping + (let ((al (rd (lambda (elem) ;; al = address lines + (assoc-plus elem csv-record)) + (caadr e))) + ;; to use bbdb-csv-import-combined, we can't mapcar (address-data (--reduce-from (if (member it csv-fields) (cons (ca it csv-record) acc) acc) nil (cdadr e))) (elem-name (car e))) - (setq address-lines (nreverse address-lines)) + (setq al (nreverse al)) (setq address-data (nreverse address-data)) ;; make it a list of at least 2 elements - (setq address-lines (append address-lines - (-repeat (- 2 (length address-lines)) ""))) + (setq al (append al + (-repeat (- 2 (length al)) ""))) (when (consp elem-name) (setq elem-name (ca (car elem-name) csv-record))) ;; determine if non-nil and put together the minimum set (when (or (not (--all? (zerop (length it)) address-data)) - (not (--all? (zerop (length it)) address-lines))) - (when (> 2 (length address-lines)) + (not (--all? (zerop (length it)) al))) + (when (> 2 (length al)) (setcdr (max 2 (nthcdr (--find-last-index (not (null it)) - address-lines) - address-lines)) nil)) - (vconcat (list elem-name) (list address-lines) address-data)))) + al) + al)) nil)) + (vconcat (list elem-name) (list al) address-data)))) (map-bbdb :address))) - (organization (rd-assoc :organization)) - (affix (map-assoc "affix")) - (aka (rd-assoc :aka))) - (bbdb-create-internal name affix aka organization mail phone address xfields t)))) - (setq bbdb-allow-duplicates initial-duplicate-value))) - + (xfields (rd (lambda (list) + (let ((e (car list))) + (while (string-match " +" e) + (setq e (replace-match "-" nil nil e))) + (while (string-match "--+" e) + (setq e (replace-match "-" nil nil e))) + (setq e (make-symbol (downcase e))) + (cons e (cadr list)))) ;; change from (a b) to (a . b) + (rd #'assoc-expand (map-bbdb :xfields))))) + ;; we copy and subvert bbdb's duplicate detection instead of catching + ;; errors so that we don't interfere with other errors, and can print + ;; them nicely at the end. + (let (found-dupe) + (dolist (elt mail) + (when (bbdb-gethash elt '(mail)) + (push elt dupes) + (setq found-dupe t))) + (when (or allow-dupes (not found-dupe)) + (bbdb-create-internal name affix aka organization mail phone address xfields t)))))) + (when dupes (if allow-dupes + (message "Warning, contacts with duplicate email addresses were imported:\n%s" dupes) + (message "Skipped contacts with duplicate email addresses:\n%s" dupes))) + (setq bbdb-allow-duplicates allow-dupes))) (defun bbdb-csv-import-rd (func list) "like mapcar but don't build nil results into the resulting list" @@ -431,6 +514,14 @@ Defaults to current buffer." (when (not (string= "" result)) result))) +(defun bbdb-csv-anonymize-current-buffer () + (interactive) + "Anonymize the current buffer which contains csv data. + The first line should contain header names." + (goto-line 2) + (while (re-search-forward "\\w") + (delete-char -1) + (insert (number-to-string (random 9))))) (provide 'bbdb-csv-import)