;; (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)
+;;
;;
;; Simply call `bbdb3-csv-import-buffer' or
;; `bbdb3-csv-import-file'. Interactively they prompt for file/buffer. Use
;; 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.
-;;
+;;
+;; Todo: It would be nice if we would programatically or manually merge all the
+;; mapping tables, then we would not have to set one.
(require 'pcsv)
(require 'dash)
;; note. PO Box and Extended Address are added as additional address street lines if they exist.
-;; If you don't like this, you can remove them. If you want some other special handling, it will need to be coded.
+;; 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")
(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
people don't use those labels and using the default labels
would create useless custom fields.")
+(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.")
+
+
+(defconst bbdb3-csv-import-outlook-web
+ '(("firstname" "Display Name" "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-combined)
+
+
(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.
;; 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))
+ ((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)))
(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))
(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 (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
- ;; 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)))))
(map-assoc (field)
;; For mappings with just 1 simple csv-field, get it's data
- (assoc-plus (car (map-bbdb3 field)) csv-record)))
-
+ (car (rd-assoc field))))
(let ((name (let ((first (map-assoc "firstname"))
(middle (map-assoc "middlename"))
(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)
(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)))
+ (let ((address-lines (rd (lambda (elem)
+ (assoc-plus elem csv-record))
+ (caadr mapping-elem)))
(address-data (mapcar-assoc (cdadr mapping-elem)))
(elem-name (car mapping-elem)))
-
+ (if (= (length address-lines) 1)
+ (setq address-lines (-snoc 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))
+ (--reduce-from (if (consp it)
+ (-concat acc it)
+ (-snoc acc it))
+ 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)
iankelling.org / git / bbdb-csv-import / blobdiff