Refactor address lines to use first found instead of leaving blanks

[bbdb-csv-import] / bbdb3-csv-import.el

diff --git a/bbdb3-csv-import.el b/bbdb3-csv-import.el
index 9abd27e862f5b4c791e357363d7c3c29246ad31d..ab72bacb1f4d2430f49c98f471200b3e2de825bf 100644 (file)
--- a/bbdb3-csv-import.el
+++ b/bbdb3-csv-import.el
@@ -181,7 +181,7 @@ Adds email labels as custom fields.")
 
 
 (defconst bbdb3-csv-import-outlook-web
 
 
 (defconst bbdb3-csv-import-outlook-web

-  '(("firstname" "First Name")
+  '(("firstname" "Display Name" "First Name")

     ("lastname" "Last Name")
     ("middlename" "Middle Name")
     ("mail" "E-mail Address" "E-mail 2 Address" "E-mail 3 Address")
     ("lastname" "Last Name")
     ("middlename" "Middle Name")
     ("mail" "E-mail Address" "E-mail 2 Address" "E-mail 3 Address")


@@ -214,6 +214,8 @@ Adds email labels as custom fields.")
 Based on 'Export for outlook.com and other services',
 not the export for Outlook 2010 and 2013.")
 
 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.
 
 (defvar bbdb3-csv-import-mapping-table nil
   "The table which maps bbdb3 fields to csv fields.


@@ -255,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*
     ;; 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))
            (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))


@@ -271,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))
            (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 root-mapping bbdb3-csv-import-mapping-table)))))

            (map-assoc (field)
                       ;; For mappings with just 1 simple csv-field, get it's data
            (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"))
 
         (let ((name (let ((first (map-assoc "firstname"))
                           (middle (map-assoc "middlename"))


@@ -319,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"))))
                           (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)
               (xfields (rd (lambda (list)
                              (let ((e (car list)))
                                (while (string-match "-" e)


@@ -330,48 +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)
                                (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)))
                                    (address-data (mapcar-assoc (cdadr mapping-elem)))
                                    (elem-name (car mapping-elem)))

-                               ;; outlook-web has 1 address line, bbdb requires 2

                                (if (= (length address-lines) 1)
                                (if (= (length address-lines) 1)

-                                   (setq address-lines (append address-lines '(""))))
+                                   (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 (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))
                                  (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")))
                                                           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"))
               (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)))
 
           (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."
 (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"
 
 ;;;###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)
 
 ;;;###autoload
 (defun bbdb3-csv-import-assoc-plus (key list)