X-Git-Url: https://iankelling.org/git/?p=bbdb-csv-import;a=blobdiff_plain;f=bbdb3-csv-import.el;h=ec782afe678a4318ac0836ee7d51ac1933ea413e;hp=7632258ae8b41a0146c351aaac28ab2f647aa942;hb=e2d7e59a5ba95fd7868e2652040b3925d3a80d2f;hpb=fabc4c5d44edacb68d7327bed2a640132e3b57dc diff --git a/bbdb3-csv-import.el b/bbdb3-csv-import.el index 7632258..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,53 +26,73 @@ ;;; Commentary: ;; Importer of csv (comma separated value) text into Emacs’s bbdb database, -;; version 3+. Programs such as Thunderbird, Gmail, Linkedin, and Outlook allow -;; for exporting contact data as csv files. See ASynK for syncing bbdb/google/outlook. +;; 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 as this may be a one time usage: -;; (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. ;; -;; Assign a mapping table. Predefined ones listed here: +;; 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 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. ;; -;; Simply call `bbdb3-csv-import-buffer' or -;; `bbdb3-csv-import-file'. Interactively they prompt for file/buffer. Use -;; non-interactively for no prompts. -;; -;; If you need to define your own mapping table, it should not be too hard. Use -;; the existing tables as an example, and perhaps the test data within this -;; project. 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: +;; 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") @@ -170,12 +193,6 @@ people don't use those labels and using the default labels would create useless custom fields.") -(defconst bbdb3-csv-import-outlook-web-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.") - - (defconst bbdb3-csv-import-outlook-web '(("firstname" "First Name") ("lastname" "Last Name") @@ -210,17 +227,71 @@ Adds email labels as custom fields.") 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.") -(defvar bbdb3-csv-import-mapping-table nil - "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.") ;;;###autoload (defun bbdb3-csv-import-file (filename) @@ -228,7 +299,6 @@ 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. @@ -252,20 +322,7 @@ Defaults to current buffer." ;; loop over the csv records (while (setq csv-record (map 'list 'cons csv-fields (pop csv-contents))) (cl-flet* - ((rd-assoc (list) - ;; given LIST of fields, return a list of data, ignoring empty fields - (rd (lambda (elem) (assoc-plus elem csv-record)) list)) - (mapcar-assoc (list) - ;; given LIST of fields,return a list of data with nil in place of an empty field - (mapcar (lambda (elem) (cdr (assoc elem csv-record))) list)) - (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)))) - (replace-num (num string) + ((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) @@ -273,37 +330,43 @@ Defaults to current buffer." ;; (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 (lambda (acc arg) - (if (not (and (consp arg) (eq (car arg) 'repeat))) - (cons arg acc) - (setq arg (cdr arg)) - (let* ((i 1) - (first-field (car (flatten arg)))) - (setq acc (cons arg 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 arg) acc)))) - acc))) nil list)) - - (map-bbdb3 (root-mapping) - ;; ROOT-MAPPING = a root element from bbdb3-csv-import-mapping-table. - ;; - ;; Get the actual csv-fields, including variably repeated ones flattened - ;; by one because potentially repeated fields are put in sub-lists so they - ;; can be as one thing, but after they are, that extra depth is no longer - ;; useful. This makes for a little quirk: address mappings without 'repeat + (--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. I've decided that is a better trade off than more - ;; complex code. - (flatten1 (expand-repeats (cdr (assoc bbdb-arg bbdb3-csv-import-mapping-table))))) + ;; 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 mappings with just 1 simple csv-field, get it's data - (assoc-plus (car (map-bbdb3 field)) csv-record))) - + ;; For simple mappings, get a single result + (car (rd-assoc field)))) (let ((name (let ((first (map-assoc "firstname")) (middle (map-assoc "middlename")) @@ -316,7 +379,7 @@ Defaults to current buffer." (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 (map-bbdb3 "mail"))) + (mail (rd-assoc "mail")) (xfields (rd (lambda (list) (let ((e (car list))) (while (string-match "-" e) @@ -326,51 +389,52 @@ Defaults to current buffer." (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 (mapping-elem) - (let ((address-lines (mapcar-assoc (caadr mapping-elem))) - (address-data (mapcar-assoc (cdadr mapping-elem))) - (elem-name (car mapping-elem))) - + (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 (mapping-elem) (not (null mapping-elem))) - address-lines) + (setcdr (max 2 (nthcdr (--find-last-index (not (null it)) + address-lines) address-lines)) nil)) (vconcat (list elem-name) (list address-lines) address-data)))) (map-bbdb3 "address"))) - (organization (rd-assoc (map-bbdb3 "organization"))) + (organization (rd-assoc "organization")) (affix (map-assoc "affix")) - (aka (rd-assoc (map-bbdb3 "aka")))) + (aka (rd-assoc "aka"))) (bbdb-create-internal name affix aka organization mail phone address xfields t)))) (setq bbdb-allow-duplicates initial-duplicate-value))) -(defun bbdb3-csv-import-flatten1 (list) - "flatten LIST by 1 level." - (-reduce-from (lambda (acc elem) - (if (consp elem) - (-concat acc elem) - (-snoc acc elem))) - nil list)) - -;;;###autoload (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)))