-;;; bbdb-csv-import.el --- import csv to bbdb version 3+
+;;; bbdb-csv-import.el --- import csv to bbdb version 3+
;; Copyright (C) 2014 by Ian Kelling
;; Author: Ian Kelling <ian@iankelling.org>
;; Created: 1 Apr 2014
;; Version: 1.1
-;; Package-Requires: ((pcsv "1.3.3") (dash "2.5.0"))
+;; 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
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; 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.
;;; Installation:
;;
-;; Install bbdb. If you installed this file with a package manager, just
+;; 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:
+;; and load this file. The exact minimum bbdb version is unknown, something 3+.
+;;
+;;; Basic 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.
+;; 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:
+;;
+;; 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 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:
+;; 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)
;;
-;; 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.
+;; 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
- '(("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"
+ '((:namelist "First Name" "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"
(("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"))
+ (: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"
+ '((: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"
"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"
+ (:address
(("business address"
(("Business Street" "Business Street 2" "Business Street 3")
"Business City" "Business State"
(("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"
+ (:organization "Company")
+ (:xfields
+ "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"
+ '((: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
(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"
+ (: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"
(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
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"
+ '((: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"
"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"
+ (:address
(("business address"
(("Business Street")
"Business City" "Business State"
(("Other Street")
"Other City" "Other State"
"Other Postal Code" "Other Country"))))
- ("organization" "Company")
- ("xfields"
+ (: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',
(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))
(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
(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 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)
;; manually combined the addresses. Because it was easier.
- '("address"
+ '(:address
(repeat (("Address 1 - Type")
(("Address 1 - Street" "Address 1 - PO Box" "Address 1 - Extended Address")
"Address 1 - City" "Address 1 - Region"
(("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")))
+ (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)
- (fset 'flatten1 'bbdb-csv-import-flatten1)
- ;; 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*
- ((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)))))
+ ((ca (key list) (cdr (assoc key list))) ;; utility function
(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))
+ ;; 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 ((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"))))
+ (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))
+ (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 (cdr (assoc it csv-record)) acc)
+ (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 (cdr (assoc (car elem-name) csv-record))))
+ (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))))
- (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)))
-
+ al)
+ al)) nil))
+ (vconcat (list elem-name) (list al) address-data))))
+ (map-bbdb :address)))
+ (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"
(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)
iankelling.org / git / bbdb-csv-import / blobdiff