[elpa] externals/emms 16f107b583 24/42: Use bindat-type in emms-info-vorbis

[ELPA Syncer]

branch: externals/emms
commit 16f107b583f7238aba2f8d38382ec795b6b76551
Author: Petteri Hintsanen <petterih@iki.fi>
Commit: Petteri Hintsanen <petterih@iki.fi>

    Use bindat-type in emms-info-vorbis
---
 emms-info-vorbis.el            | 187 +++++++++++++++++++++++++++--------------
 test/emms-info-vorbis-tests.el |  21 +++--
 2 files changed, 140 insertions(+), 68 deletions(-)

diff --git a/emms-info-vorbis.el b/emms-info-vorbis.el
index e41f8c0e57..1f50e738c1 100644
--- a/emms-info-vorbis.el
+++ b/emms-info-vorbis.el
@@ -27,6 +27,9 @@
 
 ;;; Code:
 
+(require 'bindat)
+(require 'emms)
+
 (defconst emms-info-vorbis--max-comments 1024
   "Maximum number of Vorbis comment fields in a stream.
 Technically a single Vorbis stream may have up to 2^32 comments,
@@ -76,75 +79,137 @@ their comments have almost the same format as Vorbis.")
     "year")
   "EMMS info fields that are extracted from Vorbis comments.")
 
-(defconst emms-info-vorbis--headers-bindat-spec
-  '((identification-header struct emms-info-vorbis--id-header-bindat-spec)
-    (comment-header struct emms-info-vorbis--comment-header-bindat-spec))
-  "Specification for first two Vorbis header packets.
-They are always an identification header followed by a comment
-header.")
+(defconst emms-info-vorbis--header-magic-pattern "vorbis"
+  "Header packet magic pattern.")
 
 (defconst emms-info-vorbis--id-header-bindat-spec
-  '((packet-type u8)
-    (eval (unless (= last 1)
-            (error "Vorbis header type mismatch: expected 1, got %s"
-                   last)))
-    (vorbis str 6)
-    (eval (unless (equal last emms-info-vorbis--header-magic-pattern)
-            (error "Vorbis framing mismatch: expected `%s', got `%s'"
-                   emms-info-vorbis--header-magic-pattern
-                   last)))
-    (vorbis-version u32r)
-    (eval (unless (= last 0)
-            (error "Vorbis version mismatch: expected 0, got %s"
-                   last)))
-    (channel-count u8)
-    (sample-rate u32r)
-    (bitrate-maximum u32r)
-    (bitrate-nominal u32r)
-    (bitrate-minimum u32r)
-    (blocksize u8)
-    (framing-flag u8)
-    (eval (unless (= last 1))
-          (error "Vorbis framing bit mismatch: expected 1, got %s"
-                 last)))
+  (if emms--use-bindat-type
+      (bindat-type
+        (packet-type u8)
+        (_ unit (unless (= packet-type 1)
+                  (error "Vorbis header type mismatch: expected 1, got %s"
+                         packet-type)))
+        (vorbis str 6)
+        (_ unit (unless (equal vorbis emms-info-vorbis--header-magic-pattern)
+                  (error "Vorbis framing mismatch: expected `%s', got `%s'"
+                         emms-info-vorbis--header-magic-pattern
+                         vorbis)))
+        (vorbis-version uint 32 'le)
+        (_ unit (unless (= vorbis-version 0)
+                  (error "Vorbis version mismatch: expected 0, got %s"
+                         vorbis-version)))
+        (channel-count u8)
+        (sample-rate uint 32 'le)
+        (bitrate-maximum uint 32 'le)
+        (bitrate-nominal uint 32 'le)
+        (bitrate-minimum uint 32 'le)
+        (blocksize u8)
+        (framing-flag u8)
+        (_ unit (unless (= framing-flag 1)
+                  (error "Vorbis framing bit mismatch: expected 1, got %s"
+                         framing-flag))))
+    '((packet-type u8)
+      (eval (unless (= last 1)
+              (error "Vorbis header type mismatch: expected 1, got %s"
+                     last)))
+      (vorbis str 6)
+      (eval (unless (equal last emms-info-vorbis--header-magic-pattern)
+              (error "Vorbis framing mismatch: expected `%s', got `%s'"
+                     emms-info-vorbis--header-magic-pattern
+                     last)))
+      (vorbis-version u32r)
+      (eval (unless (= last 0)
+              (error "Vorbis version mismatch: expected 0, got %s"
+                     last)))
+      (channel-count u8)
+      (sample-rate u32r)
+      (bitrate-maximum u32r)
+      (bitrate-nominal u32r)
+      (bitrate-minimum u32r)
+      (blocksize u8)
+      (framing-flag u8)
+      (eval (unless (= last 1))
+            (error "Vorbis framing bit mismatch: expected 1, got %s"
+                   last))))
   "Vorbis identification header specification.")
 
-(defconst emms-info-vorbis--header-magic-pattern "vorbis"
-  "Header packet magic pattern.")
+(defconst emms-info-vorbis--comment-field-bindat-spec
+  (if emms--use-bindat-type
+      (bindat-type
+        (length uint 32 'le)
+        (_ unit (when (> length emms-info-vorbis--max-comment-size)
+                  (error "Vorbis comment length %s is too long"
+                         length)))
+        (user-comment str length))
+    '((length u32r)
+      (eval (when (> last emms-info-vorbis--max-comment-size)
+              (error "Vorbis comment length %s is too long" last)))
+      (user-comment str (length))))
+  "Vorbis comment field specification.")
 
 (defconst emms-info-vorbis--comment-header-bindat-spec
-  '((packet-type u8)
-    (eval (unless (= last 3)
-            (error "Vorbis header type mismatch: expected 3, got %s"
-                   last)))
-    (vorbis str 6)
-    (eval (unless (equal last emms-info-vorbis--header-magic-pattern)
-            (error "Vorbis framing mismatch: expected `%s', got `%s'"
-                   emms-info-vorbis--header-magic-pattern
-                   last)))
-    (vendor-length u32r)
-    (eval (when (> last emms-info-vorbis--max-vendor-length)
-            (error "Vorbis vendor length %s is too long" last)))
-    (vendor-string str (vendor-length))
-    (user-comments-list-length u32r)
-    (eval (when (> last emms-info-vorbis--max-comments)
-            (error "Vorbis user comment list length %s is too long"
-                   last)))
-    (user-comments repeat
-                   (user-comments-list-length)
-                   (struct emms-info-vorbis--comment-field-bindat-spec))
-    (framing-bit u8)
-    (eval (unless (= last 1))
-          (error "Vorbis framing bit mismatch: expected 1, got %s"
-                 last)))
+  (if emms--use-bindat-type
+      (bindat-type
+        (packet-type u8)
+        (_ unit (unless (= packet-type 3)
+                  (error "Vorbis header type mismatch: expected 3, got %s"
+                         packet-type)))
+        (vorbis str 6)
+        (_ unit (unless (equal vorbis emms-info-vorbis--header-magic-pattern)
+                  (error "Vorbis framing mismatch: expected `%s', got `%s'"
+                         emms-info-vorbis--header-magic-pattern
+                         vorbis)))
+        (vendor-length uint 32 'le)
+        (_ unit (when (> vendor-length emms-info-vorbis--max-vendor-length)
+                  (error "Vorbis vendor length %s is too long"
+                         vendor-length)))
+        (vendor-string str vendor-length)
+        (user-comments-list-length uint 32 'le)
+        (_ unit (when (> user-comments-list-length 
emms-info-vorbis--max-comments)
+                  (error "Vorbis user comment list length %s is too long"
+                         user-comments-list-length)))
+        (user-comments repeat user-comments-list-length
+                       type emms-info-vorbis--comment-field-bindat-spec)
+        (framing-bit u8)
+        (_ unit (unless (= framing-bit 1)
+                  (error "Vorbis framing bit mismatch: expected 1, got %s"
+                         framing-bit))))
+    '((packet-type u8)
+      (eval (unless (= last 3)
+              (error "Vorbis header type mismatch: expected 3, got %s"
+                     last)))
+      (vorbis str 6)
+      (eval (unless (equal last emms-info-vorbis--header-magic-pattern)
+              (error "Vorbis framing mismatch: expected `%s', got `%s'"
+                     emms-info-vorbis--header-magic-pattern
+                     last)))
+      (vendor-length u32r)
+      (eval (when (> last emms-info-vorbis--max-vendor-length)
+              (error "Vorbis vendor length %s is too long" last)))
+      (vendor-string str (vendor-length))
+      (user-comments-list-length u32r)
+      (eval (when (> last emms-info-vorbis--max-comments)
+              (error "Vorbis user comment list length %s is too long"
+                     last)))
+      (user-comments repeat
+                     (user-comments-list-length)
+                     (struct emms-info-vorbis--comment-field-bindat-spec))
+      (framing-bit u8)
+      (eval (unless (= last 1))
+            (error "Vorbis framing bit mismatch: expected 1, got %s"
+                   last))))
   "Vorbis comment header specification.")
 
-(defconst emms-info-vorbis--comment-field-bindat-spec
-  '((length u32r)
-    (eval (when (> last emms-info-vorbis--max-comment-size)
-            (error "Vorbis comment length %s is too long" last)))
-    (user-comment str (length)))
-  "Vorbis comment field specification.")
+(defconst emms-info-vorbis--headers-bindat-spec
+  (if emms--use-bindat-type
+      (bindat-type
+        (_ struct (identification-header type 
emms-info-vorbis--id-header-bindat-spec)
+                  (comment-header type 
emms-info-vorbis--comment-header-bindat-spec)))
+    '((identification-header struct emms-info-vorbis--id-header-bindat-spec)
+      (comment-header struct emms-info-vorbis--comment-header-bindat-spec)))
+  "Specification for first two Vorbis header packets.
+They are always an identification header followed by a comment
+header.")
 
 (defun emms-info-vorbis-extract-comments (user-comments)
   "Return a decoded list of comments from USER-COMMENTS.
diff --git a/test/emms-info-vorbis-tests.el b/test/emms-info-vorbis-tests.el
index c5c424a38f..019a2657f5 100644
--- a/test/emms-info-vorbis-tests.el
+++ b/test/emms-info-vorbis-tests.el
@@ -27,12 +27,19 @@
 (require 'ert)
 
 (ert-deftest emms-vorbis-test-extract-comments ()
-  (let ((comments `(((user-comment . ,(unibyte-string 77 85 83 73 67 66 82 65 
73 78 90 95 82 69 76 69 65 83 69 71 82 79 85 80 73 68 61 57 98 51 48 55 50 57 
51 45 100 50 101 54 45 51 52 97 57 45 97 50 56 57 45 49 54 49 99 53 98 97 102 
49 56 55 102)) (length . 63)) ;musicbrainz_releasegroupid
-                    ((user-comment . ,(unibyte-string 79 82 73 71 73 78 65 76 
68 65 84 69 61 49 57 57 55 45 48 51 45 51 49)) (length . 23)) ;originaldate
-                    ((user-comment . ,(unibyte-string 79 82 73 71 73 78 65 76 
89 69 65 82 61 49 57 57 55)) (length . 17)) ;originalyear
-                    ((user-comment . ,(unibyte-string 82 69 76 69 65 83 69 84 
89 80 69 61 97 108 98 117 109)) (length . 17)) ;releasetype
-                    ((user-comment . ,(unibyte-string 66 65 82 67 79 68 69 61 
55 54 57 50 51 51 48 48 52 55 50 55)) (length . 20)) ;barcode
-                    ((user-comment . ,(unibyte-string 65 76 66 85 77 61 65 32 
116 111 100 97 32 67 117 98 97 32 108 101 32 103 117 115 116 97)) (length . 
26))))) ;album
+  (let ((comments
+         (quote (((user-comment . 
"MUSICBRAINZ_RELEASEGROUPID=9b307293-d2e6-34a9-a289-161c5baf187f")
+                  (length . 63))
+                 ((user-comment . "ORIGINALDATE=1997-03-31")
+                  (length . 23))
+                 ((user-comment . "ORIGINALYEAR=1997")
+                  (length . 17))
+                 ((user-comment . "RELEASETYPE=album")
+                  (length . 17))
+                 ((user-comment . "BARCODE=769233004727")
+                  (length . 20))
+                 ((user-comment . "ALBUM=A toda Cuba le gusta")
+                  (length . 26))))))
     (should (equal (emms-info-vorbis-extract-comments comments)
                    (quote (("album" . "A toda Cuba le gusta")
                            ("originalyear" . "1997")
@@ -47,7 +54,7 @@
                  (cons "a" "B")))
   (should (equal (emms-info-vorbis--split-comment "abc=ABC=123")
                  (cons "abc" "ABC=123")))
-  (let ((comment (unibyte-string 75 101 121 61 206 159 225 189 144 207 135 225 
189 182 32 206 164 206 177 225 189 144 207 132 225 189 176 10))) ;Key=Οὐχὶ Ταὐτὰ
+  (let ((comment "Key=\316\237\341\275\220\317\207\341\275\266 
\316\244\316\261\341\275\220\317\204\341\275\260"))
     (should (equal (emms-info-vorbis--split-comment comment)
                    (cons "key" "Οὐχὶ Ταὐτὰ")))))