[elpa] externals/ebdb 0120729 240/350: Add vcard unescaping, and some vcard tests

[Eric Abrahamsen]

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

    Add vcard unescaping, and some vcard tests
    
    * ebdb-vcard.el (ebdb-vcard-unescape): New function, also expand
      `ebdb-vcard-escape' so it doesn't double-escape. And fix bug
      revealed by testing.
    * ebdb-test.el (ebdb-vcard-escape/unescape,
      ebdb-vcard-export-dont-explode): New tests for some of this stuff.
---
 ebdb-test.el  | 83 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 ebdb-vcard.el | 19 ++++++++++----
 2 files changed, 96 insertions(+), 6 deletions(-)

diff --git a/ebdb-test.el b/ebdb-test.el
index 5a560ee..a081dc6 100644
--- a/ebdb-test.el
+++ b/ebdb-test.el
@@ -19,13 +19,16 @@
 
 ;;; Commentary:
 
-;; Tests for EBDB.
+;; Tests for EBDB.  Tests for EBDB's internationalization support are
+;; in a separate file, since loading ebdb-i18n.el overloads a bunch of
+;; methods, and un-overloading them is difficult.
 
 ;;; Code:
 
 (require 'ert)
 (require 'ebdb)
 (require 'ebdb-snarf)
+(require 'ebdb-vcard)
 
 ;; Testing macros.
 
@@ -264,5 +267,83 @@
                         t))
                       rec))))))
 
+;; Vcard testing.
+
+(ert-deftest ebdb-vcard-escape/unescape ()
+  "Test the escaping and unescaping routines."
+  (should (equal (ebdb-vcard-escape "Nothing.to \"escape\"!")
+                "Nothing.to \"escape\"!"))
+
+  (should (equal (ebdb-vcard-escape "Marry, nuncle")
+                "Marry\\, nuncle"))
+
+  (should (equal (ebdb-vcard-escape "Mine uncle; nay!")
+                "Mine uncle\\; nay!"))
+
+  ;; Don't double-escape
+  (should (equal (ebdb-vcard-escape "Marry\\, uncle")
+                "Marry\\, uncle"))
+
+  ;; Don't double-escape, part II
+  (should (equal (ebdb-vcard-escape "Marry\n uncle!")
+                "Marry\\n uncle!"))
+
+  (should (equal (ebdb-vcard-escape "Mine 
+uncle")
+                "Mine \\nuncle"))
+
+  (should (equal (ebdb-vcard-unescape "Marry\\, nuncle!")
+                "Marry, nuncle!"))
+
+  (should (equal (ebdb-vcard-unescape "Marry \\nuncle")
+                "Marry 
+uncle"))
+
+  (should (equal (ebdb-vcard-unescape
+                 (ebdb-vcard-escape
+                  "Look, a bog; dogs."))
+                "Look, a bog; dogs.")))
+
+(ert-deftest ebdb-vcard-export-dont-explode ()
+  "Can we export a record to Vcard without immediate disaster?"
+  (ebdb-test-with-records
+    (let ((rec (make-instance ebdb-default-record-class
+                             :name (ebdb-field-name-complex
+                                    :surname "Barleycorn"
+                                    :given-names '("John"))
+                             :uuid (ebdb-field-uuid
+                                    :uuid "asdfasdfadsf")
+                             :mail (list (ebdb-field-mail
+                                          :mail "address@hidden"))
+                             :phone (list (ebdb-field-phone
+                                           :object-name "home"
+                                           :country-code 1
+                                           :area-code 555
+                                           :number "5555555"))
+                             :notes (ebdb-field-notes
+                                     :notes "He's in the fields")))
+         (fmt-4
+          (ebdb-formatter-vcard-40
+           :combine nil
+           :collapse nil
+           :include '(ebdb-field-uuid
+                      ebdb-field-name
+                      ebdb-field-mail
+                      ebdb-field-phone
+                      ebdb-field-mail)))
+         (fmt-3
+          (ebdb-formatter-vcard-30
+           :combine nil
+           :collapse nil
+           :include '(ebdb-field-uuid
+                      ebdb-field-name
+                      ebdb-field-mail
+                      ebdb-field-phone
+                      ebdb-field-mail))))
+
+      (should (ebdb-fmt-record fmt-4 rec))
+
+      (should (ebdb-fmt-record fmt-3 rec)))))
+
 (provide 'ebdb-test)
 ;;; ebdb-test.el ends here
diff --git a/ebdb-vcard.el b/ebdb-vcard.el
index 3527358..ef305a9 100644
--- a/ebdb-vcard.el
+++ b/ebdb-vcard.el
@@ -123,8 +123,15 @@ not always respect these headings."
 (defsubst ebdb-vcard-escape (str)
   "Escape commas, semi-colons and newlines in STR."
   (replace-regexp-in-string
-   "\\(\n\\)" "\\\\n"
-   (replace-regexp-in-string "\\([,;]\\)" "\\\\\\1" str)))
+   "\\([^\\]\\)\n" "\\1\\\\n"
+   (replace-regexp-in-string "\\([^\\]\\)\\([,;]\\)" "\\1\\\\\\2" str)))
+
+(defun ebdb-vcard-unescape (str)
+  "Unescape escaped commas, semicolons and newlines in STR."
+  (replace-regexp-in-string
+   "\\\\n" "\n"
+   (replace-regexp-in-string
+    "\\\\\\([,;]\\)" "\\1" str)))
 
 (cl-defmethod ebdb-fmt-process-fields ((_f ebdb-formatter-vcard)
                                       (_record ebdb-record)
@@ -289,9 +296,11 @@ method is just responsible for formatting the record name."
                                    (field ebdb-field-labeled)
                                    _style
                                    _record)
-  (concat (cl-call-next-method)
-         ";TYPE=" (ebdb-vcard-escape
-                   (slot-value field 'object-name))))
+  (let ((ret (cl-call-next-method)))
+    (if-let ((lab (slot-value field 'object-name)))
+       (concat ret
+               ";TYPE=" (ebdb-vcard-escape lab))
+      ret)))
 
 (cl-defmethod ebdb-fmt-field ((_f ebdb-formatter-vcard)
                              (addr ebdb-field-address)