;;; listen-info.el --- Audio file metadata library  -*- lexical-binding: t; -*-

;; Copyright (C) 2020-2021, 2024 Free Software Foundation, Inc.

;; Author: Petteri Hintsanen <petterih@iki.fi>

;; This file was part of EMMS; see commentary.

;; EMMS is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; EMMS is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
;; License for more details.

;; You should have received a copy of the GNU General Public License
;; along with EMMS; see the file COPYING. If not, write to the Free
;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
;; MA 02110-1301, USA.

;;; Commentary:

;; [This library was copied wholesale from the file
;; "emms-info-native.el" from EMMS.  Its symbols have been renamed to
;; have the `listen-info' prefix.  This is to allow this very useful
;; library to be used outside of the EMMS package, which is quite
;; large.]

;; The following file formats are supported:
;;
;; - Vorbis: Ogg Vorbis I Profile, filename extension `.ogg',
;;   elementary streams only.  Based on xiph.org's Vorbis I
;;   specification, see URL
;;   `https://xiph.org/vorbis/doc/Vorbis_I_spec.html'.
;;
;; - Opus: Ogg Opus profile, filename extension `.opus', elementary
;;   streams only.  Based on RFC 7845, see URL
;;   `https://tools.ietf.org/html/rfc7845.html'.
;;
;; - FLAC streams in native encapsulation format, filename extension
;;   `.flac'.  Based on xiph.org's FLAC format specification, see URL
;;   `https://xiph.org/flac/format.html'.
;;
;; - MP3 files with extension `.mp3' and id3v2 tags.  All id3v2
;;   versions should work, but many features like CRC, compression and
;;   encryption are not supported.  Based on id3v2 Informal Standards,
;;   see URL `https://id3.org'.
;;
;; Format detection is based solely on filename extension, which is
;; matched case-insensitively.

;;; Code:

(require 'bindat)
(require 'cl-lib)
(require 'seq)
(require 'subr-x)

(defconst listen-info--max-peek-size (* 2048 1024)
  "Maximum buffer size for metadata decoding.
Functions called by `listen-info' read certain amounts of
data into a temporary buffer while decoding metadata.  This
variable controls the maximum size of that buffer: if more than
`listen-info--max-peek-size' bytes are needed, an error is
signaled.

Technically metadata blocks can have almost arbitrary lengths,
but in practice processing must be constrained to prevent memory
exhaustion in case of garbled or malicious inputs.")

(defvar listen-info--opus-channel-count 0
  "Last decoded Opus channel count.
This is a kludge; it is needed because bindat spec cannot refer
outside itself.")

(defvar listen-info--id3v2-version 0
  "Last decoded id3v2 version.
This is a kludge; it is needed because bindat spec cannot refer
outside itself.")

;;;; Vorbis code

(defconst listen-info--max-num-vorbis-comments 1024
  "Maximum number of Vorbis comment fields in a stream.
Technically a single Vorbis stream may have up to 2^32 comments,
but in practice processing must be constrained to prevent memory
exhaustion in case of garbled or malicious inputs.

This limit is used with Opus and FLAC streams as well, since
their comments have almost the same format as Vorbis.")

(defconst listen-info--max-vorbis-comment-size (* 64 1024)
  "Maximum length for a single Vorbis comment field.
Technically a single Vorbis comment may have a length up to 2^32
bytes, but in practice processing must be constrained to prevent
memory exhaustion in case of garbled or malicious inputs.

This limit is used with Opus and FLAC streams as well, since
their comments have almost the same format as Vorbis.")

(defconst listen-info--max-vorbis-vendor-length 1024
  "Maximum length of Vorbis vendor string.
Technically a vendor string can be up to 2^32 bytes long, but in
practice processing must be constrained to prevent memory
exhaustion in case of garbled or malicious inputs.

This limit is used with Opus and FLAC streams as well, since
their comments have almost the same format as Vorbis.")

(defconst listen-info--accepted-vorbis-fields
  '("album"
    "albumartist"
    "albumartistsort"
    "albumsort"
    "artist"
    "artistsort"
    "composer"
    "composersort"
    "date"
    "discnumber"
    "genre"
    "label"
    "originaldate"
    "originalyear"
    "performer"
    "title"
    "titlesort"
    "tracknumber"
    "year")
  "EMMS info fields that are extracted from Vorbis comments.")

(defconst listen-info--vorbis-headers-bindat-spec
  '((identification-header struct listen-info--vorbis-identification-header-bindat-spec)
    (comment-header struct listen-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 listen-info--vorbis-identification-header-bindat-spec
  '((packet-type u8)
    (eval (unless (= last 1)
            (error "Vorbis header type mismatch: expected 1, got %s"
                   last)))
    (vorbis vec 6)
    (eval (unless (equal last listen-info--vorbis-magic-array)
            (error "Vorbis framing mismatch: expected `%s', got `%s'"
                   listen-info--vorbis-magic-array
                   last)))
    (vorbis-version u32r)
    (eval (unless (= last 0)
            (error "Vorbis version mismatch: expected 0, got %s"
                   last)))
    (audio-channels u8)
    (audio-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 listen-info--vorbis-magic-array
  [118 111 114 98 105 115]
  "Header packet magic pattern `vorbis'.")

