Mark VandenBrink 12 years ago
parent
commit
47b6eeb390
7 changed files with 39 additions and 37 deletions
  1. 4 4
      id3-frame.lisp
  2. 3 3
      mp3-tag.lisp
  3. 2 2
      mp4-atom.lisp
  4. 7 5
      mpeg.lisp
  5. 2 2
      packages.lisp
  6. 6 18
      taglib-tests.lisp
  7. 15 3
      utils.lisp

+ 4 - 4
id3-frame.lisp

@@ -908,10 +908,10 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
 
     (log5:with-context "find-id3-frames"
       (when (not (is-valid-mp3-file mp3-file))
-        (log-id3-frame "~a is not an mp3 file" (stream-filename mp3-file))
-        (error 'id3-frame-condition :location "find-id3-frames" :object (stream-filename mp3-file) :message "is not an mp3 file"))
+        (log-id3-frame "~a is not an mp3 file" (fn mp3-file))
+        (error 'id3-frame-condition :location "find-id3-frames" :object (fn mp3-file) :message "is not an mp3 file"))
 
-      (log-id3-frame "~a is a valid mp3 file" (stream-filename mp3-file))
+      (log-id3-frame "~a is a valid mp3 file" (fn mp3-file))
 
       (setf (id3-header mp3-file) (make-instance 'id3-header :instream mp3-file))
       (with-slots (size ext-header frames flags version) (id3-header mp3-file)
@@ -930,7 +930,7 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
             ;; Start reading frames from memory stream
             (multiple-value-bind (_ok _frames) (read-loop version mem-stream)
               (if (not _ok)
-                  (warn-user "File ~a had errors finding mp3 frames. potentially missed frames!" (stream-filename mp3-file)))
+                  (warn-user "File ~a had errors finding mp3 frames. potentially missed frames!" (fn mp3-file)))
               (log-id3-frame "ok = ~a, returning ~d frames" _ok (length _frames))
               (setf frames _frames)
               _ok)))))))

+ 3 - 3
mp3-tag.lisp

