Continuing cleanup: merged mp3- and mp4- tag into one package to simplify adding new tag types

mp3-tag.lisp → abstract-tag.lisp

@@ -1,6 +1,6 @@
-;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: MP3-TAG; -*-
+;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: ABSTRACT-TAG; -*-
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
-(in-package #:mp3-tag)
+(in-package #:abstract-tag)
 
 (defparameter *id3v1-genres*
   #("Blues"
@@ -168,6 +168,8 @@
         "BAD GENRE"
         (aref *id3v1-genres* n)))
 
+;;;;;;;;;;;;;;;;;;;; MP3 ;;;;;;;;;;;;;;;;;;;;
+
 (defun get-frames (stream names)
   "Given a MP3-STREAM, search its frames for NAMES.  Return file-order list of matching frames"
   (let (found-frames)
@@ -177,7 +179,6 @@
                               (push f found-frames))))
     (nreverse found-frames)))
 
-;;; Abstract TAG interface
 ;;; The following probably should be macro-ized in the future---lots of cut/paste going on...
 (defmethod album ((me mp3-file-stream))
   (let ((frames (get-frames me '("TAL" "TALB"))))
@@ -386,3 +387,84 @@
         (when track (format t "~4ttrack: ~a~%" track))
         (when writer (format t "~4twriter: ~a~%" writer))
         (when year (format t "~4tyear: ~a~%" year)))))
+
+
+
+;;;;;;;;;;;;;;;;;;;; MP4 ;;;;;;;;;;;;;;;;;;;;
+;;; Abstract TAG interface
+(defmethod album ((me mp4-file-stream))          (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-album+))
+(defmethod album-artist ((me mp4-file-stream))   (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-album-artist+))
+(defmethod artist ((me mp4-file-stream))         (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-artist+))
+(defmethod comment ((me mp4-file-stream))        (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-comment+))
+(defmethod composer ((me mp4-file-stream))       (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-composer+))
+(defmethod copyright ((me mp4-file-stream))      (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-copyright+))
+(defmethod year ((me mp4-file-stream))           (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-year+))
+(defmethod encoder ((me mp4-file-stream))        (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-encoder+))
+(defmethod groups ((me mp4-file-stream))         (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-groups+))
+(defmethod lyrics ((me mp4-file-stream))         (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-lyrics+))
+(defmethod title ((me mp4-file-stream))          (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-title+))
+(defmethod writer ((me mp4-file-stream))         (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-writer+))
+(defmethod compilation ((me mp4-file-stream))    (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-compilation+))
+(defmethod disk  ((me mp4-file-stream))          (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-disk+))
+(defmethod tempo ((me mp4-file-stream))          (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-tempo+))
+(defmethod genre ((me mp4-file-stream))
+  (let ((genre   (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-genre+))
+        (genre-x (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-genre-x+)))
+    (assert (not (and genre genre-x)))
+    (cond
+      (genre   (format nil "~d (~a)" genre (get-id3v1-genre (1- genre))))
+      (genre-x (format nil "~d (~a)" genre-x (get-id3v1-genre (1- genre-x))))
+      (t       "None"))))
+(defmethod track ((me mp4-file-stream))
+  (let ((track   (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-track+))
+        (track-n (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-track-n+)))
+    (assert (not (and track track-n)))
+    (if track
+        track
+        track-n)))
+
+(defmethod show-tags ((me mp4-file-stream) &key (raw nil))
+  "Show the tags for an MP4-FILE. If RAW is non-nil, dump the DATA atoms; else show subset of DATA atoms"
+  (format t "~a~%" (stream-filename me))
+  (if raw
+      (progn
+        (mp4-atom:mp4-show-raw-tag-atoms me)
+        (if (audio-info me)
+          (mp4-atom:vpprint (audio-info me) t)))
+      (let ((album (album me))
+            (album-artist (album-artist me))
+            (artist (artist me))
+            (comment (comment me))
+            (compilation (compilation me))
+            (composer (composer me))
+            (copyright (copyright me))
+            (disk (disk me))
+            (encoder (encoder me))
+            (genre (genre me))
+            (groups (groups me))
+            (lyrics (lyrics me))
+            (tempo (tempo me))
+            (title (title me))
+            (track (track me))
+            (writer (writer me))
+            (year (year me)))
+
+        (if (audio-info me)
+          (mp4-atom:vpprint (audio-info me) t))
+        (when album (format t "~&~4talbum: ~a~%" album))
+        (when album-artist (format t "~4talbum-artist: ~a~%" album-artist))
+        (when artist (format t "~4tartist: ~a~%" artist))
+        (when comment (format t "~4tcomment: ~a~%" comment))
+        (format t "~4tcompilation: ~[no~;yes;unknown~]~%" (if compilation compilation 2))
+        (when composer (format t "~4tcomposer: ~a~%" composer))
+        (when copyright (format t "~4tcopyright: ~a~%" copyright))
+        (when disk (format t "~4tdisk: ~a~%" disk))
+        (when encoder (format t "~4tencoder: ~a~%" encoder))
+        (when genre (format t "~4tgenre: ~a~%" genre))
+        (when groups (format t "~4tgroups: ~a~%" groups))
+        (when lyrics (format t "~4tlyrics: ~a~%" lyrics))
+        (when tempo (format t "~4ttempo: ~a~%" tempo))
+        (when title (format t "~4ttitle: ~a~%" title))
+        (when track (format t "~4ttrack: ~a~%" track))
+        (when writer (format t "~4twriter: ~a~%" writer))
+        (when year (format t "~4tyear: ~a~%" year)))))

id3-frame.lisp

@@ -69,7 +69,7 @@ Written in this fashion so as to be 'crash-proof' when passed an arbitrary file.
 (defmethod vpprint ((me v21-tag-header) stream)
   (with-slots (title artist album year comment track genre) me
     (format stream "title = <~a>, artist = <~a>, album = <~a>, year = <~a>, comment = <~a>, track = <~d>, genre = ~d (~a)"
-            title artist album year comment track genre (mp3-tag:get-id3v1-genre genre))))
+            title artist album year comment track genre (abstract-tag:get-id3v1-genre genre))))
 
 ;;; NB: no ":after" here
 (defmethod initialize-instance ((me v21-tag-header) &key instream)

mp4-tag.lisp

@@ -1,81 +0,0 @@
-;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: MP4-TAG; -*-
-;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
-(in-package #:mp4-tag)
-
-;;; Abstract TAG interface
-(defmethod album ((me mp4-file-stream))          (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-album+))
-(defmethod album-artist ((me mp4-file-stream))   (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-album-artist+))
-(defmethod artist ((me mp4-file-stream))         (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-artist+))
-(defmethod comment ((me mp4-file-stream))        (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-comment+))
-(defmethod composer ((me mp4-file-stream))       (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-composer+))
-(defmethod copyright ((me mp4-file-stream))      (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-copyright+))
-(defmethod year ((me mp4-file-stream))           (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-year+))
-(defmethod encoder ((me mp4-file-stream))        (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-encoder+))
-(defmethod groups ((me mp4-file-stream))         (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-groups+))
-(defmethod lyrics ((me mp4-file-stream))         (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-lyrics+))
-(defmethod title ((me mp4-file-stream))          (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-title+))
-(defmethod writer ((me mp4-file-stream))         (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-writer+))
-(defmethod compilation ((me mp4-file-stream))    (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-compilation+))
-(defmethod disk  ((me mp4-file-stream))          (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-disk+))
-(defmethod tempo ((me mp4-file-stream))          (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-tempo+))
-(defmethod genre ((me mp4-file-stream))
-  (let ((genre   (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-genre+))
-        (genre-x (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-genre-x+)))
-    (assert (not (and genre genre-x)))
-    (cond
-      (genre   (format nil "~d (~a)" genre (mp3-tag:get-id3v1-genre (1- genre))))
-      (genre-x (format nil "~d (~a)" genre-x (mp3-tag:get-id3v1-genre (1- genre-x))))
-      (t       "None"))))
-(defmethod track ((me mp4-file-stream))
-  (let ((track   (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-track+))
-        (track-n (mp4-atom:tag-get-value (mp4-atoms me) mp4-atom:+itunes-track-n+)))
-    (assert (not (and track track-n)))
-    (if track
-        track
-        track-n)))
-
-(defmethod show-tags ((me mp4-file-stream) &key (raw nil))
-  "Show the tags for an MP4-FILE. If RAW is non-nil, dump the DATA atoms; else show subset of DATA atoms"
-  (format t "~a~%" (stream-filename me))
-  (if raw
-      (progn
-        (mp4-atom:mp4-show-raw-tag-atoms me)
-        (if (audio-info me)
-          (mp4-atom:vpprint (audio-info me) t)))
-      (let ((album (album me))
-            (album-artist (album-artist me))
-            (artist (artist me))
-            (comment (comment me))
-            (compilation (compilation me))
-            (composer (composer me))
-            (copyright (copyright me))
-            (disk (disk me))
-            (encoder (encoder me))
-            (genre (genre me))
-            (groups (groups me))
-            (lyrics (lyrics me))
-            (tempo (tempo me))
-            (title (title me))
-            (track (track me))
-            (writer (writer me))
-            (year (year me)))
-
-        (if (audio-info me)
-          (mp4-atom:vpprint (audio-info me) t))
-        (when album (format t "~&~4talbum: ~a~%" album))
-        (when album-artist (format t "~4talbum-artist: ~a~%" album-artist))
-        (when artist (format t "~4tartist: ~a~%" artist))
-        (when comment (format t "~4tcomment: ~a~%" comment))
-        (format t "~4tcompilation: ~[no~;yes;unknown~]~%" (if compilation compilation 2))
-        (when composer (format t "~4tcomposer: ~a~%" composer))
-        (when copyright (format t "~4tcopyright: ~a~%" copyright))
-        (when disk (format t "~4tdisk: ~a~%" disk))
-        (when encoder (format t "~4tencoder: ~a~%" encoder))
-        (when genre (format t "~4tgenre: ~a~%" genre))
-        (when groups (format t "~4tgroups: ~a~%" groups))
-        (when lyrics (format t "~4tlyrics: ~a~%" lyrics))
-        (when tempo (format t "~4ttempo: ~a~%" tempo))
-        (when title (format t "~4ttitle: ~a~%" title))
-        (when track (format t "~4ttrack: ~a~%" track))
-        (when writer (format t "~4twriter: ~a~%" writer))
-        (when year (format t "~4tyear: ~a~%" year)))))

packages.lisp

@@ -63,14 +63,21 @@
            #:map-id3-frames #:frames #:year #:title #:genre #:id #:v21-tag-header #:info #:version)
   (:use #:common-lisp #:audio-streams #:utils #:iso-639-2))
 
-(defpackage #:mp3-tag
-  (:export #:show-tags #:get-id3v1-genre)
-  (:use #:common-lisp #:audio-streams #:id3-frame #:utils))
+;; (defpackage #:mp3-tag
+;;   (:export #:show-tags #:get-id3v1-genre)
+;;   (:use #:common-lisp #:audio-streams #:id3-frame #:utils))
+
+;; (defpackage #:mp4-tag
+;;   (:export #:show-tags #:album #:album-artist #:artist #:comment #:composer #:copyright #:created
+;;            #:encoder #:groups #:lyrics #:purd #:title #:tool #:writer)
+;;   (:use #:common-lisp #:audio-streams #:utils))
 
-(defpackage #:mp4-tag
-  (:export #:show-tags #:album #:album-artist #:artist #:comment #:composer #:copyright #:created
+(defpackage #:abstract-tag
+  (:export #:show-tags #:get-id3v1-genre
+           #:album #:album-artist #:artist #:comment #:composer #:copyright #:created
            #:encoder #:groups #:lyrics #:purd #:title #:tool #:writer)
-  (:use #:common-lisp #:audio-streams #:utils))
+  (:use #:common-lisp #:audio-streams #:id3-frame #:utils))
+
 
 (defpackage #:logging
   (:export #:with-logging)

taglib-tests.lisp

@@ -39,8 +39,7 @@
 
 
 (defun do-audio-dir (&optional (dir "Queen") &key (file-system-encoding :utf-8)
-                                                  (mp3-func #'mp3-tag:show-tags)
-                                                  (mp4-func #'mp4-tag:show-tags))
+                                                  (func #'abstract-tag:show-tags))
   "Walk :DIR and FUNCALL specified function for each file (MP4/MP3) found."
   (set-pathname-encoding file-system-encoding)
   (let ((mp3-count 0)
@@ -51,12 +50,12 @@
                                  (do-audio-file f :func (lambda (s)
                                                           (cond ((typep s 'mp3-file-stream)
                                                                  (incf mp3-count)
-                                                                 (when mp3-func
-                                                                   (funcall mp3-func s)))
+                                                                 (when func
+                                                                   (funcall func s)))
                                                                 ((typep s 'mp4-file-stream)
                                                                  (incf mp4-count)
-                                                                 (when mp4-func
-                                                                   (funcall mp4-func s)))
+                                                                 (when func
+                                                                   (funcall func s)))
                                                                 ((null s) (incf other-count)))))))
 
     (format t "~&~:d MP3s, ~:d MP4s, ~:d Others, for a total of ~:d~%"
@@ -65,7 +64,7 @@
 (defun time-test (&optional (dir "Queen") &key (file-system-encoding :utf-8) (do-audio-processing t))
   "Time parsing of DIR."
   (let ((audio-streams:*get-audio-info* do-audio-processing))
-    (time (do-audio-dir dir :file-system-encoding file-system-encoding :mp3-func nil :mp4-func nil))))
+    (time (do-audio-dir dir :file-system-encoding file-system-encoding :func nil))))
 
 ;;;;;;;;;;;;;;;;;;;; Experimental multi-thread code below ;;;;;;;;;;;;;;;;;;;;
 
@@ -79,8 +78,7 @@
   other-count)
 
 (defun mp-do-audio-dir (&optional (dir "Queen") &key (file-system-encoding :utf-8)
-                                                     (mp3-func #'mp3-tag:show-tags)
-                                                     (mp4-func #'mp4-tag:show-tags))
+                                                     (func #'abstract-tag:show-tags))
   "Walk :DIR and FUNCALL specified function for each file (MP4/MP3) found."
   (set-pathname-encoding file-system-encoding)
   (let ((channel (make-instance 'chanl:unbounded-channel))
@@ -103,10 +101,10 @@
                      (do-audio-file f :func (lambda (s)
                                               (cond ((typep s 'mp3-file-stream)
                                                      (incf mp3-count)
-                                                     (when mp3-func (funcall mp3-func s)))
+                                                     (when func (funcall func s)))
                                                     ((typep s 'mp4-file-stream)
                                                      (incf mp4-count)
-                                                     (when mp4-func (funcall mp4-func s)))
+                                                     (when func (funcall func s)))
                                                     ((null s) (incf other-count))))))))))
 
       (cl-fad:walk-directory dir (lambda (f)
@@ -146,4 +144,4 @@
 (defun mp-time-test (&optional (dir "Queen") &key (file-system-encoding :utf-8) (do-audio-processing t))
   "Time parsing of DIR."
   (let ((audio-streams:*get-audio-info* do-audio-processing))
-    (time (mp-do-audio-dir dir :file-system-encoding file-system-encoding :mp3-func nil :mp4-func nil))))
+    (time (mp-do-audio-dir dir :file-system-encoding file-system-encoding :func nil))))

taglib.asd

@@ -2,23 +2,19 @@
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 ;;;
 
-;;; should only be set when on markv machines...
-(pushnew :I-AM-MARKV *features*)
-
 (asdf:defsystem #:taglib
   :description "Pure Lisp implementation to read (and write, perhaps, one day) tags"
   :author "Mark VandenBrink"
   :license "Public Domain"
-  :depends-on (#:log5)
+  :depends-on (#:log5 #:optima #:optima.ppcre)
   :components ((:file "packages")
                (:file "utils"         :depends-on ("packages"))
                (:file "audio-streams" :depends-on ("packages" "utils"))
                (:file "mpeg"          :depends-on ("packages" "audio-streams" "utils"))
                (:file "iso-639-2"     :depends-on ("packages" "utils"))
                (:file "id3-frame"     :depends-on ("packages" "utils"))
-               (:file "mp3-tag"       :depends-on ("packages" "id3-frame" "audio-streams" "utils"))
+               (:file "abstract-tag"  :depends-on ("packages" "id3-frame" "audio-streams" "mp4-atom" "utils"))
+			   ;;(:file "mp3-tag"       :depends-on ("packages" "id3-frame" "audio-streams" "utils"))
+               ;;(:file "mp4-tag"       :depends-on ("packages" "utils")))
                (:file "logging"       :depends-on ("packages" "mp4-atom" "audio-streams" "utils"))
-               (:file "mp4-atom"      :depends-on ("packages" "utils"))
-               (:file "mp4-tag"       :depends-on ("packages" "utils"))))
-
-
+               (:file "mp4-atom"      :depends-on ("packages" "utils"))))