(defconst listen-info--vorbis-comment-header-bindat-spec
  '((packet-type u8)
    (eval (unless (= last 3)
            (error "Vorbis header type mismatch: expected 3, got %s"
                   last)))
    (vorbis vec 6)
    (eval (unless (equal last listen-info--vorbis-magic-array)
            (error "Vorbis framing mismatch: expected `%s', got `%s'"
                   listen-info--vorbis-magic-array
                   last)))
    (vendor-length u32r)
    (eval (when (> last listen-info--max-vorbis-vendor-length)
            (error "Vorbis vendor length %s is too long" last)))
    (vendor-string vec (vendor-length))
    (user-comments-list-length u32r)
    (eval (when (> last listen-info--max-num-vorbis-comments)
            (error "Vorbis user comment list length %s is too long"
                   last)))
    (user-comments repeat
                   (user-comments-list-length)
                   (struct listen-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 listen-info--vorbis-comment-field-bindat-spec
  '((length u32r)
    (eval (when (> last listen-info--max-vorbis-comment-size)
            (error "Vorbis comment length %s is too long" last)))
    (user-comment vec (length)))
  "Vorbis comment field specification.")

(defun listen-info--extract-vorbis-comments (user-comments)
  "Return a decoded list of comments from USER-COMMENTS.
USER-COMMENTS should be a list of Vorbis comments according to
`user-comments' field in
`listen-info--vorbis-comment-header-bindat-spec',
`listen-info--opus-comment-header-bindat-spec' or
`listen-info--flac-comment-block-bindat-spec'.

Return comments in a list of (FIELD . VALUE) cons cells."
  (let (comments)
    (dolist (user-comment user-comments)
      (let* ((comment (cdr (assoc 'user-comment user-comment)))
             (pair (listen-info--split-vorbis-comment comment)))
        (push pair comments)))
    comments))

(defun listen-info--split-vorbis-comment (comment)
  "Split Vorbis comment to a field-value pair.
Vorbis comments are of form `FIELD=VALUE'.  FIELD is a
case-insensitive field name with a restricted set of ASCII
characters.  VALUE is an arbitrary UTF-8 encoded octet stream.

Return a cons cell (FIELD . VALUE), where FIELD is converted to
lower case and VALUE is the decoded value."
  (let ((comment-string (decode-coding-string (mapconcat
                                               #'byte-to-string
                                               comment
                                               nil)
                                              'utf-8)))
    (when (string-match "^\\(.+?\\)=\\(.+?\\)$" comment-string)
      (cons (downcase (match-string 1 comment-string))
            (match-string 2 comment-string)))))

;;;; Opus code

(defconst listen-info--opus-headers-bindat-spec
  '((identification-header struct listen-info--opus-identification-header-bindat-spec)
    (comment-header struct listen-info--opus-comment-header-bindat-spec))
  "Specification for two first Opus header packets.
They are always an identification header followed by a comment
header.")

(defconst listen-info--opus-identification-header-bindat-spec
  '((opus-head vec 8)
    (eval (unless (equal last listen-info--opus-head-magic-array)
            (error "Opus framing mismatch: expected `%s', got `%s'"
                   listen-info--opus-head-magic-array
                   last)))
    (opus-version u8)
    (eval (unless (< last 16)
            (error "Opus version mismatch: expected < 16, got %s"
                   last)))
    (channel-count u8)
    (eval (setq listen-info--opus-channel-count last))
    (pre-skip u16r)
    (sample-rate u32r)
    (output-gain u16r)
    (channel-mapping-family u8)
    (union (channel-mapping-family)
           (0 nil)
           (t (struct listen-info--opus-channel-mapping-table))))
  "Opus identification header specification.")

