Plaster
New
List
Login
common-lisp
default
anonymous
2023.12.21 15:38:19
(uiop:define-package #:scripts/video-conversion (:use #:cl #:fare-utils #:cl-scripting #:inferior-shell #:cl-launch/dispatch) (:export #:convert-video #:convert-all)) (in-package #:scripts/video-conversion) (define-condition video-conversion-condition (serious-condition) ()) (define-condition file-not-a-video (video-conversion-condition) ((file :accessor file :initarg :file)) (:report (lambda (obj stream) (format stream "File ~A is not a video." (file obj))))) (defparameter *recently-used* "/home/josh/.local/share/recently-used.xbel") (defparameter *comment* "ite") (defparameter *description* "conversion brought to you by 08e781d46ae598328082e8c7e1b3ec601f1bc75ca44b822c9c50a861d079dd0b") (defvar *encoders* (make-hash-table :test #'equalp)) (defvar *extensions* (make-hash-table :test #'equalp)) (defvar *known-signatures* (make-hash-table :test #'equal)) (defparameter *separator* #\-) (defclass video () ((size :accessor size :initarg :size :type float) (dir :accessor dir :initarg :dir :type pathname) (final-size :accessor final-size :type float) (ffmpeg-args :accessor ffmpeg-args :initform () :type list) (name :accessor name :initarg :name :type name) (path :accessor path :initarg :path :type pathname) (new-name :accessor new-name :initarg :new-name :type name) (encoder :accessor encoder :initarg :encoder :type encoder))) (defclass as-string () ((as-string :accessor as-string :initarg :as-string :type (or string null)))) (defclass already-converted (video) ()) (defclass encoder (as-string) ()) (defclass other-encoder (encoder) ()) (defclass extension (as-string) ()) (defclass other-ext (extension) ()) (defclass signature (as-string) ()) (defclass invalid-signature (signature) ()) (defclass unknown-signature (invalid-signature) ()) (defclass no-signature (invalid-signature) ()) (defclass name () ((signature :accessor signature :initarg :signature :type signature) (extension :accessor extension :initarg :extension :type extension) (name :accessor name :initarg :name :type string))) (defclass known-name (name) ()) (defclass unknown-name (name) ()) (defmacro def-encoder (name string) `(progn (defclass ,name (encoder) ((as-string :initform ,string))) (setf (gethash ,string *encoders*) ',name))) (def-encoder av1 "av1") (def-encoder h264 "h264") (def-encoder h265 "h265") (def-encoder vp8 "vp8") (defparameter *wanted-encoder* (make-instance 'h264)) (defun get-encoder (string) (make-instance (gethash string *encoders* 'other-encoder))) (defun current-encoder-p (encoder) (eql (class-of encoder) (class-of *wanted-encoder*))) (defmacro def-extension (name string) `(progn (defclass ,name (extension) ((as-string :initform ,string))) (setf (gethash ,string *extensions*) ',name))) (def-extension mp4 "mp4") (def-extension wav "wav") (def-extension webm "webm") (def-extension mov "mov") (defun get-extension (string) (make-instance (gethash string *extensions* 'other-ext) :as-string string)) (defmethod current-extension-p ((extension mp4)) t) (defmethod current-extension-p ((extension extension)) nil) (defun make-blank-name () (make-instance 'name :extension (get-extension "mp4") :signature (get-signature "d0"))) (defun determine-extension (path) (let ((ext (pathname-type path))) (get-extension ext))) (defmacro def-signature (name string) `(progn (defclass ,name (signature) ((as-string :initform ,string))) (setf (gethash ,string *known-signatures*) ',name))) (def-signature d0 "d0") (defun get-signature (string) (make-instance (if string (gethash string *known-signatures* 'unknown-signature) 'no-signature))) (defun determine-signature (path) (let ((name (pathname-name path))) (if (find #\- name :from-end t) (get-signature (first (last (str:split *separator* name)))) (get-signature nil)))) (defmethod known-signature-p ((signature signature)) t) (defmethod known-signature-p ((signature invalid-signature)) nil) (defun construct-name (path) (let ((signature (determine-signature path))) (make-instance 'name :extension (determine-extension path) :signature signature :name (strip-signature signature (pathname-name path))))) (defmethod strip-signature ((sig invalid-signature) path) path) (defmethod strip-signature ((sig signature) path) "This means its our own name so something -<signature>" (str:replace-all (format nil "-~A" (as-string sig)) "" path)) (defun file-size (path) (with-open-file (s path :element-type '(unsigned-byte 8)) (let ((len (file-length s))) (float (/ (/ len 1024) 1024))))) (defmacro destructure-path ((name ext) path &body body) `(let ((,name (pathname-name ,path)) (,ext (pathname-type ,path))) (declare (ignorable ,name ,ext)) (locally ,@body))) (defmethod new-video :around (path) (let ((res (call-next-method))) (report-video res) res)) (defmethod new-video (path) (destructure-path (name ext) path (let* ((absolute (uiop:resolve-absolute-location path)) (name (construct-name path)) (size (file-size path)) (dir (uiop:resolve-absolute-location (make-pathname :directory (pathname-directory path)))) (encoder (determine-encoder absolute))) (make-instance (if (and (current-encoder-p encoder) (current-extension-p (extension name)) (known-signature-p (signature name))) 'already-converted 'video) :name name :size size :path absolute :dir dir :encoder encoder)))) (defun clean-ffmpeg-info (info) (mapcar #'str:collapse-whitespaces (str:split #\Newline info :omit-nulls t))) (defmethod determine-encoder :around (path) (handler-case (call-next-method) (uiop/run-program:subprocess-error () (error 'file-not-a-video :file path)))) (defmethod determine-encoder (path) (let ((e (str:remove-punctuation (with-output-to-string (s) (run `(ffprobe -v error -select_streams "v:0" -show_entries stream=codec_name -of "default=nokey=1:noprint_wrappers=1" ,(p-as-str path)) :output s :error-output s))))) (get-encoder e))) (defmethod report-video (video) (with-slots (name size path dir encoder) video (log:info "Name: ~A" (name name)) (log:info "Ext: ~A" (extension name)) (log:info "Directory: ~A" dir) (log:info "Encoder: ~A" encoder) (log:info "Type: ~A" (type-of video)))) (defmethod determine-conversion-steps ((video already-converted)) ()) (defmethod determine-conversion-steps ((video video)) (with-slots (name encoder) video (append (determine-name-conversion name) (determine-encoding-conversion encoder)))) (defmethod determine-name-conversion ((name name)) (with-slots (signature extension) name (list :signature t ;;(not (known-signature-p signature)) :extension t)));;(not (current-extension-p extension))))) (defmethod determine-encoding-conversion ((encoder encoder)) (list :encoder t)) (defun perform-conversion (video) (let ((steps (determine-conversion-steps video))) (when steps (alexandria:doplist (key val steps) (when val (start-conversion key video)))))) (defmethod start-conversion :before ((key (eql :signature)) (video video)) (unless (slot-boundp video 'new-name) (setf (new-name video) (make-blank-name)))) (defmethod start-conversion :before ((key (eql :extension)) (video video)) (unless (slot-boundp video 'new-name) (setf (new-name video) (make-blank-name)))) (defmethod start-conversion ((key (eql :signature)) (video video)) t);;this is handled automatically by the :before method. (defmethod start-conversion ((key (eql :extension)) (video video)) t) (defmethod start-conversion :after ((key (eql :signature)) (video video)) (unless (slot-boundp (new-name video) 'name) (setf (name (new-name video)) (clean-name (name (name video)))))) (defmethod start-conversion :after ((key (eql :extension)) (video video)) (unless (slot-boundp (new-name video) 'name) (setf (name (new-name video)) (clean-name (name (name video)))))) (defun changed-container-p (n1 n2) (string/= (as-string (extension n1)) (as-string (extension n2)))) (defmethod start-conversion :before ((key (eql :encoder)) (video video)) (unless (slot-boundp video 'new-name) (setf (new-name video) (name video)))) (defmethod start-conversion ((key (eql :encoder)) (video video)) (setf (ffmpeg-args video) (generate-ffmpeg (encoder video) *wanted-encoder* (extension (name video)) (extension (new-name video)) video))) (defmethod export-name ((name name)) (format nil "~(~A-~A.~A~)" (name name) (as-string (signature name)) (as-string (extension name)))) (defmethod export-path ((video video)) (let ((name (export-name (new-name video)))) (format nil "~A~A" (dir video) name))) (defmethod export-path ((video already-converted)) (path video)) (defun clean-name (str) (string-downcase (str:remove-punctuation str :replacement "-"))) (defun p-as-str (p) (format nil "~A" p)) (defgeneric generate-ffmpeg (current-encoder wanted-encoder current-extension wanted-extension video)) (defmethod generate-ffmpeg ((c-enc encoder) (w-enc av1) (c-con extension) (w-con mp4) video) ;;in this case we are exporting to vp1 (with-accessors ((name name) (dir dir) (path path)) video `((ffmpeg -y -hide_banner -hwaccel vdpau -i ,(p-as-str path) -vcodec "libsvtav1" -pass 1 -passlogfile ,(name name) -an -f null "/dev/null") (ffmpeg -y -hide_banner -hwaccel vdpau -i ,(p-as-str path) -passlogfile ,(name name) -max_muxing_queue_size "20000" -metadata ,(format nil "comment='~A'" *comment*) -metadata ,(format nil "description='~A'" *description*) -vcodec "libsvtav1" -pass 2 -preset 8 ,(format nil "~Atmp.~A" (dir video) (as-string w-con)))))) (defmethod generate-ffmpeg ((c-enc av1) (w-enc av1) (c-con mp4) (w-con mp4) video) ;;in this case we dont have to do anything nil) (defmethod generate-ffmpeg ((c-enc av1) (w-enc av1) (c-con extension) (w-con mp4) video) "This is already av1 but has a different extension so we just copy the codec but change the container to the wanted container." (with-accessors ((path path) (dir dir)) video `((ffmpeg -y -hide_banner -i ,(p-as-str path) -vcodec copy -metadata ,(format nil "comment='~A'" *comment*) -metadata ,(format nil "description='~A'" *description*) ,(format nil "~Atmp.~A" (dir video) (as-string w-con)))))) (defmethod generate-ffmpeg ((c-enc encoder) (w-enc h264) (c-con extension) (w-con mp4) video) (with-accessors ((path path) (dir dir)) video `((ffmpeg -y -hide_banner -i ,(p-as-str path) -vcodec libx264 -preset fast -acodec copy -metadata ,(format nil "comment='~A'" *comment*) -metadata ,(format nil "description='~A'" *description*) ,(format nil "~Atmp.~A" (dir video) (as-string w-con)))))) (defmethod generate-ffmpeg ((c-enc h264) (w-enc h264) (c-con extension) (w-con mp4) video) (with-accessors ((path path) (dir dir)) video `((ffmpeg -y -hide_banner -i ,(p-as-str path) -vcodec copy -acodec copy -metadata ,(format nil "comment='~A'" *comment*) -metadata ,(format nil "description='~A'" *description*) ,(format nil "~Atmp.~A" (dir video) (as-string w-con)))))) (defmethod remove-old ((video video)) (log:info "Removing old video") (delete-file (path video))) (defmethod convert ((video already-converted)) (log:info "Already converted.")) (defmethod clean-log ((video video)) (let* ((name (new-name video)) (log-name (format nil "~A-0.log" (name name))) (path (format nil "~A~A" (dir video) log-name))) (when (probe-file path) (delete-file path)))) (defmethod convert :around ((video video)) (restart-case (call-next-method) (clean-log-and-skip (c) (log:fatal c) (clean-log video)))) (defmethod convert ((video video)) (if (ffmpeg-args video) (progn (mapc #'run (ffmpeg-args video)) (remove-old video) (rename-file (format nil "~Atmp.~A" (dir video) (as-string (extension (new-name video)))) (export-path video)) (clean-log video)) (progn (log:info "No ffmpeg required. Renaming!") (rename-file (path video) (export-path video))))) (defmethod convert :after ((video video)) (let ((size (file-size (export-path video)))) (setf (final-size video) size) (log:info "Start size: ~4,2fMB" (size video)) (log:info "Final size: ~4,2fMB" size) (log:info "~4,2f% of original size" (* (/ size (size video)) 100)))) (defmethod convert :before ((video video)) (perform-conversion video)) (exporting-definitions (defun convert-video (path) ;;currently we won't determine if a file is ready to convert (handler-bind ((uiop:subprocess-error (lambda (c) (cond ((find-restart 'clean-log-and-skip c) (invoke-restart 'clean-log-and-skip c)) ((find-restart 'skip) (invoke-restart 'skip c))))) (file-not-a-video (lambda (c) (log:error "~A" c) (invoke-restart 'skip c)))) (restart-case (progn (convert (new-video (format nil "~A~A" (uiop:getcwd) path))) '|Done|) (skip (c) :report "Skip?" (declare (ignore c)) nil)))) (defun convert-all () (let* ((paths (uiop:directory-files (uiop:getcwd)))) (loop :for name :in paths :do (convert-video (file-namestring name))) '|Done|)) ) (register-commands :scripts/video-conversion)
Raw
Annotate
Repaste
Edit