X-Git-Url: https://iankelling.org/git/?a=blobdiff_plain;f=bbdb3-csv-import.el;h=ab72bacb1f4d2430f49c98f471200b3e2de825bf;hb=0048a23895646a030f988b06333e8ba77ba86104;hp=b644e52426e49369531d2b74f0c88fc5d317af7b;hpb=190f78899eec5e7977acc0ee2773faee432a5510;p=bbdb-csv-import diff --git a/bbdb3-csv-import.el b/bbdb3-csv-import.el index b644e52..ab72bac 100644 --- a/bbdb3-csv-import.el +++ b/bbdb3-csv-import.el @@ -46,6 +46,8 @@ ;; (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 @@ -63,7 +65,9 @@ ;; 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) @@ -126,7 +130,8 @@ ;; 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") @@ -161,6 +166,7 @@ (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 @@ -168,6 +174,49 @@ 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. @@ -208,9 +257,38 @@ 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)) + ((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)) @@ -224,42 +302,9 @@ Defaults to current buffer." (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")) @@ -272,7 +317,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) @@ -283,46 +328,46 @@ Defaults to current buffer." (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)