[elpa] externals/emms b083c59e18 07/42: Decode playing time from MP3 files

[ELPA Syncer]

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

    Decode playing time from MP3 files
    
    MP3 does not have a single, well-defined concept of embedded "playing
    time" or stream length.  Therefore this implementation relies on
    estimation with three heuristics:
    
    - For constant bit rates, estimate the length based on encoded bit
    rate and input file size.
    
    - For variable bit rates, try to decode the total frame count from
    Xing/Info/VBRI header if available in the input file and use that for
    estimating the length.
---
 emms-info-native.el            | 245 +++++++++++++++++++++++++++++++++++++++--
 test/emms-info-native-tests.el | 122 ++++++++++++++++++--
 2 files changed, 349 insertions(+), 18 deletions(-)

diff --git a/emms-info-native.el b/emms-info-native.el
index a5d5219149..334f41dd06 100644
--- a/emms-info-native.el
+++ b/emms-info-native.el
@@ -57,6 +57,9 @@
 ;;
 ;; Format detection is based solely on filename extension, which is
 ;; matched case-insensitively.
+;;
+;; For technical details on MP3 duration estimation, see URL
+;; `https://www.codeproject.com/Articles/8295/MPEG-Audio-Frame-Header'.
 
 ;;; Code:
 
@@ -558,11 +561,11 @@ Granule position is 64-bit little-endian signed integer 
counting
 the number of PCM samples per channel.  If granule position is
 -1, it was for a partial packet and hence invalid.  In that case
 return nil."
-  (let* ((int (emms-info-native--vector-to-integer vec))
+  (let* ((int (emms-info-native--lsb-to-integer vec))
          (pos (emms-info-native--unsigned-to-signed int 64)))
     (unless (= pos -1) (/ pos rate))))
 
-(defun emms-info-native--vector-to-integer (vec)
+(defun emms-info-native--lsb-to-integer (vec)
   (apply '+ (seq-map-indexed (lambda (elt idx)
                                (* (expt 2 (* 8 idx)) elt))
                              vec)))
@@ -652,7 +655,7 @@ Return the comment block data in a vector."
       comment-block)))
 
 
-;;;; id3v2 (MP3) code
+;;;; MP3 code
 
 (defconst emms-info-native--id3v2-header-bindat-spec
   '((file-identifier vec 3)
@@ -852,11 +855,66 @@ Sources:
     (3 . utf-8))
   "id3v2 text encodings.")
 
+(defconst emms-info-native--mp3-audio-versions
+  '((0 . mpeg25)
+    (1 . reserved)
+    (2 . mpeg2)
+    (3 . mpeg1)))
+
+(defconst emms-info-native--mp3-layers
+  '((0 . reserved)
+    (1 . layerIII)
+    (2 . layerII)
+    (3 . layerI)))
+
+(defconst emms-info-native--mp3-channel-modes
+  '((0 . stereo)
+    (1 . joint-stereo)
+    (2 . dual-channel)
+    (3 . single-channel)))
+
+(defconst emms-info-native--mp3-bit-rates
+  '((mpeg1-layerI       'free  32  64  96  128  160  192  224  256  288  320  
352  384  416  448  'reserved)
+    (mpeg1-layerII      'free  32  48  56  64   80   96   112  128  160  192  
224  256  320  384  'reserved)
+    (mpeg1-layerIII     'free  32  40  48  56   64   80   96   112  128  160  
192  224  256  320  'reserved)
+    (mpeg2x-layerI      'free  32  48  56  64   80   96   112  128  144  160  
176  192  224  256  'reserved)
+    (mpeg2x-layerII-III 'free  8   16  24  32   40   48   56   64   80   96   
112  128  144  160  'reserved)))
+
+(defconst emms-info-native--mp3-samples-per-frame
+  '((layerI . 384)
+    (layerII . 1152)
+    (layerIII-mpeg1 . 1152)
+    (layerIII-mpeg2x . 576)))
+
+(defconst emms-info-native--mp3-sample-rates
+  '((mpeg1  44100  48000  32000  'reserved)
+    (mpeg2  22050  24000  16000  'reserved)
+    (mpeg25 11025  12000  8000   'reserved)))
+
+(defconst emms-info-native--vbri-header-bindat-spec
+  '((id vec 4)
+    (version u16)
+    (delay u16)
+    (quality u16)
+    (bytes u32)
+    (frames u32))
+  "VBR header, VBRI format.
+This spec is purposefully incomplete, as we are interested only
+in frame count.")
+
+(defconst emms-info-native--xing-header-bindat-spec
+  '((id vec 4)
+    (flags bits 4)
+    (frames u32))
+  "VBR header, Xing/Info format.
+This spec is purposefully incomplete, as we are is interested
+only in frame count.")
+
 (defun emms-info-native--valid-id3v2-frame-id-p (id)
   "Return t if ID is a proper id3v2 frame identifier, nil otherwise."
   (if (= emms-info-native--id3v2-version 2)
-      (string-match "[A-Z0-9]\\{3\\}" id)
-    (string-match "[A-Z0-9]\\{4\\}" id)))
+      (string-match "^[A-Z0-9]\\{3\\}$" id)
+    (string-match "^[A-Z0-9]\\{4\\}$" id)))
 
 (defun emms-info-native--checked-id3v2-size (elt bytes)
   "Calculate id3v2 element ELT size from BYTES.
@@ -879,9 +937,11 @@ Depending on SYNCSAFE, BYTES are interpreted as 7- or 8-bit
 bytes, MSB first.
 
 Return the decoded size."
-  (let ((num-bits (if syncsafe 7 8)))
+  (let ((num-bits (if syncsafe 7 8))
+        (mask (if syncsafe #x7f #xff)))
     (apply '+ (seq-map-indexed (lambda (elt idx)
-                                 (* (expt 2 (* num-bits idx)) elt))
+                                 (* (expt 2 (* num-bits idx))
+                                    (logand elt mask)))
                                (reverse bytes)))))
 
 (defun emms-info-native--decode-id3v2 (filename)
@@ -901,10 +961,12 @@ fields."
           ;; Skip the extended header.
           (cl-incf offset
                    (emms-info-native--checked-id3v2-ext-header-size filename)))
-        (emms-info-native--decode-id3v2-frames filename
-                                               offset
-                                               (+ tag-size 10)
-                                               unsync))
+        (let ((tags (emms-info-native--decode-id3v2-frames
+                     filename offset (+ tag-size 10) unsync))
+              (playtime (emms-info-native--decode-mp3-duration
+                         filename (+ tag-size 10))))
+          (nconc tags (when playtime
+                        (list (cons "playing-time" playtime))))))
     (error nil)))
 
 (defun emms-info-native--decode-id3v2-header (filename)
@@ -1070,6 +1132,167 @@ Return the text as string."
   (cdr (assoc (seq-first bytes)
               emms-info-native--id3v2-text-encodings)))
 
+(defun emms-info-native--decode-mp3-duration (filename offset)
+  (with-temp-buffer
+    (set-buffer-multibyte nil)
+    (insert-file-contents-literally filename nil offset (+ offset 1024))
+    (let* ((header (emms-info-native--find-and-decode-mp3-frame-header))
+           (samples-per-frame (alist-get 'samples-per-frame header))
+           (sample-rate (alist-get 'sample-rate header))
+           (bit-rate (alist-get 'bit-rate header))
+           (frames (or (emms-info-native--find-and-decode-xing-header)
+                       (emms-info-native--find-and-decode-vbri-header))))
+      (cond ((and frames samples-per-frame sample-rate)
+             (/ (* frames samples-per-frame) sample-rate))
+            (bit-rate
+             (emms-info-native--estimate-mp3-duration
+              filename bit-rate))))))
+
+(defun emms-info-native--find-and-decode-mp3-frame-header ()
+  (let (header)
+    (goto-char (point-min))
+    (condition-case nil
+        (while (and (not header)
+                    (search-forward (string 255)))
+          (let ((bytes (emms-info-native--msb-to-integer
+                        (buffer-substring-no-properties
+                         (- (point) 1) (+ (point) 3)))))
+            (setq header
+                  (emms-info-native--decode-mp3-frame-header bytes))))
+      (error nil))
+    header))
+
+(defun emms-info-native--decode-mp3-frame-header (header)
+  (when (= (logand header #xffe00000) #xffe00000)
+    (let* ((version-bits
+            (emms-info-native--extract-bits header 19 20))
+           (layer-bits
+            (emms-info-native--extract-bits header 17 18))
+           (crc-bit
+            (emms-info-native--extract-bits header 16))
+           (bit-rate-bits
+            (emms-info-native--extract-bits header 12 15))
+           (sample-rate-bits
+            (emms-info-native--extract-bits header 10 11))
+           (padding-bit
+            (emms-info-native--extract-bits header 9))
+           (private-bit
+            (emms-info-native--extract-bits header 8))
+           (channel-mode-bits
+            (emms-info-native--extract-bits header 6 7))
+           (mode-extension-bits
+            (emms-info-native--extract-bits header 4 5))
+           (copyright-bit
+            (emms-info-native--extract-bits header 3))
+           (original-bit
+            (emms-info-native--extract-bits header 2))
+           (emphasis-bits
+            (emms-info-native--extract-bits header 0 1))
+           (version
+            (alist-get version-bits
+                       emms-info-native--mp3-audio-versions))
+           (layer
+            (alist-get layer-bits
+                       emms-info-native--mp3-layers))
+           (channel-mode
+            (alist-get channel-mode-bits
+                       emms-info-native--mp3-channel-modes))
+           (sample-rate
+            (nth sample-rate-bits
+                 (alist-get version
+                            emms-info-native--mp3-sample-rates)))
+           (samples-per-frame
+            (emms-info-native--get-samples-per-frame
+             version layer))
+           (bit-rate
+            (emms-info-native--decode-bit-rate
+             version layer bit-rate-bits)))
+      (list (cons 'version version)
+            (cons 'layer layer)
+            (cons 'crc crc-bit)
+            (cons 'bit-rate bit-rate)
+            (cons 'sample-rate sample-rate)
+            (cons 'samples-per-frame samples-per-frame)
+            (cons 'padding padding-bit)
+            (cons 'private private-bit)
+            (cons 'channel-mode channel-mode)
+            (cons 'mode-extension mode-extension-bits)
+            (cons 'copyright copyright-bit)
+            (cons 'emphasis emphasis-bits)
+            (cons 'original original-bit)))))
+
+(defun emms-info-native--find-and-decode-xing-header ()
+  (goto-char (point-min))
+  (when (re-search-forward "Xing\\|Info" (point-max) t)
+    (let ((header (bindat-unpack
+                   emms-info-native--xing-header-bindat-spec
+                   (buffer-string) (1- (match-beginning 0)))))
+      (when (memq 0 (bindat-get-field header 'flags))
+        (bindat-get-field header 'frames)))))
+
+(defun emms-info-native--find-and-decode-vbri-header ()
+  (goto-char (point-min))
+  (when (re-search-forward "VBRI" (point-max) t)
+    (let ((header (bindat-unpack
+                   emms-info-native--vbri-header-bindat-spec
+                   (buffer-string) (1- (match-beginning 0)))))
+      (bindat-get-field header 'frames))))
+
+(defun emms-info-native--estimate-mp3-duration (filename bitrate)
+  (let ((size (file-attribute-size
+               (file-attributes (file-chase-links filename)))))
+    (when bitrate (/ (* 8 size) (* 1000 bitrate)))))
+
+(defun emms-info-native--extract-bits (int from &optional to)
+  "Extract consequent set bits FROM[..TO] from INT.
+The first (rightmost) bit is zero.  Return the value of bits as
+if they would have been shifted to right by FROM positions."
+  (unless to (setq to from))
+  (let ((num-bits (1+ (- to from)))
+        (mask (1- (expt 2 (1+ to)))))
+    (when (> num-bits 0) (ash (logand int mask) (- from)))))
+
+(defun emms-info-native--msb-to-integer (vec)
+  (emms-info-native--lsb-to-integer (reverse vec)))
+
+(defun emms-info-native--decode-bit-rate (version layer bits)
+  (cond ((eq version 'mpeg1)
+         (cond ((eq layer 'layerI)
+                (nth bits (alist-get
+                           'mpeg1-layerI
+                           emms-info-native--mp3-bit-rates)))
+               ((eq layer 'layerII)
+                (nth bits (alist-get
+                           'mpeg1-layerII
+                           emms-info-native--mp3-bit-rates)))
+               ((eq layer 'layerIII)
+                (nth bits (alist-get
+                           'mpeg1-layerIII
+                           emms-info-native--mp3-bit-rates)))))
+        (t (cond ((eq layer 'layerI)
+                  (nth bits (alist-get
+                             'mpeg2x-layerI
+                             emms-info-native--mp3-bit-rates)))
+                 (t (nth bits (alist-get
+                               'mpeg2x-layerII-III
+                               emms-info-native--mp3-bit-rates)))))))
+
+(defun emms-info-native--get-samples-per-frame (version layer)
+  (cond ((eq layer 'layerIII)
+         (cond ((eq version 'mpeg1)
+                (alist-get
+                 'layerIII-mpeg1
+                 emms-info-native--mp3-samples-per-frame))
+               (t (alist-get
+                   'layerIII-mpeg2x
+                   emms-info-native--mp3-samples-per-frame))))
+        ((eq layer 'layerII)
+         (alist-get 'layerII
+                    emms-info-native--mp3-samples-per-frame))
+        ((eq layer 'layerI)
+         (alist-get 'layerI
+                    emms-info-native--mp3-samples-per-frame))))
+
 
 ;;;; EMMS code
 
diff --git a/test/emms-info-native-tests.el b/test/emms-info-native-tests.el
index 952624c4d1..ed4623df9d 100644
--- a/test/emms-info-native-tests.el
+++ b/test/emms-info-native-tests.el
@@ -122,13 +122,13 @@
   (should (equal (emms-info-native--decode-ogg-granule-position [255 255 255 
255 255 255 255 255] nil)
                  nil)))
 
-(ert-deftest emms-test-vector-to-integer ()
-  (should (equal (emms-info-native--vector-to-integer [0]) 0))
-  (should (equal (emms-info-native--vector-to-integer [127]) 127))
-  (should (equal (emms-info-native--vector-to-integer [255]) 255))
-  (should (equal (emms-info-native--vector-to-integer [0 1]) 256))
-  (should (equal (emms-info-native--vector-to-integer [1 0]) 1))
-  (should (equal (emms-info-native--vector-to-integer [0 128]) 32768)))
+(ert-deftest emms-test-lsb-to-integer ()
+  (should (equal (emms-info-native--lsb-to-integer [0]) 0))
+  (should (equal (emms-info-native--lsb-to-integer [127]) 127))
+  (should (equal (emms-info-native--lsb-to-integer [255]) 255))
+  (should (equal (emms-info-native--lsb-to-integer [0 1]) 256))
+  (should (equal (emms-info-native--lsb-to-integer [1 0]) 1))
+  (should (equal (emms-info-native--lsb-to-integer [0 128]) 32768)))
 
 (ert-deftest emms-test-unsigned-to-signed ()
   (should (equal (emms-info-native--unsigned-to-signed 0 8) 0))
@@ -155,3 +155,111 @@
   (should (equal (emms-info-native--decode-flac-comment-block 
#'emms-test-valid-flac-block)
                  [1 2 3 4])))
 
+(ert-deftest emms-test-valid-id3v2-frame-id-p ()
+  (let ((emms-info-native--id3v2-version 2))
+    (should (emms-info-native--valid-id3v2-frame-id-p "A1B"))
+    (should (not (emms-info-native--valid-id3v2-frame-id-p "~B1")))
+    (should (not (emms-info-native--valid-id3v2-frame-id-p "XX")))
+    (should (not (emms-info-native--valid-id3v2-frame-id-p "XXXX"))))
+  (let ((emms-info-native--id3v2-version 3))
+    (should (emms-info-native--valid-id3v2-frame-id-p "ABC9"))
+    (should (not (emms-info-native--valid-id3v2-frame-id-p "~BCD")))
+    (should (not (emms-info-native--valid-id3v2-frame-id-p "XXX")))
+    (should (not (emms-info-native--valid-id3v2-frame-id-p "XXXXX")))))
+
+(ert-deftest emms-test-checked-id3v2-size ()
+  (should (= (emms-info-native--checked-id3v2-size 'tag [0 0 2 1]) 257))
+  (should (= (emms-info-native--checked-id3v2-size 'tag [1 1 1 1]) 2113665))
+  (should (= (emms-info-native--checked-id3v2-size 'tag [#xff #xff #xff #xff])
+             (1- (* 256 1024 1024))))
+  (should (= (emms-info-native--checked-id3v2-size 'tag [#x7f #x7f #x7f #x7f])
+             (1- (* 256 1024 1024))))
+  (should (= (emms-info-native--checked-id3v2-size 'tag [#x12 #x34 #x56 #x78])
+             38611832))
+  (let ((emms-info-native--id3v2-version 4))
+    (should (= (emms-info-native--checked-id3v2-size 'frame [#xff #xff #xff 
#xff])
+               (1- (* 256 1024 1024)))))
+  (let ((emms-info-native--id3v2-version 3))
+    (should (= (emms-info-native--checked-id3v2-size 'frame [#xff #xff #xff 
#xff])
+               (1- (* 4 1024 1024 1024))))))
+
+(ert-deftest emms-test-decode-id3v2-size ()
+  (should (= (emms-info-native--decode-id3v2-size [01 01 01 01] nil)
+             16843009))
+  (should (= (emms-info-native--decode-id3v2-size [01 01 01 01] t)
+             2113665))
+  (should (= (emms-info-native--decode-id3v2-size [00 00 02 01] nil)
+             513))
+  (should (= (emms-info-native--decode-id3v2-size [00 00 02 01] t)
+             257)))
+
+(ert-deftest emms-test-extract-bits ()
+  (should (= (emms-info-native--extract-bits 128 7) 1))
+  (should (= (emms-info-native--extract-bits 64 6 7) 1))
+  (should (= (emms-info-native--extract-bits 128 6 7) 2))
+  (should (= (emms-info-native--extract-bits 192 6 7) 3))
+  (should (eq (emms-info-native--extract-bits 192 7 6) nil))
+  (should (= (emms-info-native--extract-bits 128 32) 0))
+  (should (= (emms-info-native--extract-bits 4294688772 21 31) 2047)))
+
+(ert-deftest emms-test-decode-mp3-frame-header ()
+  (with-temp-buffer
+    (set-buffer-multibyte nil)
+    (insert (concat [#x00 #x00 #x00 #x00 #x00 #x00 #x00 #xff #xfb
+                          #xb0 #x04 #x00 #x00 #x00 #x00 #x00 #x69 #x06 #x00 
#x00 #x00 #x00
+                          #x00 #x0d #x20 #xc0 #x00 #x00 #x00 #x00 #x01 #xa4 
#x1c #x00 #x00
+                          #x00 #x00 #x00 #x34 #x83 #x80 #x00 #x00 #x4c #x41 
#x4d #x45 #x33
+                          #x2e #x39 #x31 #x55 #x55]))
+    (should (equal (emms-info-native--find-and-decode-mp3-frame-header)
+                   '((version . mpeg1)
+                     (layer . layerIII)
+                     (crc . 1)
+                     (bit-rate . 192)
+                     (sample-rate . 44100)
+                     (samples-per-frame . 1152)
+                     (padding . 0)
+                     (private . 0)
+                     (channel-mode . stereo)
+                     (mode-extension . 0)
+                     (copyright . 0)
+                     (emphasis . 0)
+                     (original . 1))))))
+
+(ert-deftest emms-test-decode-xing-header ()
+  (with-temp-buffer
+    (set-buffer-multibyte nil)
+    (insert (concat [255 234 144 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+                         0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 88 105 110 103 0 0 
0 15 0 0 33
+                         89 0 80 29 121 0 3 6 8 11 14 15 18 21 23 26 29 31 34 
37 39 42 45
+                         47 50 53 55 57 60 62 65 68 70 73 76 78 81 84 86 89 92 
94 97 100
+                         101 104 107 109 112 115 117 120 122 123 125 127 130 
133 135 138
+                         141 143 146 149 151 154 157 159 162 165 167 170 173 
174 177 180
+                         182 185 188 190 193 196 198 201 204 206 209 212 214 
217 220 222
+                         225 228 230 233 236 238 241 244 246 249 251 253 255 0 
0 0 88 76
+                         65 77 69 51 46 56 56 32 40 97 108 112 104 97 41 0 0 
]))
+    (should (= (emms-info-native--find-and-decode-xing-header) 8537))))
+
+(ert-deftest emms-test-decode-xing-header-2 ()
+  (with-temp-buffer
+    (set-buffer-multibyte nil)
+    (insert (concat [255 251 80 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+                         0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 73 110 102 111 0 0 0 
15 0 0 35
+                         216 0 58 134 9 0 2 5 8 10 13 16 18 20 23 25 28 31 33 
36 38 41 43
+                         46 49 51 54 56 58 61 64 66 69 72 74 76 79 82 84 87 90 
91 94 97
+                         99 102 105 108 109 112 115 117 120 123 125 128 130 
133 135 138
+                         141 143 146 148 150 153 156 158 161 164 166 168 171 
174 176 179
+                         182 183 186 189 191 194 197 199 201 204 207 209 212 
215 217 219
+                         222 224 227 230 233 235 237 240 242 245 248 250 253 0 
0 0 0 76
+                         97 118 99 53 57 46 51 55 0 0]))
+    (should (= (emms-info-native--find-and-decode-xing-header) 9176))))
+
+(ert-deftest emms-test-decode-vbri-header ()
+  (with-temp-buffer
+    (set-buffer-multibyte nil)
+    (insert (concat [255 251 161 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 86 66 82 73 0 1 13 177 0 100 0
+ 98 219 145 0 0 33 58 0 132 0 1 0 2 0 64 152 177 189 168 187 54
+ 186 206 187 55 186 207 186 103 187 55 188 215 187 159 186 207
+ 185 44 187 53 187 56 188 8 187 159 185 149 190 224 188 8 185 250
+ 186 99 184 90 182]))
+    (should (= (emms-info-native--find-and-decode-xing-header) 8506))))