@@ -232,7 +232,7 @@
   (let ((frames (get-frames me '("TCO" "TCON"))))
     (when frames
       (when (> (length frames) 1)
-        (warn-user "file ~a has more than one genre frame, will only use the first" (stream-filename me)))
+        (warn-user "file ~a has more than one genre frame, will only use the first" (fn me)))
       (let ((count)
             (end)
             (str (info (first frames))))
@@ -344,7 +344,7 @@
 (defmethod show-tags ((me mp3-file-stream) &key (raw nil))
   "Show the tags for an mp3-file.  If RAW is non-nil, dump all the frames; else, print out a subset."
   (if raw
-      (format t "~a~%~a~%" (stream-filename me)
+      (format t "~a~%~a~%" (fn me)
               (with-output-to-string (s)
                 (when (audio-info me)
                   (mpeg::vpprint (audio-info me) s)
@@ -367,7 +367,7 @@
             (track (track me))
             (writer (writer me))
             (year (year me)))
-        (format t "~a~%~a~%" (stream-filename me)
+        (format t "~a~%~a~%" (fn me)
                 (if (audio-info me)
                     (mpeg::vpprint (audio-info me) nil) ""))
         (when album (format t "~4talbum: ~a~%" album))

+ 2 - 2
mp4-atom.lisp

@@ -461,7 +461,7 @@ Loop through this container and construct constituent atoms"
 
       (when (= 0 siz)
         (error "trying to make an atom ~a with size of 0 at offset ~:d in file ~a"
-               (as-string typ) pos (stream-filename mp4-file)))
+               (as-string typ) pos (fn mp4-file)))
 
       (setf atom (make-instance (find-atom-class typ) :atom-size siz :atom-type typ :atom-file-position pos :mp4-file mp4-file :atom-parent-type parent-type))
       (log-mp4-atom "make-mp4-atom: made ~a" (vpprint atom nil))
@@ -494,7 +494,7 @@ Loop through this container and construct constituent atoms"
       (error 'mp4-atom-condition :location "find-mp4-atoms" :object mp4-file :message "is not an mp4-file" ))
 
     (log-mp4-atom "find-mp4-atoms: ~a, before read-file loop, file-position = ~:d, end = ~:d"
-                  (stream-filename mp4-file) (stream-seek mp4-file) (stream-size mp4-file))
+                  (fn mp4-file) (stream-seek mp4-file) (stream-size mp4-file))
 
     (let ((atoms))
       (atom-read-loop mp4-file (stream-size mp4-file)

+ 7 - 5
mpeg.lisp

@@ -178,7 +178,10 @@
           (when (null hdr-u32)          ; has header already been read in?
             (log-mpeg-frame "reading in header")
             (setf pos (stream-seek instream))
-            (setf hdr-u32 (stream-read-u32 instream)))
+            (setf hdr-u32 (stream-read-u32 instream))
+            (when (null hdr-u32)
+              (log-mpeg-frame "hit EOF")
+              (return-from load-frame nil)))
 
           (if (parse-header me)
               (progn
@@ -326,8 +329,6 @@
     (format stream "tag = ~a, flags = 0x~x, frames = ~:d, bytes = ~:d, tocs = ~d, scale = ~d, "
             tag flags frames bytes tocs scale)))
 
-;;;     if( (head & 0xffe00000) != 0xffe00000 ||
-
 (defun find-first-sync (in)
   (log5:with-context "find-first-sync"
 
@@ -340,8 +341,9 @@
           (loop
             (setf pos (stream-seek in))
             (setf hdr-u32 (stream-read-u32 in))
+            (when (null hdr-u32) (return-from find-first-sync nil))
             (incf count)
-            ;;(log-mpeg-frame "pos = ~:d, count = ~:d, hdr-u32 = ~x" pos count hdr-u32)
+
             (when (= (logand hdr-u32 #xffe00000) #xffe00000)
               (log-mpeg-frame "Potential sync bytes at ~:d: <~x>" pos hdr-u32)
               (let ((hdr (make-instance 'frame :hdr-u32 hdr-u32 :pos pos)))
@@ -362,7 +364,7 @@
   (log5:with-context "next-frame"
     (let ((nxt-frame (make-instance 'frame)))
       (when (not (payload me))
-        (log-mpeg-frame "no payload loaded in current frame, skipping from ~:d forward ~:d bytes"
+        (log-mpeg-frame "no payload load required in current frame, skipping from ~:d forward ~:d bytes"
                         (stream-seek instream)
                         (- (size me) 4) :current)
         (stream-seek instream (- (size me) 4) :current))

+ 2 - 2
packages.lisp

@@ -3,7 +3,7 @@
 (in-package #:cl-user)
 
 (defpackage #:utils
-  (:export #:warn-user #:printable-array #:upto-null)
+  (:export #:warn-user #:printable-array #:upto-null #:has-extension)
   (:use #:common-lisp))
 
 (defpackage #:iso-639-2
@@ -15,7 +15,7 @@
            #:mp3-file-stream #:mp4-file-stream #:base-mem-stream
            #:id3-header #:audio-info #:mp4-atoms
            #:parse-mp3-file #:parse-mp4-file
-           #:make-mem-stream #:make-file-stream #:stream-filename #:stream-pos
+           #:make-mem-stream #:make-file-stream #:fn
            #:stream-read-u8 #:stream-read-u16 #:stream-read-u24 #:stream-read-u32 #:stream-read-u64 #:stream-read-octets
            #:stream-decode-iso-string #:stream-deocode-ucs-string #:stream-decode-ucs-be-string
            #:stream-decode-utf-8-string #:stream-decode-string #:stream-read-iso-string-with-len

+ 6 - 18
taglib-tests.lisp

@@ -17,18 +17,6 @@
 (defun set-pathname-encoding-for-osx ()   (set-pathname-encoding :utf-8))
 (defun set-pathname-encoding-for-linux () (set-pathname-encoding nil))
 
-(defmethod has-extension ((n string) ext)
-  "Probably should use CL's PATHNAME methods, but simply looking at the .XXX portion of a filename
-to see if it matches. This is the string version that makes a PATHNAME and calls the PATHNAME version."
-  (has-extension (parse-namestring n) ext))
-
-(defmethod has-extension ((p pathname) ext)
-  "Probably should use CL's PATHNAME methods , but simply looking at the .XXX portion of a filename
-to see if it matches. PATHNAME version."
-  (let ((e (pathname-type p)))
-    (if e
-      (string= (string-downcase e) (string-downcase ext))
-      nil)))
 
 (defmacro redirect (filename &rest body)
   "Temporarily set *STANDARD-OUTPUT* to FILENAME and execute BODY."
@@ -59,7 +47,7 @@ to see if it matches. PATHNAME version."
   "Walk :DIR and call SHOW-TAGS for each file (MP4/MP3) found."
   (set-pathname-encoding file-system-encoding)
   (osicat:walk-directory dir (lambda (f)
-                               (when (has-extension f "m4a")
+                               (when (utils:has-extension f "m4a")
                                  (let ((file (mp4-test0 (merge-pathnames (ccl:current-directory) (pathname f)))))
                                    (when file
                                      (mp4-tag:show-tags file :raw raw)))))))
@@ -83,7 +71,7 @@ to see if it matches. PATHNAME version."
   "Walk :DIR and parse every MP3 we find."
   (set-pathname-encoding file-system-encoding)
   (osicat:walk-directory dir (lambda (f)
-                               (when (has-extension f "mp3")
+                               (when (utils:has-extension f "mp3")
                                  (let ((file (mp3-test0 (merge-pathnames (ccl:current-directory) (pathname f)))))
                                    (when file
                                      (mp3-tag:show-tags file :raw raw)))))))
@@ -94,11 +82,11 @@ to see if it matches. PATHNAME version."
   (set-pathname-encoding file-system-encoding)
   (osicat:walk-directory dir (lambda (f)
                                (let ((full-name (merge-pathnames (ccl:current-directory) (pathname f))))
-                                 (cond ((has-extension f "mp3")
+                                 (cond ((utils:has-extension f "mp3")
                                         (let ((file (mp3-test0 full-name)))
                                           (when file
                                             (mp3-tag:show-tags file :raw raw))))
-                                       ((has-extension f "m4a")
+                                       ((utils:has-extension f "m4a")
                                         (let ((file (mp4-test0 full-name)))
                                           (when file
                                             (mp4-tag:show-tags file :raw raw)))))))))
@@ -111,10 +99,10 @@ to see if it matches. PATHNAME version."
     (labels ((do-dir (dir)
                (osicat:walk-directory dir (lambda (f)
                                             (let ((full-name (merge-pathnames (ccl:current-directory) (pathname f))))
-                                              (cond ((has-extension f "mp3")
+                                              (cond ((utils:has-extension f "mp3")
                                                      (incf mp3-count)
                                                      (mp3-test0 full-name))
-                                                    ((has-extension f "m4a")
+                                                    ((utils:has-extension f "m4a")
                                                      (incf mp4-count)
                                                      (mp4-test0 full-name))
                                                     (t

+ 15 - 3
utils.lisp

@@ -5,11 +5,10 @@
 (defun warn-user (format-string &rest args)
   "print a warning error to *ERROR-OUTPUT* and continue"
   ;; COMPLETELY UNPORTABLE!!!
-  (format *error-output* "~&****************************************~%")
+  (format *error-output* "~&********************************************************************************~%")
   (format *error-output* "~&~&WARNING in ~a:: " (ccl::%last-fn-on-stack 1))
   (apply #'format *error-output* format-string args)
-  (format *error-output* "~%~%")
-  (format *error-output* "****************************************~%"))
+  (format *error-output* "**********************************************************************************~%"))
 
 
 (defparameter *max-raw-bytes-print-len* 10 "Max number of octets to print from an array")
@@ -28,3 +27,16 @@
 (defun dump-data (file-name data)
   (with-open-file (f file-name :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
     (write-sequence data f)))
+
+(defmethod has-extension ((n string) ext)
+  "Probably should use CL's PATHNAME methods, but simply looking at the .XXX portion of a filename
+to see if it matches. This is the string version that makes a PATHNAME and calls the PATHNAME version."
+  (has-extension (parse-namestring n) ext))
+
+(defmethod has-extension ((p pathname) ext)
+  "Probably should use CL's PATHNAME methods , but simply looking at the .XXX portion of a filename
+to see if it matches. PATHNAME version."
+  (let ((e (pathname-type p)))
+    (if e
+      (string= (string-downcase e) (string-downcase ext))
+      nil)))