[elpa] externals/ebdb bc71bda 099/350: Many fixes to migration routine

[Eric Abrahamsen]

branch: externals/ebdb
commit bc71bda8038fa21aece8795413c37e082664255e
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Many fixes to migration routine
    
    Fixes #15
    
    Thanks to Andy Cowling for reporting.
    
    * ebdb-migrate.el (ebdb-migrate-vector-to-class): Had accumulated many
      small bugs.
      (ebdb-migrate-parse-records): This is the weird part, no idea how
      this had ever worked.
    * ebdb.el: Tweak requires and autoloads, as well as parts of the role
      adoption routine.
    * ebdb-gnus.el: Autoload message-make-domain.
---
 ebdb-gnus.el    |  2 ++
 ebdb-migrate.el | 33 ++++++++++++++++++++++-----------
 ebdb.el         |  8 +++++---
 3 files changed, 29 insertions(+), 14 deletions(-)

diff --git a/ebdb-gnus.el b/ebdb-gnus.el
index 00feef1..8af8e58 100644
--- a/ebdb-gnus.el
+++ b/ebdb-gnus.el
@@ -27,6 +27,8 @@
 (require 'ebdb-mua)
 (require 'gnus)
 
+(autoload 'message-make-domain "message")
+
 (defgroup ebdb-mua nil
   "Variables that specify the EBDB-MUA interface"
   :group 'ebdb)
diff --git a/ebdb-migrate.el b/ebdb-migrate.el
index dbabffa..dffbf69 100644
--- a/ebdb-migrate.el
+++ b/ebdb-migrate.el
@@ -375,7 +375,7 @@ holding valid contacts in a previous BBDB format."
   (require 'ebdb-gnus)
   (with-current-buffer (find-file-noselect bbdb-file)
     (when (and (/= (point-min) (point-max))
-              (yes-or-no-p "Upgrade from previous version of BBDB?"))
+              (yes-or-no-p "Upgrade from previous version of BBDB? "))
       (let ((v-records (ebdb-migrate-parse-records))
            (target-db (if (= (length ebdb-db-list) 1)
                           (car ebdb-db-list)
@@ -522,11 +522,13 @@ holding valid contacts in a previous BBDB format."
                                      :timestamp
                                      (apply #'encode-time
                                             (parse-time-string val)))))
-        ((eq lab ebdb-mail-alias-field)
+        ((eq lab 'mail-alias)
          (push (make-instance 'ebdb-field-mail-alias
-                              :alias val)
+                              :alias val
+                              :address (car-safe mails))
                fields))
-        ((string-match-p val url-handler-regexp)
+        ((and (stringp v)
+              (string-match-p val url-handler-regexp))
          (push (make-instance 'ebdb-field-url
                               :url val)
                fields))
@@ -547,6 +549,15 @@ holding valid contacts in a previous BBDB format."
                                     :notes val)))
         ((eq lab 'messages)
          (unless (stringp val)
+           (setq val
+                 (mapcar
+                  (lambda (s)
+                    (make-gnorb-ebdb-link
+                     :subject (aref s 1)
+                     :date (aref s 2)
+                     :group (aref s 3)
+                     :id (aref s 4)))
+                  val))
            (push (make-instance 'gnorb-ebdb-field-messages
                                 :messages val)
                  fields)))
@@ -554,7 +565,7 @@ holding valid contacts in a previous BBDB format."
          (push (make-instance 'ebdb-org-field-tags
                               :tags (if (listp val)
                                         val
-                                      (split-string val ";" t t)))
+                                      (split-string val ";" t " ")))
                fields))
         ((memq lab (list bbdb/gnus-score-field
                          bbdb/gnus-split-private-field
@@ -596,18 +607,18 @@ holding valid contacts in a previous BBDB format."
       (widen)
       (goto-char (point-min))
       ;; look backwards for file-format, and convert if necessary.
-      (let ((file-format (save-excursion
-                           (if (re-search-backward
-                                "^;+[ \t]*file-\\(format\\|version\\):[ 
\t]*\\([0-9]+\\)[ \t]*$" nil t)
-                               (string-to-number (match-string 2)))))
+      (let ((file-format
+            (if (re-search-forward
+                 "^;+[ \t]*file-\\(format\\|version\\):[ \t]*\\([0-9]+\\)[ 
\t]*$" nil t)
+                (string-to-number (match-string 2))))
             migrate records)
         (unless file-format ; current file-format, but no file-format: line.
           (error "BBDB corrupted: no file-format line"))
         (if (> file-format ebdb-file-format)
-            (error "BBDB version %s understands file format %s but not %s."
+            (error "EBDB version %s understands file format %s but not %s."
                    ebdb-version ebdb-file-format file-format)
           (setq migrate (< file-format ebdb-file-format)))
-
+       (forward-char)
         (or (eobp) (looking-at "\\[")
             (error "BBDB corrupted: no following bracket"))
 
diff --git a/ebdb.el b/ebdb.el
index b781725..c18a654 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -45,6 +45,7 @@
 (require 'timezone)
 (require 'cl-lib)
 (require 'seq)
+(require 'subr-x)
 (require 'pcase)
 (require 'eieio)
 (require 'eieio-base)
@@ -52,7 +53,7 @@
 
 (eval-when-compile              ; pacify the compiler.
   (autoload 'widget-group-match "wid-edit")
-  (autoload 'ebdb-migrate "ebdb-migrate")
+  (autoload 'ebdb-migrate-from-bbdb "ebdb-migrate")
   (autoload 'ebdb-do-records "ebdb-com")
   (autoload 'ebdb-append-display-p "ebdb-com")
   (autoload 'ebdb-toggle-records-layout "ebdb-com")
@@ -2583,7 +2584,7 @@ be moved to a role at ORG.
 Currently only works for mail fields."
   (let ((roles (slot-value record 'organizations))
        (org-domain (slot-value org 'domain))
-       org mail-domain)
+       mail-domain)
     (dolist (r roles)
       (when (and (string= (slot-value r 'org-uuid) (ebdb-record-uuid org))
                 org-domain)
@@ -2635,7 +2636,8 @@ appropriate person record."
                                               _slot
                                               (field ebdb-field-role))
   (let ((org (ebdb-gethash (slot-value field 'org-uuid) 'uuid)))
-    (ebdb-record-adopt-role-fields record org t)))
+    (when org
+      (ebdb-record-adopt-role-fields record org t))))
 
 (cl-defmethod ebdb-record-change-name ((org ebdb-record-organization) 
&optional name)
   (let ((new-name (or name (ebdb-read 'ebdb-field-name-simple nil (slot-value 
org 'name)))))