Coverage report: /home/ellis/comp/core/lib/dsp/av.lisp

KindCoveredAll%
expression7177 4.0
branch08 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; av.lisp --- Audio/Video
2
 
3
 ;; High-level wrappers to libav*
4
 
5
 ;;; Code:
6
 (in-package :dsp/av)
7
 
8
 (defun load-av (&key (util t) (codec t) (format t))
9
   (when util (load-avutil))
10
   (when codec (load-avcodec))
11
   (when format (load-avformat)))
12
 
13
 (eval-always (deferror av-error (dsp-error std-error) ()))
14
 
15
 (defmacro with-av-handlers (&body body)
16
   `(handler-case (progn ,@body)
17
      (error (c) (error 'av-error :message (format nil "An error occurred in a LIBAV* context: ~S" c)))))
18
 
19
 (defmacro with-av-format-context (sym &body body)
20
   `(with-alien ((,sym (* av-format-context) (avformat-alloc-context)))
21
      (unwind-protect (with-av-handlers ,@body)
22
        (avformat-free-context ,sym))))
23
 
24
 (defmacro with-av-codec-context ((sym codec-id) &body body)
25
   `(with-alien ((,sym (* av-codec-context) (avcodec-alloc-context3 (avcodec-find-decoder ,codec-id))))
26
      (unwind-protect (with-av-handlers ,@body)
27
        (avcodec-free-context ,sym))))
28
 
29
 (defmacro with-av-parser ((sym codec-id) &body body)
30
   `(with-alien ((,sym (* av-codec-context) (av-parser-init ,codec-id)))
31
      (unwind-protect (with-av-handlers ,@body)
32
        (av-parser-close ,sym))))
33
 
34
 (defmacro with-av-frame (sym &body body)
35
   `(with-alien ((,sym (* av-frame) (av-frame-alloc)))
36
      (unwind-protect (with-av-handlers ,@body)
37
        (av-frame-free ,sym))))
38
 
39
 (defmacro with-av-packet (sym &body body)
40
   `(with-alien ((,sym (* av-packet) (av-packet-alloc)))
41
      (unwind-protect (with-av-handlers ,@body)
42
        (av-frame-free ,sym))))
43
 
44
 (defun av-dictionary-alist (dict)
45
   (let ((tag))
46
     (loop do (setf tag (av-dict-iterate dict tag))
47
           while (and tag (not (null-alien tag)))
48
           collect (cons (slot tag 'ffmpeg::key) (slot tag 'ffmpeg::val)))))
49
 
50
 (defun av-dictionary-to-hash-table (dict)
51
   (let ((tag)
52
         (tbl (make-hash-table :test 'equalp)))
53
     (loop do (setf tag (av-dict-iterate dict tag))
54
           while (and tag (not (null-alien tag)))
55
           do (setf (gethash (slot tag 'ffmpeg::key) tbl) (slot tag 'ffmpeg::val))
56
           finally (return tbl))))
57
 
58
 (defun av-dictionary-coerce (dict type)
59
   (ecase type
60
     (:hash-table (av-dictionary-to-hash-table dict))
61
     ((or :alist :list) (av-dictionary-alist dict))))
62
 
63
 (defun media-file-metadata (path &optional (type :hash-table))
64
   (with-av-format-context ctx
65
     (unwind-protect 
66
          (case #1=(avformat-open-input (addr ctx) (namestring path) nil nil)
67
                (0 (with-alien ((dict (* av-dictionary) (slot ctx 'ffmpeg::metadata)))
68
                     (prog1 (av-dictionary-coerce dict type))))
69
                (t (error 'av-error :message #1#)))
70
       (avformat-close-input (addr ctx)))))
71
 
72
 (defun media-file-format (path)
73
   (with-av-format-context ctx
74
     (assert (zerop (avformat-open-input (addr ctx) (namestring path) nil nil)))
75
     (assert (zerop (avformat-find-stream-info ctx nil)))
76
     (let ((iformat (slot ctx 'ffmpeg::iformat)))
77
       (values
78
        (ssplit #\, (slot iformat 'ffmpeg::name))
79
        (ssplit #\, (slot iformat 'ffmpeg::extensions))
80
        (ssplit #\, (slot iformat 'ffmpeg::mime-type))))))
81
 
82
 (defun media-file-codecs (path)
83
   (with-av-format-context ctx
84
     (assert (zerop (avformat-open-input (addr ctx) (namestring path) nil nil)))
85
     (assert (zerop (avformat-find-stream-info ctx nil)))
86
     (let ((vc (slot ctx 'ffmpeg::video-codec))
87
           (ac (slot ctx 'ffmpeg::audio-codec))
88
           (sc (slot ctx 'ffmpeg::subtitle-codec))
89
           (dc (slot ctx 'ffmpeg::data-codec)))
90
       (values ac vc sc dc))))
91
 
92
 (defun media-file-stream-count (path)
93
   (with-av-format-context ctx
94
     (assert (zerop (avformat-open-input (addr ctx) (namestring path) nil nil)))
95
     (assert (zerop (avformat-find-stream-info ctx nil)))
96
     (values (slot ctx 'ffmpeg::nb-streams) (slot ctx 'ffmpeg::nb-stream-groups))))