(defconst listen-info--opus-head-magic-array
  [79 112 117 115 72 101 97 100]
  "Opus identification header magic pattern `OpusHead'.")

(defconst listen-info--opus-channel-mapping-table
  '((stream-count u8)
    (coupled-count u8)
    (channel-mapping vec (eval listen-info--opus-channel-count)))
  "Opus channel mapping table specification.")

(defconst listen-info--opus-comment-header-bindat-spec
  '((opus-tags vec 8)
    (eval (unless (equal last listen-info--opus-tags-magic-array)
            (error "Opus framing mismatch: expected `%s', got `%s'"
                   listen-info--opus-tags-magic-array
                   last)))
    (vendor-length u32r)
    (eval (when (> last listen-info--max-vorbis-vendor-length)
            (error "Opus vendor length %s is too long" last)))
    (vendor-string vec (vendor-length))
    (user-comments-list-length u32r)
    (eval (when (> last listen-info--max-num-vorbis-comments)
            (error "Opus user comment list length %s is too long"
                   last)))
    (user-comments repeat
                   (user-comments-list-length)
                   (struct listen-info--vorbis-comment-field-bindat-spec)))
  "Opus comment header specification.")

(defconst listen-info--opus-tags-magic-array
  [79 112 117 115 84 97 103 115]
  "Opus comment header magic pattern `OpusTags'.")

;;;; Ogg code

(defconst listen-info--ogg-page-size 65307
  "Maximum size for a single Ogg container page.")

