X-Git-Url: https://iankelling.org/git/?p=bbdb-csv-import;a=blobdiff_plain;f=bbdb3-csv-import.el;h=ec782afe678a4318ac0836ee7d51ac1933ea413e;hp=35f99f44be89627acc86fc7124ad83cacc035cae;hb=e2d7e59a5ba95fd7868e2652040b3925d3a80d2f;hpb=704495c225d50fa0b8e5cb2ffaf867456be2d5c0 diff --git a/bbdb3-csv-import.el b/bbdb3-csv-import.el index 35f99f4..ec782af 100644 --- a/bbdb3-csv-import.el +++ b/bbdb3-csv-import.el @@ -1,11 +1,14 @@ -;;; bbdb3-csv-import.el --- import csv to bbdb version 3+ -*- lexical-binding: t; -*- +;;; bbdb3-csv-import.el --- import csv to bbdb version 3+ ;; Copyright (C) 2014 by Ian Kelling +;; Maintainer: Ian Kelling ;; Author: Ian Kelling ;; Created: 1 Apr 2014 -;; Version: 1.0 +;; Version: 1.1 +;; Package-Requires: ((pcsv "1.3.3") (dash "2.5.0")) ;; Keywords: csv, util, bbdb +;; Homepage: https://gitlab.com/iankelling/bbdb3-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 @@ -23,46 +26,73 @@ ;;; Commentary: ;; Importer of csv (comma separated value) text into Emacs’s bbdb database, -;; version 3+. Programs such as Thunderbird and Outlook allow for exporting -;; contact data as csv files. +;; version 3+. Works out of the box with csv exported from Thunderbird, Gmail, +;; Linkedin, Outlook.com/hotmail, and probably others. +;; Easily extensible to handle new formats. ;;; Installation: ;; -;; dependencies: pcsv.el, dash.el, bbdb -;; These are available via marmalade/melpa or the internet -;; -;; Add to init file or execute manually: -;; (load-file FILENAME-OF-THIS-FILE) -;; or -;; (add-to-list 'load-path DIRECTORY-CONTAINING-THIS-FILE) +;; Install bbdb. If you installed this file with a package manager, just +;; ;; (require 'bbdb3-csv-import) +;; +;; Else, note the min versions of dependencies above in "Package-Requires:", +;; and load this file. I don't know the exact minimum bbdb version. ;;; Usage: ;; -;; Backup or rename any existing ~/.bbdb and ~/.emacs.d/bbdb while testing that -;; the import works correctly. +;; You may want to back up existing data in ~/.bbdb and ~/.emacs.d/bbdb in case +;; you don't like the newly imported data. +;; +;; Simply M-x `bbdb3-csv-import-buffer' or `bbdb3-csv-import-file'. +;; When called interactively, they prompt for file or buffer arguments. ;; -;; Simply call `bbdb3-csv-import-buffer' or -;; `bbdb3-csv-import-file'. Interactively they prompt for file/buffer. Use -;; non-interactively for no prompts. +;; 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. ;; -;; Thunderbird csv data works out of the box. Otherwise you will need to create -;; a mapping table to suit your data and assign it to -;; bbdb3-csv-import-mapping-table. Note that variable's doc string and perhaps -;; the test data within this project for more details. Please send any new -;; mapping tables upstream so I can add it to this file for other's benefit. I, -;; Ian Kelling, am willing to help with any issues including creating a mapping -;; table given sample data. +;; If things don't work, you can probably fix it with a field mapping variable. +;; By default, we use a combination of all predefined mappings, and look for +;; every known field. If you have data that is from something we've already +;; tested, try using it's specific mapping table in case that works better. +;; Here is a handy template to set each of the predefined mapping tables: +;; +;; (setq bbdb3-csv-import-mapping-table bbdb3-csv-import-combined) +;; (setq bbdb3-csv-import-mapping-table bbdb3-csv-import-thunderbird) +;; (setq bbdb3-csv-import-mapping-table bbdb3-csv-import-gmail) +;; (setq bbdb3-csv-import-mapping-table bbdb3-csv-import-linkedin) +;; (setq bbdb3-csv-import-mapping-table bbdb3-csv-import-outlook-web) +;; +;; If you need to define your own mapping table, it should not be too hard. Use +;; the existing tables as an example. Probably best to ignore the combined table +;; as it is an unnecessary complexity when working on a new table. 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. ;; -;; Tips for testing: 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. +;; 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. +;; - 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 +;; (setq bbdb3-csv-import-mapping-table ...) so that it propagates. + + +;;; Code: (require 'pcsv) (require 'dash) (require 'bbdb-com) (eval-when-compile (require 'cl)) + (defconst bbdb3-csv-import-thunderbird '(("firstname" "First Name") ("lastname" "Last Name") @@ -71,32 +101,197 @@ ("mail" "Primary Email" "Secondary Email") ("phone" "Work Phone" "Home Phone" "Fax Number" "Pager Number" "Mobile Number") ("address" - ("home address" (("Home Address" - "Home Address 2") - "Home City" - "Home State" - "Home ZipCode" - "Home Country")) - ("work address" (("Work Address" - "Work Address 2") - "Work City" - "Work State" - "Work ZipCode" - "Work Country"))) - ("organization" ("Organization")) + (("home address" + (("Home Address" "Home Address 2") + "Home City" "Home State" + "Home ZipCode" "Home Country")) + ("work address" + (("Work Address" "Work Address 2") + "Work City" "Work State" + "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"))) - -(defvar bbdb3-csv-import-mapping-table bbdb3-csv-import-thunderbird - "The table which maps bbdb3 fields to csv fields. -Use the default as an example to map non-thunderbird data. -Name used is firstname + lastname or name. -After the car, all names should map to whatever csv -field names are used in the first row of csv data. -Many fields are optional. If you aren't sure if one is, -best to just try it. The doc string for `bbdb-create-internal' -may be useful for determining which fields are required.") + "Custom 4" "Notes" "Job Title")) + "Thunderbird csv format") + +(defconst bbdb3-csv-import-linkedin + '(("firstname" "First Name") + ("lastname" "Last Name") + ("middlename" "Middle Name") + ("mail" "E-mail Address" "E-mail 2 Address" "E-mail 3 Address") + ("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") + ("address" + (("business address" + (("Business Street" "Business Street 2" "Business Street 3") + "Business City" "Business State" + "Business Postal Code" "Business Country")) + ("home address" + (("Home Street" "Home Street 2" "Home Street 3") + "Home City" "Home State" + "Home Postal Code" "Home Country")) + ("other address" + (("Other Street" "Other Street 2" "Other Street 3") + "Other City" "Other State" + "Other Postal Code" "Other Country")))) + ("organization" "Company") + ("xfields" + "Suffix" "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 bbdb3-csv-import-gmail + '(("firstname" "Given Name") + ("lastname" "Family Name") + ("name" "Name") + ("mail" (repeat "E-mail 1 - Value")) + ("phone" (repeat ("Phone 1 - Type" "Phone 1 - Value"))) + ("address" + (repeat (("Address 1 - Type") + (("Address 1 - Street" "Address 1 - PO Box" "Address 1 - Extended Address") + "Address 1 - City" "Address 1 - Region" + "Address 1 - Postal Code" "Address 1 - Country")))) + ("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" + "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. + (repeat + "Organization 1 - Type" "Organization 1 - Yomi Name" + "Organization 1 - Title" "Organization 1 - Department" + "Organization 1 - Symbol" "Organization 1 - Location" + "Organization 1 - Job Description") + (repeat ("Relation 1 - Type" "Relation 1 - Value")) + (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") + + +(defconst bbdb3-csv-import-gmail-typed-email + (append (car (last bbdb3-csv-import-gmail)) '((repeat "E-mail 1 - Type"))) + "Like the first Gmail mapping, but use custom fields to store + Gmail's email labels. This is separate because I assume most + people don't use those labels and using the default labels + would create useless custom fields.") + +(defconst bbdb3-csv-import-outlook-web + '(("firstname" "First Name") + ("lastname" "Last Name") + ("middlename" "Middle Name") + ("mail" "E-mail Address" "E-mail 2 Address" "E-mail 3 Address") + ("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") + ("address" + (("business address" + (("Business Street") + "Business City" "Business State" + "Business Postal Code" "Business Country")) + ("home address" + (("Home Street") + "Home City" "Home State" + "Home Postal Code" "Home Country")) + ("other address" + (("Other Street") + "Other City" "Other State" + "Other Postal Code" "Other Country")))) + ("organization" "Company") + ("xfields" + "Anniversary" "Family Name Yomi" "Given Name Yomi" + "Suffix" "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', +not the export for Outlook 2010 and 2013.") + +(defconst bbdb3-csv-import-outlook-typed-email + (append (car (last bbdb3-csv-import-outlook-web)) '((repeat "E-mail 1 - Type"))) + "Like the previous var, but for outlook-web. +Adds email labels as custom fields.") + + +(defun bbdb3-csv-import-flatten1 (list) + "flatten LIST by 1 level." + (--reduce-from (if (consp it) + (-concat acc it) + (-snoc acc it)) + nil list)) + + +(defun bbdb3-csv-import-merge-map (root) + "Combine two root mappings." + (bbdb3-csv-import-flatten1 + (list root + (-distinct + (append + (cdr (assoc root bbdb3-csv-import-thunderbird)) + (cdr (assoc root bbdb3-csv-import-linkedin)) + (cdr (assoc root bbdb3-csv-import-gmail)) + (cdr (assoc root bbdb3-csv-import-outlook-web))))))) + + +(defconst bbdb3-csv-import-combined + (list + (bbdb3-csv-import-merge-map "firstname") + (bbdb3-csv-import-merge-map "middlename") + (bbdb3-csv-import-merge-map "lastname") + (bbdb3-csv-import-merge-map "name") + (bbdb3-csv-import-merge-map "aka") + (bbdb3-csv-import-merge-map "mail") + (bbdb3-csv-import-merge-map "phone") + ;; manually combined the addresses. Because it was easier. + '("address" + (repeat (("Address 1 - Type") + (("Address 1 - Street" "Address 1 - PO Box" "Address 1 - Extended Address") + "Address 1 - City" "Address 1 - Region" + "Address 1 - Postal Code" "Address 1 - Country"))) + (("business address" + (("Business Street" "Business Street 2" "Business Street 3") + "Business City" "Business State" + "Business Postal Code" "Business Country")) + ("home address" + (("Home Street" "Home Street 2" "Home Street 3" + "Home Address" "Home Address 2") + "Home City" "Home State" + "Home Postal Code" "Home ZipCode" "Home Country")) + ("work address" + (("Work Address" "Work Address 2") + "Work City" "Work State" + "Work ZipCode" "Work Country")) + ("other address" + (("Other Street" "Other Street 2" "Other Street 3") + "Other City" "Other State" + "Other Postal Code" "Other Country")))) + (bbdb3-csv-import-merge-map "organization") + (bbdb3-csv-import-merge-map "xfields"))) + +(defvar bbdb3-csv-import-mapping-table bbdb3-csv-import-combined + "The table which maps bbdb3 fields to csv fields. The default should work for most cases. +See the commentary section of this file for more details.") + ;;;###autoload (defun bbdb3-csv-import-file (filename) @@ -104,89 +299,148 @@ may be useful for determining which fields are required.") (interactive "fCSV file containg contact data: ") (bbdb3-csv-import-buffer (find-file-noselect filename))) - ;;;###autoload (defun bbdb3-csv-import-buffer (&optional buffer-or-name) "Parse and import csv BUFFER-OR-NAME to bbdb3. Argument is a buffer or name of a buffer. Defaults to current buffer." (interactive "bBuffer containing CSV contact data: ") + (when (null bbdb3-csv-import-mapping-table) + (error "error: `bbdb3-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) + csv-record rd assoc-plus flatten1) + ;; convenient function names + (fset 'rd 'bbdb3-csv-import-rd) + (fset 'assoc-plus 'bbdb3-csv-import-assoc-plus) + (fset 'flatten1 'bbdb3-csv-import-flatten1) ;; Easier to allow duplicates and handle them post import vs failing as ;; soon as we find one. (setq bbdb-allow-duplicates t) + ;; loop over the csv records (while (setq csv-record (map 'list 'cons csv-fields (pop csv-contents))) - (cl-flet* - ((rd (func list) (bbdb3-csv-import-reduce func list)) ;; just a local defalias - (assoc-plus (key list) (bbdb3-csv-import-assoc-plus key list)) ;; defalias - (rd-assoc (list) (rd (lambda (elem) (assoc-plus elem csv-record)) list)) - (mapcar-assoc (list) (mapcar (lambda (elem) (cdr (assoc elem csv-record))) list)) - (field-map (field) (cdr (assoc field bbdb3-csv-import-mapping-table))) - (map-assoc (field) (assoc-plus (car (field-map field)) csv-record))) - + (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)) + (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-bbdb3 (root) + ;; ROOT = a root element from bbdb3-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. + (flatten1 (expand-repeats (cdr (assoc root bbdb3-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-bbdb3 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. + (let ((data-name (if (consp e) (cdr (assoc (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 ((first (map-assoc "firstname")) + (middle (map-assoc "middlename")) (last (map-assoc "lastname")) (name (map-assoc "name"))) - (if (and first last) + ;; prioritize any combination of first middle last over just "name" + (if (or (and first last) (and first middle) (and middle last)) ;; purely historical note. - ;; it works exactly the same but I don't use (cons first last) due to a bug - ;; http://www.mail-archive.com/bbdb-info%40lists.sourceforge.net/msg06388.html - (concat first " " last) - (or name first last "")))) - (phone (rd (lambda (elem) - (let ((data (assoc-plus elem csv-record))) - (if data (vconcat (list elem data))))) - (field-map "phone"))) - (xfields (rd (lambda (field) - (let ((value (assoc-plus field csv-record))) - (when value - (while (string-match " " field) - ;; turn csv field names into symbols for extra fields - (setq field (replace-match "" nil nil field))) - (cons (make-symbol (downcase field)) value)))) - (field-map "xfields"))) - (address (rd (lambda (x) - (let ((address-lines (mapcar-assoc (caadr x))) - (address-data (mapcar-assoc (cdadr x)))) + ;; using (cons first last) as argument works the same as (concat first " " last) + (concat (or first middle) " " (or middle last) (when (and first middle) (concat " " last) )) + (or name first middle last "")))) + (phone (rd 'vconcat (rd #'assoc-expand (map-bbdb3 "phone")))) + (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-bbdb3 "xfields")))) + (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 + (address-data (--reduce-from (if (member it csv-fields) + (cons (cdr (assoc it csv-record)) acc) + acc) + nil (cdadr e))) + (elem-name (car e))) + (setq address-lines (nreverse address-lines)) + (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)) ""))) + (when (consp elem-name) + (setq elem-name (cdr (assoc (car elem-name) csv-record)))) + ;; determine if non-nil and put together the minimum set - (when (or (not (-all? '(lambda (arg) (zerop (length arg))) address-data)) - (not (-all? '(lambda (arg) (zerop (length arg))) address-lines))) + (when (or (not (--all? (zerop (length it)) address-data)) + (not (--all? (zerop (length it)) address-lines))) (when (> 2 (length address-lines)) - (setcdr (max 2 (nthcdr (-find-last-index (lambda (x) (not (null x))) - address-lines) + (setcdr (max 2 (nthcdr (--find-last-index (not (null it)) + address-lines) address-lines)) nil)) - (vconcat (list (car x)) (list address-lines) address-data)))) - (cdr (assoc "address" bbdb3-csv-import-mapping-table)))) - (mail (rd-assoc (field-map "mail"))) - (organization (rd-assoc (field-map "organization"))) + (vconcat (list elem-name) (list address-lines) address-data)))) + (map-bbdb3 "address"))) + (organization (rd-assoc "organization")) (affix (map-assoc "affix")) - (aka (rd-assoc (field-map "aka")))) - (bbdb-create-internal name affix aka organization mail - phone address xfields t)))) + (aka (rd-assoc "aka"))) + (bbdb-create-internal name affix aka organization mail phone address xfields t)))) (setq bbdb-allow-duplicates initial-duplicate-value))) -;;;###autoload -(defun bbdb3-csv-import-reduce (func list) +(defun bbdb3-csv-import-rd (func list) "like mapcar but don't build nil results into the resulting list" - (-reduce-from (lambda (acc elem) - (let ((funcreturn (funcall func elem))) - (if funcreturn - (cons funcreturn acc) - acc))) - nil list)) + (--reduce-from (let ((funcreturn (funcall func it))) + (if funcreturn + (cons funcreturn acc) + acc)) + nil list)) -;;;###autoload (defun bbdb3-csv-import-assoc-plus (key list) - "Like `assoc' but turn an empty string result to nil." + "Like (cdr assoc ...) but turn an empty string result to nil." (let ((result (cdr (assoc key list)))) (when (not (string= "" result)) result))) + + (provide 'bbdb3-csv-import) ;;; bbdb3-csv-import.el ends here