From 8b59aa1e503d9ef9595f0a8f8265828f97590f56 Mon Sep 17 00:00:00 2001 From: Ian Kelling Date: Fri, 18 Apr 2014 18:58:02 -0700 Subject: [PATCH] fix botched file rename --- bbdb-csv-import.el | 446 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 446 insertions(+) create mode 100644 bbdb-csv-import.el diff --git a/bbdb-csv-import.el b/bbdb-csv-import.el new file mode 100644 index 0000000..0679be2 --- /dev/null +++ b/bbdb-csv-import.el @@ -0,0 +1,446 @@ +;;; bbdb-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.1 +;; Package-Requires: ((pcsv "1.3.3") (dash "2.5.0")) +;; Keywords: csv, util, bbdb +;; Homepage: https://gitlab.com/iankelling/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 +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; 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. +;; Easily extensible to handle new formats. + +;;; Installation: +;; +;; Install bbdb. If you installed this file with a package manager, just +;; +;; (require 'bbdb-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: +;; +;; 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 `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. +;; +;; 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 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-linkedin) +;; (setq bbdb-csv-import-mapping-table bbdb-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. +;; +;; 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 bbdb-csv-import-mapping-table ...) so that it propagates. + + +;;; Code: + +(require 'pcsv) +(require 'dash) +(require 'bbdb-com) +(eval-when-compile (require 'cl)) + + +(defconst bbdb-csv-import-thunderbird + '(("firstname" "First Name") + ("lastname" "Last Name") + ("name" "Display Name") + ("aka" "Nickname") + ("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") + ("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")) + "Thunderbird csv format") + +(defconst bbdb-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 bbdb-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 bbdb-csv-import-gmail-typed-email + (append (car (last bbdb-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 bbdb-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 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. +Adds email labels as custom fields.") + + +(defun bbdb-csv-import-flatten1 (list) + "flatten LIST by 1 level." + (--reduce-from (if (consp it) + (-concat acc it) + (-snoc acc it)) + nil list)) + + +(defun bbdb-csv-import-merge-map (root) + "Combine two root mappings." + (bbdb-csv-import-flatten1 + (list root + (-distinct + (append + (cdr (assoc root bbdb-csv-import-thunderbird)) + (cdr (assoc root bbdb-csv-import-linkedin)) + (cdr (assoc root bbdb-csv-import-gmail)) + (cdr (assoc root bbdb-csv-import-outlook-web))))))) + + +(defconst bbdb-csv-import-combined + (list + (bbdb-csv-import-merge-map "firstname") + (bbdb-csv-import-merge-map "middlename") + (bbdb-csv-import-merge-map "lastname") + (bbdb-csv-import-merge-map "name") + (bbdb-csv-import-merge-map "aka") + (bbdb-csv-import-merge-map "mail") + (bbdb-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")))) + (bbdb-csv-import-merge-map "organization") + (bbdb-csv-import-merge-map "xfields"))) + +(defvar 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.") + + +;;;###autoload +(defun bbdb-csv-import-file (filename) + "Parse and import csv file FILENAME to bbdb." + (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." + (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) + ;; convenient function names + (fset 'rd 'bbdb-csv-import-rd) + (fset 'assoc-plus 'bbdb-csv-import-assoc-plus) + (fset 'flatten1 'bbdb-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* + ((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. + (flatten1 (expand-repeats (cdr (assoc 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. + (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"))) + ;; prioritize any combination of first middle last over just "name" + (if (or (and first last) (and first middle) (and middle last)) + ;; purely historical note. + ;; 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-bbdb "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-bbdb "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? (zerop (length it)) address-data)) + (not (--all? (zerop (length it)) address-lines))) + (when (> 2 (length 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-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))) + + +(defun bbdb-csv-import-rd (func list) + "like mapcar but don't build nil results into the resulting list" + (--reduce-from (let ((funcreturn (funcall func it))) + (if funcreturn + (cons funcreturn acc) + acc)) + nil list)) + +(defun bbdb-csv-import-assoc-plus (key list) + "Like (cdr assoc ...) but turn an empty string result to nil." + (let ((result (cdr (assoc key list)))) + (when (not (string= "" result)) + result))) + + + +(provide 'bbdb-csv-import) + +;;; bbdb-csv-import.el ends here -- 2.30.2