(defconst listen-info--ogg-page-bindat-spec
  '((capture-pattern vec 4)
    (eval (unless (equal last listen-info--ogg-magic-array)
            (error "Ogg framing mismatch: expected `%s', got `%s'"
                   listen-info--ogg-magic-array
                   last)))
    (stream-structure-version u8)
    (eval (unless (= last 0)
            (error ("Ogg version mismatch: expected 0, got %s")
                   last)))
    (header-type-flag u8)
    (granule-position vec 8)
    (stream-serial-number vec 4)
    (page-sequence-no vec 4)
    (page-checksum vec 4)
    (page-segments u8)
    (segment-table vec (page-segments))
    (payload vec (eval (seq-reduce #'+ last 0))))
  "Ogg page structure specification.")

(defconst listen-info--ogg-magic-array
  [79 103 103 83]
  "Ogg format magic capture pattern `OggS'.")

(defun listen-info--decode-ogg-comments (filename stream-type)
  "Read and decode comments from Ogg file FILENAME.
The file is assumed to contain a single stream of type
STREAM-TYPE, which must either `vorbis' or `opus'.

Return comments in a list of (FIELD . VALUE) cons cells.  See
`listen-info--split-vorbis-comment' for details."
  (let* ((packets (listen-info--decode-ogg-packets filename 2))
         (headers (listen-info--decode-ogg-headers packets
                                                        stream-type))
         (comments (bindat-get-field headers
                                     'comment-header
                                     'user-comments)))
    (listen-info--extract-vorbis-comments comments)))

(defun listen-info--decode-ogg-packets (filename packets)
  "Read and decode packets from Ogg file FILENAME.
Read in data from the start of FILENAME, remove Ogg packet
frames, and concatenate payloads until at least PACKETS number of
packets have been decoded.  Return the decoded packets in a
vector, concatenated.

Data is read in `listen-info--ogg-page-size' chunks.  If the
total length of concatenated packets becomes greater than
`listen-info--max-peek-size', an error is signaled.

Only elementary streams are supported, that is, FILENAME should
contain only a single logical stream.  Note that this assumption
is not verified: with non-elementary streams packets from
different streams will be mixed together without an error."
  (let ((num-packets 0)
        (offset 0)
        (stream (vector)))
    (while (< num-packets packets)
      (let ((page (listen-info--decode-ogg-page filename
                                                     offset)))
        (cl-incf num-packets (or (plist-get page :num-packets) 0))
        (cl-incf offset (plist-get page :num-bytes))
        (setq stream (vconcat stream (plist-get page :stream)))
        (when (> (length stream) listen-info--max-peek-size)
          (error "Ogg payload is too large"))))
    stream))

(defun listen-info--decode-ogg-page (filename offset)
  "Read and decode a single Ogg page from FILENAME.
Starting reading data from byte offset OFFSET.

Return a plist (:num-packets N :num-bytes B :stream S), where N
is the number of packets in the page, B is the size of the page
in bytes, and S is the unframed logical bitstream in a vector.
Note that N can be zero."
  (with-temp-buffer
    (set-buffer-multibyte nil)
    (insert-file-contents-literally filename
                                    nil
                                    offset
                                    (+ offset
                                       listen-info--ogg-page-size))
    (let* ((page (bindat-unpack listen-info--ogg-page-bindat-spec
                                (buffer-string)))
           (num-packets (listen-info--num-of-packets page))
           (num-bytes (bindat-length listen-info--ogg-page-bindat-spec
                                     page))
           (stream (bindat-get-field page 'payload)))
      (list :num-packets num-packets
            :num-bytes num-bytes
            :stream stream))))

(defun listen-info--num-of-packets (page)
  "Return the number of packets in Ogg page PAGE.
PAGE must correspond to
`listen-info--ogg-page-bindat-spec'."
  ;; Every element that is less than 255 in the segment table
  ;; represents a packet boundary.
  (length (seq-filter (lambda (elt) (< elt 255))
                      (bindat-get-field page 'segment-table))))

(defun listen-info--decode-ogg-headers (packets stream-type)
  "Decode first two stream headers from PACKETS for STREAM-TYPE.
STREAM-TYPE must be either `vorbis' or `opus'.

Return a structure that corresponds to either
`listen-info--opus-headers-bindat-spec' or
`listen-info--vorbis-headers-bindat-spec'."
  (cond ((eq stream-type 'vorbis)
         (bindat-unpack listen-info--vorbis-headers-bindat-spec
                        packets))
        ((eq stream-type 'opus)
         (let (listen-info--opus-channel-count)
           (bindat-unpack listen-info--opus-headers-bindat-spec
                          packets)))
        (t (error "Unknown stream type %s" stream-type))))

;;;; FLAC code

(defconst listen-info--flac-metadata-block-header-bindat-spec
  '((flags u8)
    (length u24)
    (eval (when (or (> last listen-info--max-peek-size)
                    (= last 0))
            (error "FLAC block length %s is invalid" last))))
  "FLAC metadata block header specification.")

(defconst listen-info--flac-comment-block-bindat-spec
  '((vendor-length u32r)
    (eval (when (> last listen-info--max-vorbis-vendor-length)
            (error "FLAC vendor length %s is too long" last)))
    (vendor-string vec (vendor-length))
    (user-comments-list-length u32r)
    (eval (when (> last listen-info--max-num-vorbis-comments)
            (error "FLAC user comment list length %s is too long"
                   last)))
    (user-comments repeat
                   (user-comments-list-length)
                   (struct listen-info--vorbis-comment-field-bindat-spec)))
  "FLAC Vorbis comment block specification.")

(defun listen-info--decode-flac-comments (filename)
  "Read and decode comments from FLAC file FILENAME.
Return comments in a list of (FIELD . VALUE) cons cells.  Only
FIELDs that are listed in
`listen-info--accepted-vorbis-fields' are returned."
  (unless (listen-info--has-flac-signature filename)
    (error "Invalid FLAC stream"))
  (let* ((block (listen-info--decode-flac-comment-block
                 filename))
         (unpacked (bindat-unpack listen-info--flac-comment-block-bindat-spec
                                  block))
         (user-comments (bindat-get-field unpacked 'user-comments)))
    (listen-info--extract-vorbis-comments user-comments)))

(defun listen-info--has-flac-signature (filename)
  "Check for FLAC stream marker at the beginning of FILENAME.
Return t if there is a valid stream marker, nil otherwise."
  (with-temp-buffer
    (set-buffer-multibyte nil)
    (insert-file-contents-literally filename nil 0 4)
    (looking-at "fLaC")))

(defun listen-info--decode-flac-comment-block (filename)
  "Read and decode a comment block from FLAC file FILENAME.
Return the comment block data in a vector."
  (with-temp-buffer
    (set-buffer-multibyte nil)
    (let (comment-block
          last-flag
          (offset 4))
      (while (and (not comment-block) (not last-flag))
        (insert-file-contents-literally filename
                                        nil
                                        offset
                                        (cl-incf offset 4))
        (let* ((header (bindat-unpack listen-info--flac-metadata-block-header-bindat-spec
                                      (buffer-string)))
               (end (+ offset (bindat-get-field header 'length)))
               (flags (bindat-get-field header 'flags))
               (block-type (logand flags #x7F)))
          (setq last-flag (> (logand flags #x80) 0))
          (when (> block-type 6)
            (error "FLAC block type error: expected <= 6, got %s"
                   block-type))
          (when (= block-type 4)
            ;; Comment block found, extract it.
            (insert-file-contents-literally filename nil offset end t)
            (setq comment-block (vconcat (buffer-string))))
          (setq offset end)))
      comment-block)))

;;;; id3v2 (MP3) code

(defconst listen-info--id3v2-header-bindat-spec
  '((file-identifier vec 3)
    (eval (unless (equal last listen-info--id3v2-magic-array)
            (error "id3v2 framing mismatch: expected `%s', got `%s'"
                   listen-info--id3v2-magic-array
                   last)))
    (version u8)
    (eval (setq listen-info--id3v2-version last))
    (revision u8)
    (flags bits 1)
    (size-bytes vec 4)
    (size eval (listen-info--checked-id3v2-size 'tag last)))
  "id3v2 header specification.")

(defconst listen-info--id3v2-magic-array
  [#x49 #x44 #x33]
  "id3v2 header magic pattern `ID3'.")

(defconst listen-info--id3v2-frame-header-bindat-spec
  '((id str (eval (if (= listen-info--id3v2-version 2) 3 4)))
    (eval (unless (listen-info--valid-id3v2-frame-id-p last)
            (error "id3v2 frame id `%s' is invalid" last)))
    (size-bytes vec (eval (if (= listen-info--id3v2-version 2) 3 4)))
    (size eval (listen-info--checked-id3v2-size 'frame last))
    (flags bits (eval (if (= listen-info--id3v2-version 2) 0 2))))
  "id3v2 frame header specification.")

(defconst listen-info--id3v2-frame-to-info
  '(("TAL"  . "album")
    ("TALB" . "album")
    ("TPE2" . "albumartist")
    ("TSO2" . "albumartistsort")
    ("TSOA" . "albumsort")
    ("TP1"  . "artist")
    ("TPE1" . "artist")
    ("TSOP" . "artistsort")
    ("TCM"  . "composer")
    ("TCOM" . "composer")
    ("TSOC" . "composersort")
    ("TDRC" . "date")
    ("TPA"  . "discnumber")
    ("TPOS" . "discnumber")
    ("TCON" . genre)
    ("TPUB" . "label")
    ("TDOR" . "originaldate")
    ("TOR"  . "originalyear")
    ("TORY" . "originalyear")
    ("TIT2" . "title")
    ("TT2"  . "title")
    ("TSOT" . "titlesort")
    ("TRK"  . "tracknumber")
    ("TRCK" . "tracknumber")
    ("TYE"  . "year")
    ("TYER" . "year")
    ("TXXX" . user-defined))
  "Mapping from id3v2 frame identifiers to info fields.

Sources:

- URL `https://picard-docs.musicbrainz.org/en/appendices/tag_mapping.html'
- URL `http://wiki.hydrogenaud.io/index.php?title=Foobar2000:ID3_Tag_Mapping'")

(defconst listen-info--id3v1-genres
  '((0 . "Blues")
    (1 . "Classic Rock")
    (2 . "Country")
    (3 . "Dance")
    (4 . "Disco")
    (5 . "Funk")
    (6 . "Grunge")
    (7 . "Hip-Hop")
    (8 . "Jazz")
    (9 . "Metal")
    (10 . "New Age")
    (11 . "Oldies")
    (12 . "Other")
    (13 . "Pop")
    (14 . "R&B")
    (15 . "Rap")
    (16 . "Reggae")
    (17 . "Rock")
    (18 . "Techno")
    (19 . "Industrial")
    (20 . "Alternative")
    (21 . "Ska")
    (22 . "Death Metal")
    (23 . "Pranks")
    (24 . "Soundtrack")
    (25 . "Euro-Techno")
    (26 . "Ambient")
    (27 . "Trip-Hop")
    (28 . "Vocal")
    (29 . "Jazz+Funk")
    (30 . "Fusion")
    (31 . "Trance")
    (32 . "Classical")
    (33 . "Instrumental")
    (34 . "Acid")
    (35 . "House")
    (36 . "Game")
    (37 . "Sound Clip")
    (38 . "Gospel")
    (39 . "Noise")
    (40 . "AlternRock")
    (41 . "Bass")
    (42 . "Soul")
    (43 . "Punk")
    (44 . "Space")
    (45 . "Meditative")
    (46 . "Instrumental Pop")
    (47 . "Instrumental Rock")
    (48 . "Ethnic")
    (49 . "Gothic")
    (50 . "Darkwave")
    (51 . "Techno-Industrial")
    (52 . "Electronic")
    (53 . "Pop-Folk")
    (54 . "Eurodance")
    (55 . "Dream")
    (56 . "Southern Rock")
    (57 . "Comedy")
    (58 . "Cult")
    (59 . "Gangsta")
    (60 . "Top 40")
    (61 . "Christian Rap")
    (62 . "Pop/Funk")
    (63 . "Jungle")
    (64 . "Native American")
    (65 . "Cabaret")
    (66 . "New Wave")
    (67 . "Psychadelic")
    (68 . "Rave")
    (69 . "Showtunes")
    (70 . "Trailer")
    (71 . "Lo-Fi")
    (72 . "Tribal")
    (73 . "Acid Punk")
    (74 . "Acid Jazz")
    (75 . "Polka")
    (76 . "Retro")
    (77 . "Musical")
    (78 . "Rock & Roll")
    (79 . "Hard Rock")
    (80 . "Folk")
    (81 . "Folk-Rock")
    (82 . "National Folk")
    (83 . "Swing")
    (84 . "Fast Fusion")
    (85 . "Bebob")
    (86 . "Latin")
    (87 . "Revival")
    (88 . "Celtic")
    (89 . "Bluegrass")
    (90 . "Avantgarde")
    (91 . "Gothic Rock")
    (92 . "Progressive Rock")
    (93 . "Psychedelic Rock")
    (94 . "Symphonic Rock")
    (95 . "Slow Rock")
    (96 . "Big Band")
    (97 . "Chorus")
    (98 . "Easy Listening")
    (99 . "Acoustic")
    (100 . "Humour")
    (101 . "Speech")
    (102 . "Chanson")
    (103 . "Opera")
    (104 . "Chamber Music")
    (105 . "Sonata")
    (106 . "Symphony")
    (107 . "Booty Bass")
    (108 . "Primus")
    (109 . "Porn Groove")
    (110 . "Satire")
    (111 . "Slow Jam")
    (112 . "Club")
    (113 . "Tango")
    (114 . "Samba")
    (115 . "Folklore")
    (116 . "Ballad")
    (117 . "Power Ballad")
    (118 . "Rhythmic Soul")
    (119 . "Freestyle")
    (120 . "Duet")
    (121 . "Punk Rock")
    (122 . "Drum Solo")
    (123 . "A cappella")
    (124 . "Euro-House")
    (125 . "Dance Hall"))
  "id3v1 genres.")

(defconst listen-info--id3v2-text-encodings
  '((0 . latin-1)
    (1 . utf-16)
    (2 . uft-16be)
    (3 . utf-8))
  "id3v2 text encodings.")

(defun listen-info--valid-id3v2-frame-id-p (id)
  "Return t if ID is a proper id3v2 frame identifier, nil otherwise."
  (if (= listen-info--id3v2-version 2)
      (string-match "[A-Z0-9]\\{3\\}" id)
    (string-match "[A-Z0-9]\\{4\\}" id)))

(defun listen-info--checked-id3v2-size (elt bytes)
  "Calculate id3v2 element ELT size from BYTES.
ELT must be either \\=`tag' or \\=`frame'.

Return the size.  Signal an error if the size is zero."
  (let ((size (cond ((eq elt 'tag)
                     (listen-info--decode-id3v2-size bytes t))
                    ((eq elt 'frame)
                     (if (= listen-info--id3v2-version 4)
                         (listen-info--decode-id3v2-size bytes t)
                       (listen-info--decode-id3v2-size bytes nil))))))
    (if (zerop size)
        (error "id3v2 tag/frame size is zero")
      size)))

(defun listen-info--decode-id3v2-size (bytes syncsafe)
  "Decode id3v2 element size from BYTES.
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)))
    (apply '+ (seq-map-indexed (lambda (elt idx)
                                 (* (expt 2 (* num-bits idx)) elt))
                               (reverse bytes)))))

(defun listen-info--decode-id3v2 (filename)
  "Read and decode id3v2 metadata from FILENAME.
Return metadata in a list of (FIELD . VALUE) cons cells, or nil
in case of errors or if there were no known fields in FILENAME.

See `listen-info--id3v2-frame-to-info' for recognized
fields."
  (condition-case nil
      (let* (listen-info--id3v2-version
             (header (listen-info--decode-id3v2-header filename))
             (tag-size (bindat-get-field header 'size))
             (unsync (memq 7 (bindat-get-field header 'flags)))
             (offset 10))
        (when (memq 6 (bindat-get-field header 'flags))
          ;; Skip the extended header.
          (cl-incf offset
                   (listen-info--checked-id3v2-ext-header-size filename)))
        (listen-info--decode-id3v2-frames filename
                                               offset
                                               (+ tag-size 10)
                                               unsync))
    (error nil)))

(defun listen-info--decode-id3v2-header (filename)
  "Read and decode id3v2 header from FILENAME."
  (with-temp-buffer
    (set-buffer-multibyte nil)
    (insert-file-contents-literally filename nil 0 10)
    (bindat-unpack listen-info--id3v2-header-bindat-spec
                   (buffer-string))))

(defun listen-info--checked-id3v2-ext-header-size (filename)
  "Read and decode id3v2 extended header size from FILENAME.
Return the size.  Signal an error if the size is zero."
  (with-temp-buffer
    (set-buffer-multibyte nil)
    (insert-file-contents-literally filename nil 10 14)
    (listen-info--checked-id3v2-size 'frame (buffer-string))))

(defun listen-info--decode-id3v2-frames (filename begin end unsync)
  "Read and decode id3v2 text frames from FILENAME.
BEGIN should be the offset of first byte of the first frame, and
END should be the offset after the complete id3v2 tag.

If UNSYNC is t, the frames are assumed to have gone through
unsynchronization and decoded as such.

Return metadata in a list of (FIELD . VALUE) cons cells."
  (let ((offset begin)
        (limit (- end (listen-info--id3v2-frame-header-size)))
        comments)
    (condition-case nil
        (while (< offset limit)
          (let* ((frame-data (listen-info--decode-id3v2-frame filename
                                                                   offset
                                                                   unsync))
                 (next-frame-offset (car frame-data))
                 (comment (cdr frame-data)))
            (when comment (push comment comments))
            (setq offset next-frame-offset)))
      (error nil))
    comments))

(defun listen-info--id3v2-frame-header-size ()
  "Return the last decoded header size in bytes."
  (if (= listen-info--id3v2-version 2) 6 10))

(defun listen-info--decode-id3v2-frame (filename offset unsync)
  (let* ((header (listen-info--decode-id3v2-frame-header filename
                                                              offset))
         (info-id (listen-info--id3v2-frame-info-id header))
         (data-offset (car header))
         (size (bindat-get-field (cdr header) 'size)))
    (if (or info-id unsync)
        ;; Note that if unsync is t, we have to always read the frame
        ;; to determine next-frame-offset.
        (let* ((data (listen-info--read-id3v2-frame-data filename
                                                              data-offset
                                                              size
                                                              unsync))
               (next-frame-offset (car data))
               (value (listen-info--decode-id3v2-frame-data (cdr data)
                                                                 info-id)))
          (cons next-frame-offset value))
      ;; Skip the frame.
      (cons (+ data-offset size) nil))))

(defun listen-info--decode-id3v2-frame-header (filename begin)
  "Read and decode id3v2 frame header from FILENAME.
Start reading from offset BEGIN.

Return a cons cell (OFFSET . FRAME), where OFFSET is the byte
offset after the frame header, and FRAME is the decoded frame."
  (with-temp-buffer
    (set-buffer-multibyte nil)
    (let ((end (+ begin (listen-info--id3v2-frame-header-size))))
      (insert-file-contents-literally filename nil begin end)
      (cons end (bindat-unpack listen-info--id3v2-frame-header-bindat-spec
                               (buffer-string))))))

(defun listen-info--id3v2-frame-info-id (frame)
  "Return the identifier for FRAME.
If there is no such identifier, return nil."
  (cdr (assoc (bindat-get-field frame 'id)
              listen-info--id3v2-frame-to-info)))

(defun listen-info--read-id3v2-frame-data (filename
                                                begin
                                                num-bytes
                                                unsync)
  "Read NUM-BYTES of raw id3v2 frame data from FILENAME.
Start reading from offset BEGIN.  If UNSYNC is t, all 'FF 00'
byte combinations are replaced by 'FF'.  Replaced byte pairs are
counted as one, instead of two, towards NUM-BYTES.

Return a cons cell (OFFSET . DATA), where OFFSET is the byte
offset after NUM-BYTES bytes have been read, and DATA is the raw
data."
  (with-temp-buffer
    (set-buffer-multibyte nil)
    (if unsync
        ;; Reverse unsynchronization.
        (let ((peek-end (+ begin (* 2 num-bytes)))
              (end num-bytes))
          (insert-file-contents-literally filename nil begin peek-end)
          (goto-char (point-min))
          (while (and (re-search-forward (string 255 0) nil t)
                      (< (point) end))
            (replace-match (string 255))
            (cl-incf end 1))
          (delete-region (1+ num-bytes) (point-max))
          (cons (+ begin end) (buffer-string)))
      ;; No unsynchronization: read the data as-is.
      (let ((end (+ begin num-bytes)))
        (insert-file-contents-literally filename nil begin end)
        (cons end (buffer-string))))))

(defun listen-info--decode-id3v2-frame-data (data info-id)
  "Decode id3v2 text frame data DATA.
If INFO-ID is `user-defined', assume that DATA is a TXXX frame
with key/value-pair.  Extract the key and, if it is a mapped
element in `listen-info--id3v2-frame-to-info', use it as
INFO-ID.

If INFO-ID is `genre', assume that DATA is either an integral
id3v1 genre reference or a plain genre string.  In the former
case map the reference to a string via
`listen-info--id3v1-genres'; in the latter case use the
genre string verbatim.

Return a cons cell (INFO-ID . VALUE) where VALUE is the decoded
string."
  (when info-id
    (let ((str (listen-info--decode-id3v2-string data)))
      (cond ((stringp info-id) (cons info-id str))
            ((eq info-id 'genre)
             (if (string-match "^(?\\([0-9]+\\))?" str)
                 (let ((v1-genre (assoc (string-to-number (match-string 1 str))
                                        listen-info--id3v1-genres)))
                   (when v1-genre (cons "genre" (cdr v1-genre))))
               (cons "genre" str)))
            ((eq info-id 'user-defined)
             (let* ((key-val (split-string str (string 0)))
                    (key (downcase (car key-val)))
                    (val (cadr key-val)))
               (cons key val)))))))

(defun listen-info--decode-id3v2-string (bytes)
  "Decode id3v2 text information from BYTES.
Remove the terminating null byte, if any.

Return the text as string."
  (let* ((encoding (listen-info--id3v2-text-encoding bytes))
         (string (mapconcat #'byte-to-string (seq-rest bytes) ""))
         (decoded (decode-coding-string string encoding)))
    (when (> (length decoded) 0)
      (if (equal (substring decoded -1) "\0")
          (substring decoded 0 -1)
        decoded))))

(defun listen-info--id3v2-text-encoding (bytes)
  "Return the encoding for text information BYTES."
  (cdr (assoc (seq-first bytes)
              listen-info--id3v2-text-encodings)))

;;;; (no-longer EMMS) code

(defun listen-info--decode-info-fields (filename)
  "Decode info fields from FILENAME.
Return a list of (FIELD . VALUE) cons cells, where FIELD is an
info field and VALUE is the corresponding info value.  Both are
strings."
  (let ((stream-type (listen-info--find-stream-type filename)))
    (cond ((or (eq stream-type 'vorbis) (eq stream-type 'opus))
           (listen-info--decode-ogg-comments filename stream-type))
          ((eq stream-type 'flac)
           (listen-info--decode-flac-comments filename))
          ((eq stream-type 'mp3)
           (listen-info--decode-id3v2 filename))
          (t nil))))

(defun listen-info--find-stream-type (filename)
  "Deduce the stream type from FILENAME.
This is a naive implementation that relies solely on filename
extension.

Return one of symbols `vorbis', `opus', `flac', or `mp3'."
  (let ((case-fold-search t))
    (cond ((string-match "\\.ogg$" filename) 'vorbis)
          ((string-match "\\.opus$" filename) 'opus)
          ((string-match "\\.flac$" filename) 'flac)
          ((string-match "\\.mp3$" filename) 'mp3)
          (t nil))))

(provide 'listen-info)

;;; listen-info.el ends here
