pretty-print frames

doc/scribbu.texi

@@ -2197,6 +2197,7 @@ Module @code{scribbu} defines a few @code{<id3v2-frame>} sub-classes.
 * @code{<user-defined-text-frame>}::
 * @code{<play-count-frame>}::
 * @code{<popm-frame>}::
+* @code{<tag-cloud-frame>}::
 * @code{<unk-frame>}::
 @end menu
 

doc/version.texi

@@ -1,4 +1,4 @@
-@set UPDATED 29 January 2024
-@set UPDATED-MONTH January 2024
+@set UPDATED 1 February 2024
+@set UPDATED-MONTH February 2024
 @set EDITION 0.6.23
 @set VERSION 0.6.23

scheme/scribbu.scm

@@ -100,7 +100,6 @@ at `root'"
 						            (stm (cadr here))
 						            (pth (car here))
 						            (entry (readdir stm))) ; may be *eof*
-				           ;; (display entry) (newline)
 				           (set! next
 						             ;; Evaluates to either #f or the next entry
 						             (while (not (eof-object? entry))
@@ -177,6 +176,7 @@ at `root'"
 (make-symbol "play-count-frame")            ;; CNT/PCNT
 (make-symbol "playlist-delay-frame")        ;; TDY/TDLY
 (make-symbol "popm-frame")                  ;; POP/POPM
+(make-symbol "priv-frame")                  ;; PRIV
 (make-symbol "publisher-frame")             ;; TPB/TPUB
 (make-symbol "recording-dates-frame")       ;; TRD/TRDA
 (make-symbol "settings-frame")              ;; TSS/TSSE
