| 1 | ;;; emms-info-native-vorbis.el --- EMMS Vorbis info support -*- lexical-binding: t; -*- |
| 2 | |
| 3 | ;; Copyright (C) 2020-2023 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Petteri Hintsanen <petterih@iki.fi> |
| 6 | |
| 7 | ;; This file is part of EMMS. |
| 8 | |
| 9 | ;; EMMS is free software; you can redistribute it and/or modify it |
| 10 | ;; under the terms of the GNU General Public License as published by |
| 11 | ;; the Free Software Foundation; either version 3, or (at your option) |
| 12 | ;; any later version. |
| 13 | |
| 14 | ;; EMMS is distributed in the hope that it will be useful, but WITHOUT |
| 15 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY |
| 16 | ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public |
| 17 | ;; License for more details. |
| 18 | |
| 19 | ;; You should have received a copy of the GNU General Public License |
| 20 | ;; along with EMMS; see the file COPYING. If not, write to the Free |
| 21 | ;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, |
| 22 | ;; MA 02110-1301, USA. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;; This file contains Vorbis-specific code for `emms-info-native-ogg'. |
| 27 | |
| 28 | ;;; Code: |
| 29 | |
| 30 | (require 'bindat) |
| 31 | |
| 32 | (defvar bindat-raw) |
| 33 | |
| 34 | (defconst emms-info-native-vorbis--accepted-fields |
| 35 | '("album" |
| 36 | "albumartist" |
| 37 | "albumartistsort" |
| 38 | "albumsort" |
| 39 | "artist" |
| 40 | "artistsort" |
| 41 | "composer" |
| 42 | "composersort" |
| 43 | "date" |
| 44 | "discnumber" |
| 45 | "genre" |
| 46 | "label" |
| 47 | "originaldate" |
| 48 | "originalyear" |
| 49 | "performer" |
| 50 | "title" |
| 51 | "titlesort" |
| 52 | "tracknumber" |
| 53 | "year") |
| 54 | "EMMS info fields that are extracted from Vorbis comments.") |
| 55 | |
| 56 | (defconst emms-info-native-vorbis--header-magic-pattern "vorbis" |
| 57 | "Header packet magic pattern.") |
| 58 | |
| 59 | (defconst emms-info-native-vorbis--id-header-bindat-spec |
| 60 | (if (eval-when-compile (fboundp 'bindat-type)) |
| 61 | (bindat-type |
| 62 | (packet-type u8) |
| 63 | (_ unit (unless (= packet-type 1) |
| 64 | (error "Vorbis header type mismatch: expected 1, got %s" |
| 65 | packet-type))) |
| 66 | (vorbis str 6) |
| 67 | (_ unit (unless (equal vorbis emms-info-native-vorbis--header-magic-pattern) |
| 68 | (error "Vorbis framing mismatch: expected `%s', got `%s'" |
| 69 | emms-info-native-vorbis--header-magic-pattern |
| 70 | vorbis))) |
| 71 | (vorbis-version uintr 32) |
| 72 | (_ unit (unless (= vorbis-version 0) |
| 73 | (error "Vorbis version mismatch: expected 0, got %s" |
| 74 | vorbis-version))) |
| 75 | (channel-count u8) |
| 76 | (sample-rate uintr 32) |
| 77 | (bitrate-maximum uintr 32) |
| 78 | (bitrate-nominal uintr 32) |
| 79 | (bitrate-minimum uintr 32) |
| 80 | (blocksize u8) |
| 81 | (framing-flag u8) |
| 82 | (_ unit (unless (= framing-flag 1) |
| 83 | (error "Vorbis framing bit mismatch: expected 1, got %s" |
| 84 | framing-flag)))) |
| 85 | '((packet-type u8) |
| 86 | (eval (unless (= last 1) |
| 87 | (error "Vorbis header type mismatch: expected 1, got %s" |
| 88 | last))) |
| 89 | (vorbis str 6) |
| 90 | (eval (unless (equal last emms-info-native-vorbis--header-magic-pattern) |
| 91 | (error "Vorbis framing mismatch: expected `%s', got `%s'" |
| 92 | emms-info-native-vorbis--header-magic-pattern |
| 93 | last))) |
| 94 | (vorbis-version u32r) |
| 95 | (eval (unless (= last 0) |
| 96 | (error "Vorbis version mismatch: expected 0, got %s" |
| 97 | last))) |
| 98 | (channel-count u8) |
| 99 | (sample-rate u32r) |
| 100 | (bitrate-maximum u32r) |
| 101 | (bitrate-nominal u32r) |
| 102 | (bitrate-minimum u32r) |
| 103 | (blocksize u8) |
| 104 | (framing-flag u8) |
| 105 | (eval (unless (= last 1)) |
| 106 | (error "Vorbis framing bit mismatch: expected 1, got %s" |
| 107 | last)))) |
| 108 | "Vorbis identification header specification.") |
| 109 | |
| 110 | (defconst emms-info-native-vorbis--comment-field-bindat-spec |
| 111 | (if (eval-when-compile (fboundp 'bindat-type)) |
| 112 | (bindat-type |
| 113 | (length uintr 32) |
| 114 | (_ unit (when (> length (length bindat-raw)) |
| 115 | (error "Vorbis comment length %s is too long" |
| 116 | length))) |
| 117 | (user-comment str length)) |
| 118 | '((length u32r) |
| 119 | (eval (when (> last (length bindat-raw)) |
| 120 | (error "Vorbis comment length %s is too long" last))) |
| 121 | (user-comment str (length)))) |
| 122 | "Vorbis comment field specification.") |
| 123 | |
| 124 | (defconst emms-info-native-vorbis--comment-header-bindat-spec |
| 125 | (if (eval-when-compile (fboundp 'bindat-type)) |
| 126 | (bindat-type |
| 127 | (packet-type u8) |
| 128 | (_ unit (unless (= packet-type 3) |
| 129 | (error "Vorbis header type mismatch: expected 3, got %s" |
| 130 | packet-type))) |
| 131 | (vorbis str 6) |
| 132 | (_ unit (unless (equal vorbis emms-info-native-vorbis--header-magic-pattern) |
| 133 | (error "Vorbis framing mismatch: expected `%s', got `%s'" |
| 134 | emms-info-native-vorbis--header-magic-pattern |
| 135 | vorbis))) |
| 136 | (vendor-length uintr 32) |
| 137 | (_ unit (when (> vendor-length (length bindat-raw)) |
| 138 | (error "Vorbis vendor length %s is too long" |
| 139 | vendor-length))) |
| 140 | (vendor-string str vendor-length) |
| 141 | (user-comments-list-length uintr 32) |
| 142 | (_ unit (when (> user-comments-list-length (length bindat-raw)) |
| 143 | (error "Vorbis user comment list length %s is too long" |
| 144 | user-comments-list-length))) |
| 145 | (user-comments repeat user-comments-list-length |
| 146 | type emms-info-native-vorbis--comment-field-bindat-spec) |
| 147 | (framing-bit u8) |
| 148 | (_ unit (unless (= framing-bit 1) |
| 149 | (error "Vorbis framing bit mismatch: expected 1, got %s" |
| 150 | framing-bit)))) |
| 151 | '((packet-type u8) |
| 152 | (eval (unless (= last 3) |
| 153 | (error "Vorbis header type mismatch: expected 3, got %s" |
| 154 | last))) |
| 155 | (vorbis str 6) |
| 156 | (eval (unless (equal last emms-info-native-vorbis--header-magic-pattern) |
| 157 | (error "Vorbis framing mismatch: expected `%s', got `%s'" |
| 158 | emms-info-native-vorbis--header-magic-pattern |
| 159 | last))) |
| 160 | (vendor-length u32r) |
| 161 | (eval (when (> last (length bindat-raw)) |
| 162 | (error "Vorbis vendor length %s is too long" last))) |
| 163 | (vendor-string str (vendor-length)) |
| 164 | (user-comments-list-length u32r) |
| 165 | (eval (when (> last (length bindat-raw)) |
| 166 | (error "Vorbis user comment list length %s is too long" |
| 167 | last))) |
| 168 | (user-comments repeat |
| 169 | (user-comments-list-length) |
| 170 | (struct emms-info-native-vorbis--comment-field-bindat-spec)) |
| 171 | (framing-bit u8) |
| 172 | (eval (unless (= last 1)) |
| 173 | (error "Vorbis framing bit mismatch: expected 1, got %s" |
| 174 | last)))) |
| 175 | "Vorbis comment header specification.") |
| 176 | |
| 177 | (defconst emms-info-native-vorbis--headers-bindat-spec |
| 178 | (if (eval-when-compile (fboundp 'bindat-type)) |
| 179 | (bindat-type |
| 180 | (_ struct (identification-header type emms-info-native-vorbis--id-header-bindat-spec) |
| 181 | (comment-header type emms-info-native-vorbis--comment-header-bindat-spec))) |
| 182 | '((identification-header struct emms-info-native-vorbis--id-header-bindat-spec) |
| 183 | (comment-header struct emms-info-native-vorbis--comment-header-bindat-spec))) |
| 184 | "Specification for first two Vorbis header packets. |
| 185 | They are always an identification header followed by a comment |
| 186 | header.") |
| 187 | |
| 188 | (defun emms-info-native-vorbis-extract-comments (user-comments) |
| 189 | "Return a decoded list of comments from USER-COMMENTS. |
| 190 | USER-COMMENTS should be a list of Vorbis comments according to |
| 191 | `user-comments' field in |
| 192 | `emms-info-native-vorbis--comment-header-bindat-spec'. |
| 193 | |
| 194 | Return comments in a list of (FIELD . VALUE) cons cells. Only |
| 195 | FIELDs that are listed in `emms-info-native-vorbis--accepted-fields' are |
| 196 | returned." |
| 197 | (let (comments) |
| 198 | (dolist (user-comment user-comments) |
| 199 | (let* ((comment (alist-get 'user-comment user-comment)) |
| 200 | (pair (emms-info-native-vorbis--split-comment comment))) |
| 201 | (when (member (car pair) emms-info-native-vorbis--accepted-fields) |
| 202 | (push pair comments)))) |
| 203 | comments)) |
| 204 | |
| 205 | (defun emms-info-native-vorbis--split-comment (comment) |
| 206 | "Split Vorbis COMMENT to a field-value pair. |
| 207 | Vorbis comments are of form `FIELD=VALUE'. FIELD is a |
| 208 | case-insensitive field name with a restricted set of ASCII |
| 209 | characters. VALUE is an arbitrary UTF-8 encoded octet stream. |
| 210 | Comments with empty FIELD or VALUE are ignored. |
| 211 | |
| 212 | Return a cons cell (FIELD . VALUE), where FIELD is converted to |
| 213 | lower case and VALUE is the decoded value." |
| 214 | (let ((comment-string (decode-coding-string comment 'utf-8))) |
| 215 | (when (string-match "^\\(.+?\\)=\\(.+\\)$" comment-string) |
| 216 | (cons (downcase (match-string 1 comment-string)) |
| 217 | (match-string 2 comment-string))))) |
| 218 | |
| 219 | (provide 'emms-info-native-vorbis) |
| 220 | |
| 221 | ;;; emms-info-native-vorbis.el ends here |