;;; my-media-segment.el -- Media segmentation utility -*- lexical-binding: t -*- ;; Copyright (C) 2023 Free Software Foundation. ;; Author: Yuchen Pei ;; Package-Requires: ((emacs "28.2")) ;; This file is part of dotfiles. ;; dotfiles is free software: you can redistribute it and/or modify it under ;; the terms of the GNU Affero General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; dotfiles is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General ;; Public License for more details. ;; You should have received a copy of the GNU Affero General Public ;; License along with dotfiles. If not, see . ;;; Commentary: ;; Media segmentation utility. ;;; Code: ;;; A utility using ffmpeg to cut a media file into smaller ones, from a ;;; description of the timestamps. (defvar my-media-segment-queued-jobs nil) (defvar my-media-segment-max-inflight 3) (defun my-media-segment-enqueue-process (start-process-function) "Enqueue a process that can started by applying 'start-process'. The process can be started by applying 'start-process' on START-PROCESS-ARGS." ;; somehow only this version works, but not nconc or setq with append ;; the problem with the other two is that the operation gets stuck after the ;; initial 'my-media-segment-max-inflight' operations. (add-to-list 'my-media-segment-queued-jobs start-process-function) ;; (nconc my-media-segment-queued-jobs (list start-process-function)) ;; (setq my-media-segment-queued-jobs ;; (append my-media-segment-queued-jobs (list start-process-function))) ) (defun my-media-segment-dequeue-process () (when my-media-segment-queued-jobs (funcall (pop my-media-segment-queued-jobs)))) (defun my-ffmpeg-split-file (file-name split-at) "Split FILE-NAME at SPLIT-AT into two files." (let* ((name-no-ext (file-name-sans-extension file-name)) (ext (file-name-extension file-name)) (file-name-1 (make-temp-file (format "%s-1-" name-no-ext) nil (format ".%s" ext))) (file-name-2 (make-temp-file (format "%s-2-" name-no-ext) nil (format ".%s" ext)))) (message "Splitting %s at %s into %s and %s..." file-name split-at file-name-1 file-name-2) (set-process-sentinel (start-process (format "ffmpeg-%s" file-name) (format "*ffmpeg-%s*" file-name) "ffmpeg" "-i" file-name "-to" split-at "-c" "copy" file-name-1 "-ss" split-at "-c" "copy" file-name-2 "-y") (lambda (proc event) (let ((status (process-exit-status proc))) (if (eq status 0) (progn (message "Splitting %s at %s into %s and %s... Done" file-name split-at file-name-1 file-name-2)) (message "Splitting %s at %s into %s and %s... Failed: %s" file-name split-at file-name-1 file-name-2 event))))))) (defun my-dired-do-ffmpeg-split-file () (interactive) (seq-do (lambda (file) (my-ffmpeg-split-file file (read-string (format "Split %s at: " file)))) (dired-get-marked-files))) (defun my-segment-media-file-2 (media-file-name info-file-name) "Run ffmpeg to segment MEDIA-FILE-NAME according to INFO-FILE-NAME in one go. Much faster than my-segment-media-file or my-segment-media-file-1." (interactive (list (read-file-name "Choose media file: ") (read-file-name "Choose description file (.info.json or .description): "))) (let* ((dir (file-name-sans-extension (expand-file-name media-file-name))) (info (my-get-media-segments info-file-name)) (total (length info)) (pad (1+ (floor (log10 total)))) (idx 0) (args `("-i" ,(expand-file-name media-file-name)))) (ignore-errors (dired-create-directory dir)) (dolist (media info) (setq idx (1+ idx)) (let* ((title (plist-get media :title)) (start (plist-get media :start)) (end (plist-get media :end))) (setq args (append args `("-ss" ,start) (when end `("-to" ,end)) `("-c" "copy" ,(format (format "%%s/%%0%dd-%%s.%%s" pad) dir idx title (file-name-extension media-file-name))))) (message "Will cut %s-%s to %s (%d/%d)..." start (or end "") title idx total))) (set-process-sentinel (apply 'start-process (append `(,(format "ffmpeg-%s" media-file-name) ,(format "*ffmpeg-%s*" media-file-name) "ffmpeg") args)) (lambda (proc event) (let ((status (process-exit-status proc))) (if (eq status 0) (progn (message "Cutting %s: All DONE" media-file-name)) (message "Cutting %s FAILED: %s" media-file-name event))))))) (defun my-segment-media-file-1 (media-file-name info-file-name) "Run ffmpeg asynchronously to segment file-name according to description. Uses `my-media-segment-max-inflight' to limit number of inflight tasks." (interactive (list (read-file-name "Choose media file: ") (read-file-name "Choose description file (.info.json or .description): " ;; nil ;; (file-name-with-extension media-file-name ".info.json") ;; t ))) (let* ((dir (file-name-sans-extension (expand-file-name media-file-name))) (info (my-get-media-segments info-file-name)) (total (length info)) (pad (1+ (floor (log10 total)))) (idx 0) (thunk)) (dolist (media info) (setq idx (1+ idx)) (ignore-errors (dired-create-directory dir)) (let* ((title (plist-get media :title)) (start (plist-get media :start)) (end (plist-get media :end)) (args (append (list "-ss" start) (when end (list "-to" end)) (list "-i" (expand-file-name media-file-name) (format (format "%%s/%%0%dd-%%s.%%s" pad) dir idx title (file-name-extension media-file-name)))))) (setq thunk (lambda () (message "Cutting %s-%s to %s (%d/%d)..." start (or end "") title idx total) (set-process-sentinel (apply 'start-process (append (list (format "ffmpeg-%s" title) (format "*ffmpeg-%s*" title) "ffmpeg") args)) (lambda (_ _) (my-media-segment-dequeue-process))))) (if (<= idx my-media-segment-max-inflight) (funcall thunk) (my-media-segment-enqueue-process thunk)))))) (defun my-get-media-segments (info-file-name) (if (equal (file-name-extension info-file-name) "json") (my-get-media-segments-from-json info-file-name) (my-get-media-segments-from-descr info-file-name))) (defun my-get-media-segments-from-json (json-file-name) (let ((info (with-temp-buffer (insert-file-contents json-file-name) (goto-char (point-min)) (json-read)))) (seq-map (lambda (ch) (let-alist ch (list :title (my-make-filename .title) :start (format "%s" .start_time) :end (format "%s" .end_time)))) (alist-get 'chapters info)))) (defun my-get-media-segments-from-descr (descr-file-name) "Output title start end triplets." (let ((results) (title) (start) (end)) (with-temp-buffer (insert-file-contents descr-file-name) (goto-char (point-min)) (save-excursion (while (re-search-forward "\\(\\(?:[0-9]+:\\)?[0-9]+:[0-9]\\{2\\}\\)\\(?:[[:space:]]*-[[:space:]]*\\(\\(?:[0-9]+:\\)?[0-9]+:[0-9]\\{2\\}\\)\\)?" nil t) (setq start (match-string-no-properties 1) end (match-string-no-properties 2)) (replace-match "") (beginning-of-line 1) (setq title (replace-regexp-in-string "^[[:punct:][:space:]]*" "" (replace-regexp-in-string "[[:punct:][:space:]]*$" "" (buffer-substring-no-properties (point) (progn (beginning-of-line 2) (point)))))) (push (list :title (my-make-filename title) :start start :end end) results) ) (setq end nil) (dolist (result results) (unless (plist-get result :end) (plist-put result :end end) (setq end (plist-get result :start)))) (reverse results)) ))) (defvar my-segment-media-max-async 10) (defun my-segment-media-file (media-file-name info-file-name synchronously) "Run ffmpeg asynchronously to segment file-name according to description. With a prefix-arg, run synchronously." (interactive (list (read-file-name "Choose media file: ") (read-file-name "Choose info file: ") current-prefix-arg)) (let* ((dir (file-name-sans-extension (expand-file-name media-file-name))) (info (my-get-media-segments info-file-name)) (total (length info)) (idx 0)) (when (or synchronously (<= total my-segment-media-max-async) (let ((choice (car (read-multiple-choice (format "Recognised many (%d) segments, continue asynchronously?" total) '((?y "yes") (?s "synchronously instead") (?n "cancel")))))) (cond ((eq choice ?y) t) ((eq choice ?s) (setq synchronously t)) (t nil)))) (dolist (media info) (setq idx (1+ idx)) (ignore-errors (dired-create-directory dir)) (let* ((title (plist-get media :title)) (start (plist-get media :start)) (end (plist-get media :end)) (args (append (list "-ss" start) (when end (list "-to" end)) (list "-i" (expand-file-name media-file-name) (format "%s/%s.%s" dir title (file-name-extension media-file-name)))))) (message "Cutting %s-%s to %s (%d/%d)..." start (or end "") title idx total) (if synchronously (apply 'call-process (append (list "ffmpeg" nil "*ffmpeg*" t) args)) (apply 'start-process (append (list (format "ffmpeg-%s" title) (format "*ffmpeg-%s*" title) "ffmpeg") args))))) (when synchronously (message "All %d segments splitted into %s" (length info) dir))))) (provide 'my-media-segment) ;;; my-media-segment.el ends here