@@ -202,30 +202,78 @@ at `root'"
   (id-text #:init-value ""     #:accessor frameid #:init-keyword #:frameid)
   (data    #:init-value #vu8() #:accessor data    #:init-keyword #:data))
 
+(define (pp-bytevector bv)
+  "Pretty-print a byte vector. BV is a bytevector. Return a string"
+  (let ((len (min (bytevector-length bv) 8))
+        (hex '())
+        (ascii '()))
+    ;; Two loops-- one to display hex values...
+    (do ((i 0 (1+ i))) ((> i (1- len)))
+      (set! hex (append hex (list (format #f "~2,'0x " (bytevector-u8-ref bv i))))))
+    ;; and one for the ASCII representation
+    (do ((i 0 (1+ i))) ((> i (1- len)))
+      (let* ((x (bytevector-u8-ref bv i))
+             (c (if (and (> x 31) (< x 127))
+                    (integer->char x)
+                    #\.)))
+        (set! ascii (append ascii (list (format #f "~c" c))))))
+    (format #f "{~a <~a>}"
+            (string-join hex "") (string-join ascii ""))))
+
+(define-method (display (f <unk-frame>) out)
+  (format out "<unk-frame ~s ~a>" (slot-ref f 'id-text) (pp-bytevector (slot-ref f 'data))))
+
 (define-class <text-frame> (<id3v2-frame>)
   (text #:init-value "" #:accessor text #:init-keyword #:text))
 
+(define-method (display (f <text-frame>) out)
+  (format out "<~a ~s>" (slot-ref f 'id) (slot-ref f 'text)))
+
 (define-class <comment-frame> (<id3v2-frame>)
   (lang  #:init-value "eng" #:accessor lang #:init-keyword #:lang)
   (dsc   #:init-value ""    #:accessor dsc  #:init-keyword #:dsc)
   (text  #:init-value ""    #:accessor text #:init-keyword #:text))
 
+(define-method (display (f <comment-frame>) out)
+  (format out "<comment (~a, ~a) ~a>" (slot-ref f 'lang) (slot-ref f 'dsc)
+          (slot-ref f 'text)))
+
 (define-class <user-defined-text-frame> (<id3v2-frame>)
   (dsc   #:init-value "" #:accessor dsc  #:init-keyword #:dsc)
   (text  #:init-value "" #:accessor text #:init-keyword #:text))
 
+(define-method (display (f <user-defined-text-frame>) out)
+  (format out "<user-defined-text ~a>" (slot-ref f 'dsc)))
+
 (define-class <play-count-frame> (<id3v2-frame>)
   (count #:init-value 0 #:accessor count #:init-keyword #:count))
 
+(define-method (display (f <play-count-frame>) out)
+  (format out "<play-count ~a>" (slot-ref f 'count)))
+
 (define-class <popm-frame> (<id3v2-frame>)
   (e-mail #:init-value "" #:accessor e-mail #:init-keyword #:e-mail)
   (rating #:init-value 0  #:accessor rating #:init-keyword #:rating)
   (count  #:init-value 0  #:accessor count  #:init-keyword #:count))
 
+(define-method (display (f <popm-frame>) out)
+  (format out "<popularimeter ~a, ~a, ~a>" (slot-ref f 'e-mail)
+          (slot-ref f 'rating) (slot-ref f 'count)))
+
 (define-class <tag-cloud-frame> (<id3v2-frame>)
   (owner #:init-value ""  #:accessor owner #:init-keyword #:owner)
   (tags  #:init-value '() #:accessor tags  #:init-keyword #:tags))
 
+(define-method (display (f <tag-cloud-frame>) out)
+  (format out "<tag cloud (~a) ~a>" (slot-ref f 'owner) (slot-ref f 'tags)))
+
+(define-class <priv-frame> (<id3v2-frame>)
+  (owner #:init-value ""     #:accessor owner #:init-keyword #:owner)
+  (data  #:init-value #vu8() #:accessor data  #:init-keyword #:data))
+
+(define-method (display (f <priv-frame>) out)
+  (format out "<private (~a) ~a>" (slot-ref f 'owner) (pp-bytevector (slot-ref f 'data))))
+
 (define-class <id3v2-tag> ()
   (experimental #:init-value '() #:accessor experimental
                 #:init-keyword experimental)

scribbu/scheme-serde.cc

@@ -111,6 +111,7 @@ const scribbu::frame_id4 IDTXXX("TXXX");
 const scribbu::frame_id4 IDPCNT("PCNT");
 const scribbu::frame_id4 IDPOPM("POPM");
 const scribbu::frame_id4 IDXTAG("XTAG");
+const scribbu::frame_id4 IDPRIV("PRIV");
 
 SCM sym_unknown_frame;              // 'unknown-frame
 
@@ -158,6 +159,7 @@ SCM sym_udt_frame;                  // 'udt-frame, TXX/TXXX
 SCM sym_play_count_frame;           // 'play-count-frame, CNT/PCNT
 SCM sym_popm_frame;                 // 'popm-frame, POP/POPM
 SCM sym_tag_cloud_frame;            // 'tag-cloud-frame, XTG/XTAG
+SCM sym_priv_frame;                 // 'priv-frame, PRIV
 
 SCM scribbu::sym_as_needed;
 SCM scribbu::kw_apply_unsync;
@@ -229,6 +231,7 @@ void scribbu::init_symbols() {
   DEFSYMX(play_count_frame,            play-count-frame,            IDCNT, IDPCNT);
   DEFSYMX(popm_frame,                  popm-frame,                  IDPOP, IDPOPM);
   DEFSYMX(tag_cloud_frame,             tag-cloud-frame,             IDXTG, IDXTAG);
+  DEFSYM4(priv_frame,                  priv-frame,                         IDPRIV);
 
 # undef DEFSYM4
 # undef DEFSYMX
@@ -728,6 +731,54 @@ namespace {
     return x;
   }
 
+  SCM
+  de_priv_2_3(const scribbu::PRIV &f, bool unsync)
+  {
+    using namespace std;
+    using namespace scribbu;
+
+    SCM x = init_frame("<priv-frame>", sym_tag_cloud_frame,
+                       f.tag_alter_preserve(), f.file_alter_preserve(),
+                       f.readonly());
+
+    string own = f.email<string>();
+    SCM_SET_SLOT(x, 5, scm_from_utf8_string(own.c_str()));
+
+    vector<unsigned char> c;
+    f.contentsb(back_inserter(c));
+
+    SCM bv = scm_c_make_bytevector(c.size());
+    memcpy(SCM_BYTEVECTOR_CONTENTS(bv), c.data(), c.size());
+
+    SCM_SET_SLOT(x, 6, bv);
+
+    return x;
+  }
+
+  SCM
+  de_priv_2_4(const scribbu::PRIV_2_4 &f, bool unsync)
+  {
+    using namespace std;
+    using namespace scribbu;
+
+    SCM x = init_frame("<priv-frame>", sym_tag_cloud_frame,
+                       f.tag_alter_preserve(), f.file_alter_preserve(),
+                       f.readonly(), f.unsynchronised());
+
+    string own = f.email<string>();
+    SCM_SET_SLOT(x, 5, scm_from_utf8_string(own.c_str()));
+
+    vector<unsigned char> c;
+    f.contentsb(back_inserter(c));
+
+    SCM bv = scm_c_make_bytevector(c.size());
+    memcpy(SCM_BYTEVECTOR_CONTENTS(bv), c.data(), c.size());
+
+    SCM_SET_SLOT(x, 6, bv);
+
+    return x;
+  }
+
 }
 
 ////////////////////////////////////////////////////////////////////////////////
@@ -1338,6 +1389,74 @@ namespace {
                                                   boost::none));
   }
 
+  std::unique_ptr<scribbu::id3v2_3_frame>
+  ser_priv_2_3(SCM scm)
+  {
+    using namespace std;
+    using namespace scribbu;
+
+    typedef id3v2_3_plus_frame::tag_alter_preservation
+      tag_alter_preservation;
+    typedef id3v2_3_plus_frame::file_alter_preservation
+      file_alter_preservation;
+    typedef id3v2_3_plus_frame::read_only read_only;
+
+    dynwind_context ctx;
+
+    string id_txt;
+    tag_alter_preservation tap;
+    file_alter_preservation fap;
+    read_only ro;
+
+    tie(id_txt, tap, fap, ro) = ser_frame_2_3("<priv-frame>", scm, ctx);
+
+    string own = ctx.free_utf8_string(SCM_SLOT(scm, 5));
+
+    SCM scm_bv = SCM_SLOT(scm, 6);
+
+    size_t cb = SCM_BYTEVECTOR_LENGTH(scm_bv);
+    unsigned char *p = (unsigned char*) SCM_BYTEVECTOR_CONTENTS(scm_bv);
+
+    return unique_ptr<id3v2_3_frame>(new PRIV(own, p, p + cb,
+                                              tap, fap, ro, boost::none,
+                                              boost::none, boost::none));
+  }
+
+  std::unique_ptr<scribbu::id3v2_4_frame>
+  ser_priv_2_4(SCM scm)
+  {
+    using namespace std;
+    using namespace scribbu;
+
+    typedef id3v2_3_plus_frame::tag_alter_preservation
+      tag_alter_preservation;
+    typedef id3v2_3_plus_frame::file_alter_preservation
+      file_alter_preservation;
+    typedef id3v2_3_plus_frame::read_only read_only;
+
+    dynwind_context ctx;
+
+    string id_txt;
+    tag_alter_preservation tap;
+    file_alter_preservation fap;
+    read_only ro;
+    bool unsync;
+
+    tie(id_txt, tap, fap, ro, unsync) =
+      ser_frame_2_4("<priv-frame>", scm, ctx);
+
+    string own = ctx.free_utf8_string(SCM_SLOT(scm, 5));
+
+    SCM scm_bv = SCM_SLOT(scm, 6);
+
+    size_t cb = SCM_BYTEVECTOR_LENGTH(scm_bv);
+    unsigned char *p = (unsigned char*) SCM_BYTEVECTOR_CONTENTS(scm_bv);
+
+    return unique_ptr<id3v2_4_frame>(new PRIV_2_4(
+        own, p, p + cb, tap, fap, ro, boost::none, boost::none,
+        false, unsync, boost::none));
+  }
+
 }
 
 ////////////////////////////////////////////////////////////////////////////////
@@ -1786,7 +1905,7 @@ scribbu::scheme_serde_dispatcher::de_unknown_frame_2_2(const scribbu::id3v2_2_fr
 
 SCM
 scribbu::scheme_serde_dispatcher::de_unknown_frame_2_3(const scribbu::id3v2_3_frame &f,
-                                              bool unsync) const
+                                                       bool unsync) const
 {
   typedef scribbu::id3v2_3_plus_frame::tag_alter_preservation
     tag_alter_preservation;

test/test-cleanup-encoded-by

@@ -2,15 +2,12 @@
 export GUILE_AUTO_COMPILE=0
 # Cf. https://stackoverflow.com/questions/11027679/store-capture-stdout-and-stderr-in-different-variables-bash
 cols=$(tput cols)
-echo "CP0"
 eval "$(../src/scribbu -L ${srcdir}/../scheme -s ${srcdir}/test-cleanup-encoded-by.scm ${srcdir} \
         2> >(t_err=$(cat); typeset -p t_err) \
          > >(t_std=$(cat); typeset -p t_std) )"
 t_stat=$?
-echo "CP1"
 echo "$t_std"
 t_err=$(echo "$t_err" | grep -vE ';;; note: source file .*test-cleanup-encoded-by.scm' | grep -v 'newer than compiled'|grep -v ';;; WARNING: failed to parse.*lunch4bfast.mp3')
-echo "CP2"
 if [ -n "$t_err" ]; then
     printf '=%.0s' $(seq 1 $cols)
 	echo "$t_err"
@@ -22,8 +19,6 @@ fi
 # Get rid of the "Last Modified" line
 sed -e '/^Last Modified/d' test-cleanup-encoded-by.$$.out > test-cleanup-encoded-by.out
 rm test-cleanup-encoded-by.$$.out
-echo "CP3"
 diff test-cleanup-encoded-by.out ${srcdir}/data/golden-test-cleanup-encoded-by.out || exit 2
-echo "CP4"
 
 exit $t_stat

test/test-display

@@ -15,7 +15,7 @@ if [ ! -z "$t_err" ]; then
 fi
 
 output=$(echo $t_std|tr \\n :)
-if [ "$output" != "<id3v1-tag Sinead O'Connor - Easter Rebellion (Performed by> <id3v2-tag The Pogues - Lorca's Novena (335921 bytes padding)>:" ]; then
+if [ "$output" != "<id3v1-tag Sinead O'Connor - Easter Rebellion (Performed by> <id3v2-tag The Pogues - Lorca's Novena (335921 bytes padding)> <title-frame \"Lorca's Novena\"> <artist-frame \"The Pogues\"> <album-frame \"Hell's Ditch [Expanded] (US Version)\"> <genre-frame \"Pop\"> <composer-frame \"\"> <conductor-frame \"\"> <track-frame \"5\"> <year-frame \"1990\"> <band-frame \"The Pogues\"> <comment (eng, ) Amazon.com Song ID: 203558254> <copyright-frame \"2004 Warner Music UK Ltd.\"> <part-of-a-set-frame \"1\"> <unk-frame \"APIC\" {41 50 49 43 00 01 c3 62 <APIC...b>}> <unk-frame \"PRIV\" {50 52 49 56 00 00 04 62 <PRIV...b>}>:" ]; then
     echo $output
     exit 1
 fi

test/test-display.scm

@@ -30,9 +30,12 @@
   "Exercise pretty-printing tags."
   (let ((tag (read-id3v1-tag (format #f "~a/data/elliot-goldenthal.id3v1.tag" srcdir))))
     (format (current-output-port) "~a\n" tag))
-  (let ((tag (caar (read-tagset (format #f "~a/data/lorca.mp3" srcdir)))))
-    (format (current-output-port) "~a\n" tag)))
-
+  (let* ((tag (caar (read-tagset (format #f "~a/data/lorca.mp3" srcdir))))
+         (frames (slot-ref tag 'frames)))
+    (format (current-output-port) "~a\n" tag)
+    (while (> (length frames) 0)
+           (format (current-output-port) "~a\n" (car frames))
+           (set! frames (cdr frames)))))
 
 (let ((cl (cdr (command-line))))
   (if (= 1 (length cl))

test/test-frames-from-scheme.scm

@@ -47,18 +47,18 @@
                                 (slot-ref tag 'padding))))
       ;; Brute-force test for deserializing
 
-      ;; class           id                  'text or 'id-text
-      ;; =====================================================
-      ;; <text-frame>    title-frame         "Lorca's Novena"
-      ;; <text-frame>    artist-frame        "The Pogues"
-      ;; <text-frame>    album-frame         "Hell's Ditch [Expanded] (US Version)"
-      ;; <text-frame>    genre-frame         "Pop"
-      ;; <text-frame>    composer-frame      ""
-      ;; <text-frame>    conductor-frame     ""
-      ;; <text-frame>    track-frame         "5"
-      ;; <text-frame>    year-frame          "1990"
-      ;; <text-frame>    band-frame          "The Pogues"
-      ;; <comment-frame> comment-frame
+      ;;   class           id                  'text or 'id-text
+      ;; ========================================================
+      ;; 0 <text-frame>    title-frame         "Lorca's Novena"
+      ;; 1 <text-frame>    artist-frame        "The Pogues"
+      ;; 2 <text-frame>    album-frame         "Hell's Ditch [Expanded] (US Version)"
+      ;; 3 <text-frame>    genre-frame         "Pop"
+      ;; 4 <text-frame>    composer-frame      ""
+      ;; 5 <text-frame>    conductor-frame     ""
+      ;; 6 <text-frame>    track-frame         "5"
+      ;; 7 <text-frame>    year-frame          "1990"
+      ;; 8 <text-frame>    band-frame          "The Pogues"
+      ;; 9 <comment-frame> comment-frame
       ;; <text-frame>    copyright-frame     "2004 Warner Music UK Ltd."
       ;; <text-frame>    part-of-a-set-frame "1"
       ;; <unk-frame>     unknown-frame       "APIC"