From 806a1fd91a96f72433c0998eedb76cbc78856219 Mon Sep 17 00:00:00 2001 From: Michael Herstine Date: Fri, 2 Feb 2024 18:11:00 -0800 Subject: [PATCH] pretty-print frames --- doc/scribbu.texi | 1 + doc/version.texi | 4 +- scheme/scribbu.scm | 50 ++++++++++++- scribbu/scheme-serde.cc | 121 ++++++++++++++++++++++++++++++- test/test-cleanup-encoded-by | 5 -- test/test-display | 2 +- test/test-display.scm | 9 ++- test/test-frames-from-scheme.scm | 24 +++--- 8 files changed, 191 insertions(+), 25 deletions(-) diff --git a/doc/scribbu.texi b/doc/scribbu.texi index 8f78cc0..fcaf411 100644 --- a/doc/scribbu.texi +++ b/doc/scribbu.texi @@ -2197,6 +2197,7 @@ Module @code{scribbu} defines a few @code{} sub-classes. * @code{}:: * @code{}:: * @code{}:: +* @code{}:: * @code{}:: @end menu diff --git a/doc/version.texi b/doc/version.texi index 64b81d3..42a321a 100644 --- a/doc/version.texi +++ b/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 diff --git a/scheme/scribbu.scm b/scheme/scribbu.scm index d41902e..323415b 100644 --- a/scheme/scribbu.scm +++ b/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 ) out) + (format out "" (slot-ref f 'id-text) (pp-bytevector (slot-ref f 'data)))) + (define-class () (text #:init-value "" #:accessor text #:init-keyword #:text)) +(define-method (display (f ) out) + (format out "<~a ~s>" (slot-ref f 'id) (slot-ref f 'text))) + (define-class () (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 ) out) + (format out "" (slot-ref f 'lang) (slot-ref f 'dsc) + (slot-ref f 'text))) + (define-class () (dsc #:init-value "" #:accessor dsc #:init-keyword #:dsc) (text #:init-value "" #:accessor text #:init-keyword #:text)) +(define-method (display (f ) out) + (format out "" (slot-ref f 'dsc))) + (define-class () (count #:init-value 0 #:accessor count #:init-keyword #:count)) +(define-method (display (f ) out) + (format out "" (slot-ref f 'count))) + (define-class () (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 ) out) + (format out "" (slot-ref f 'e-mail) + (slot-ref f 'rating) (slot-ref f 'count))) + (define-class () (owner #:init-value "" #:accessor owner #:init-keyword #:owner) (tags #:init-value '() #:accessor tags #:init-keyword #:tags)) +(define-method (display (f ) out) + (format out "" (slot-ref f 'owner) (slot-ref f 'tags))) + +(define-class () + (owner #:init-value "" #:accessor owner #:init-keyword #:owner) + (data #:init-value #vu8() #:accessor data #:init-keyword #:data)) + +(define-method (display (f ) out) + (format out "" (slot-ref f 'owner) (pp-bytevector (slot-ref f 'data)))) + (define-class () (experimental #:init-value '() #:accessor experimental #:init-keyword experimental) diff --git a/scribbu/scheme-serde.cc b/scribbu/scheme-serde.cc index 2c2f1b0..670f8e3 100644 --- a/scribbu/scheme-serde.cc +++ b/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("", sym_tag_cloud_frame, + f.tag_alter_preserve(), f.file_alter_preserve(), + f.readonly()); + + string own = f.email(); + SCM_SET_SLOT(x, 5, scm_from_utf8_string(own.c_str())); + + vector 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("", sym_tag_cloud_frame, + f.tag_alter_preserve(), f.file_alter_preserve(), + f.readonly(), f.unsynchronised()); + + string own = f.email(); + SCM_SET_SLOT(x, 5, scm_from_utf8_string(own.c_str())); + + vector 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 + 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("", 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(new PRIV(own, p, p + cb, + tap, fap, ro, boost::none, + boost::none, boost::none)); + } + + std::unique_ptr + 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("", 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(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; diff --git a/test/test-cleanup-encoded-by b/test/test-cleanup-encoded-by index 77cbc67..95b9cad 100755 --- a/test/test-cleanup-encoded-by +++ b/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 diff --git a/test/test-display b/test/test-display index 5300067..239fb6f 100755 --- a/test/test-display +++ b/test/test-display @@ -15,7 +15,7 @@ if [ ! -z "$t_err" ]; then fi output=$(echo $t_std|tr \\n :) -if [ "$output" != " :" ]; then +if [ "$output" != " }> }>:" ]; then echo $output exit 1 fi diff --git a/test/test-display.scm b/test/test-display.scm index c332554..5a5535d 100644 --- a/test/test-display.scm +++ b/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)) diff --git a/test/test-frames-from-scheme.scm b/test/test-frames-from-scheme.scm index cbd6f8c..6f78053 100644 --- a/test/test-frames-from-scheme.scm +++ b/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 - ;; ===================================================== - ;; 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-frame + ;; class id 'text or 'id-text + ;; ======================================================== + ;; 0 title-frame "Lorca's Novena" + ;; 1 artist-frame "The Pogues" + ;; 2 album-frame "Hell's Ditch [Expanded] (US Version)" + ;; 3 genre-frame "Pop" + ;; 4 composer-frame "" + ;; 5 conductor-frame "" + ;; 6 track-frame "5" + ;; 7 year-frame "1990" + ;; 8 band-frame "The Pogues" + ;; 9 comment-frame ;; copyright-frame "2004 Warner Music UK Ltd." ;; part-of-a-set-frame "1" ;; unknown-frame "APIC"