ambrevar/ffprobe: Add ffprobe abstraction.

.local/share/common-lisp/source/ambrevar/all.lisp

@@ -42,6 +42,7 @@
   (:use-reexport
    #:ambrevar/debug
    #:ambrevar/emacs
+   #:ambrevar/ffprobe
    #:ambrevar/file
    #:ambrevar/guix
    #:ambrevar/shell

.local/share/common-lisp/source/ambrevar/ffprobe.lisp

@@ -0,0 +1,126 @@
+(uiop:define-package ambrevar/ffprobe
+  (:documentation "FFprobe abstraction.")
+  (:use #:common-lisp)
+  (:use #:trivia)
+  (:import-from #:hu.dwim.defclass-star #:defclass*)
+  (:import-from #:serapeum #:export-always))
+(in-package ambrevar/ffprobe)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (trivial-package-local-nicknames:add-package-local-nickname :alex :alexandria)
+  (trivial-package-local-nicknames:add-package-local-nickname :sera :serapeum))
+
+(sera:eval-always
+  (defun name-identity (name definition)
+    (declare (ignore definition))
+    name))
+
+(defclass* disposition ()
+    ((default 0)
+     (dub 0)
+     (original 0)
+     (comment 0)
+     (lyrics 0)
+     (karaoke 0)
+     (forced 0)
+     (hearing-impaired 0)
+     (visual-impaired 0)
+     (clean-effects 0)
+     (attached-pic 0)
+     (timed-thumbnails 0))
+    (:accessor-name-transformer #'name-identity))
+
+(defclass* media-stream ()              ; REVIEW: `stream' is reserved by CL.
+    ((index 0)
+     (codec-name "")
+     (codec-long-name "")
+     (profile "")
+     (codec-type "")
+     (width 0)
+     (height 0)
+     (coded-width 0)
+     (coded-height 0)
+     (closed-captions 0)
+     (has-b-frames 0)
+     (pix-fmt "")
+     (level 0)
+     (color-range "")
+     (color-space "")
+     (refs 0)
+     (sample-aspect-ratio "")
+     (display-aspect-ratio "")
+     (codec-time-base "")               ; TODO: Ratio?
+     (codec-tag-string "")
+     (codec-tag "")                     ; TODO: Hex?
+     (sample-fmt "")
+     (sample-rate 0)
+     (channels 2)
+     (channel-layout "")
+     (bits-per-sample 0)
+     (r-frame-rate "")                  ; TODO: Ratio?
+     (avg-frame-rate "")                ; TODO: Ratio?
+     (time-base "")
+     (start-pts 0)
+     (start-time 0.0)
+     (duration-ts 0.0)
+     (duration 0.0)
+     (bit-rate 0)
+     (disposition nil
+                  :type (or null disposition))
+     (tags '()))
+    (:accessor-name-transformer #'name-identity))
+
+(defclass* media-format ()              ; REVIEW: `format' is reserved by CL.
+    ((filename "")
+     (nb-streams 0)
+     (nb-programs 0)
+     (format-name "")
+     (format-long-name "")
+     (start-time 0.0)
+     (duration 0.0)
+     (size 0)
+     (bit-rate 0)
+     (probe-score 0)
+     (tags '()))
+    (:accessor-name-transformer #'name-identity))
+
+(defun normalize-cl-json-keywords (sym)
+  "Turn '--' to '-' and remove '+' from keywords."
+  (if (keywordp sym)
+      (intern (str:replace-all
+               "+" ""
+               (str:replace-all "--" "-" (symbol-name sym)))
+              "KEYWORD")
+      sym))
+
+(defun normalize-cl-json-scalar (value)
+  "Turn non-ratio number string to numbers."
+  (if (stringp value)
+      (let ((result (ignore-errors (parse-number:parse-number value))))
+        (if (and result
+                 (not (typep result 'ratio)))
+            result
+            value))
+      value))
+
+(defun json->media-args (json)
+  (alex:mappend (lambda-match
+                  ((cons key value)
+                   (list (normalize-cl-json-keywords key)
+                         (if (listp value)
+                             (format-ffprobe-json value)
+                             (normalize-cl-json-scalar value)))))
+                json))
+
+(defun ffprobe (path)
+  "Return a list of (MEDIA-FORMAT MEDIA-STREAMS...)."
+  (let* ((json-string
+           (cmd:$cmd "ffprobe -v quiet -print_format json -show_format -show_streams -- "
+                     (write-to-string path)))
+         (json (cl-json:decode-json-from-string json-string)))
+    (let* ((format-args (json->media-args (alex:assoc-value json :format)))
+           (format (apply #'make-instance 'media-format format-args)))
+      (cons format
+            (mapcar (lambda (s)
+                      (let ((stream-args (json->media-args s)))
+                        (apply #'make-instance 'media-stream stream-args)))
+                    (alex:assoc-value json :streams))))))