From 37a2c8df05b2493cf6fc00e11711c3276c671e5f Mon Sep 17 00:00:00 2001 From: Leo Butler Date: Sun, 28 Jun 2020 17:33:41 -0500 Subject: [PATCH] a guile scheme re-implementation -use the concat filter rather than segment+concat muxers -currently, do not create a separate subtitle stream from closed captions -ffmpeg-myth-do-pending-jobs will look up recordings with a cutlist and run the transcoder (ffmpeg-myth-cut) over each --- ffmpeg-myth.scm | 455 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 455 insertions(+) create mode 100755 ffmpeg-myth.scm diff --git a/ffmpeg-myth.scm b/ffmpeg-myth.scm new file mode 100755 index 0000000..73872d3 --- /dev/null +++ b/ffmpeg-myth.scm @@ -0,0 +1,455 @@ +#!/usr/bin/guile \ +-e ffmpeg-myth -s +!# +;;-*- geiser-scheme-implementation: guile -*- +;;-*- coding: utf-8 -*- + +(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 popen)) +(use-modules (srfi srfi-1)) +(use-modules (srfi srfi-9 gnu)) +(use-modules ((rnrs) :version (6))) +;;(use-modules ((guile json))) + +(define mysql-cnf "~/my.cnf") +(define mysql-bin "mysql") +(define mythtv-db "mythconverg") +(define mysql-row-sep #\newline) +(define mysql-col-sep #\tab) +(define ffmpeg-bin "/usr/local/bin/ffmpeg") +(define ffprobe-bin "/usr/local/bin/ffprobe") +(define recordings-directory "/var/lib/mythtv/recordings") +(define working-directory "/mnt/lvraid5/ffmpeg-cut-list.d") +(define mythtv-recorded-table->metadata-list '(chanid starttime endtime title subtitle description season episode recordid seriesid programid inetref previouslyshown originalairdate)) +(define (mythconverg-input-file-name) + (string-copy (string-join (list working-directory "ffmpeg-mythconverg.XXXXXX") "/"))) +(define shell-command-log #t) + +(define (roundx x) (inexact->exact (round x))) + +(define* (shell-command-to-string* cmd args) + (let* ((port (apply open-pipe* (append (list OPEN_READ cmd) args))) + (str (read-string port))) + (close port) + str)) + +(define* (shell-command-to-string cmd) + (cond (shell-command-log + (simple-format #t "shell-command-to-string: ~a\n" cmd) (force-output))) + (catch 'shell-command-error + ;; thunk + (lambda () + (let* ((port (open-pipe cmd OPEN_READ)) + (str (read-string port)) + (wtpd (close-pipe port)) + (xval (status:exit-val wtpd))) + (if (or (eqv? xval #f) (> xval 0)) (throw 'shell-command-error cmd str)) + str)) + ;; handler + (lambda (key cmd str) + (simple-format #t "ERROR: in command ~a\nstring: ~a\n" cmd str)))) + +(define (mysql-escape-quote str) + ;; (string-join (string-split str #\') "'\"'\"'")) + (string-join (string-split str #\') "\"")) +(define (mythconverg-execute0 statement) + (shell-command-to-string (simple-format #f "~a --defaults-file=~a --database=~a --execute='~a'" mysql-bin mysql-cnf mythtv-db (mysql-escape-quote statement)))) +(define (mythconverg-source file) + (mythconverg-execute0 (simple-format #f "source ~a" file))) +(define (mythconverg-execute statement) + (cond ((< (string-length statement) 1024) ;; really could use < ARG_MAX (see getconf ARG_MAX) + (mythconverg-execute0 statement)) + (#t + (let* ((port (mkstemp! (mythconverg-input-file-name))) + (tmpfile (port-filename port))) + (simple-format port statement) (force-output port) (close-port port) + (mythconverg-source tmpfile) + tmpfile)))) + +(define mysql-cmd "") +(define (mysql-start-transaction cmd) + (set! mysql-cmd (simple-format #f "start transaction; ~a" cmd))) +(define (mysql-continue cmd) + (set! mysql-cmd (simple-format #f "~a ~a" mysql-cmd cmd))) +(define (mysql-commit cmd) + (set! mysql-cmd (simple-format #f "~a ~a commit;" mysql-cmd cmd))) + + + +(define (elt n l) + (let ((n* (if (>= n 0) n (+ (length l) n)))) + (car (drop l n*)))) +(define (read-from-string s) + (cond ((string? s) + (let ((r (with-input-from-string s read))) + (cond ((eof-object? r) s) + ((not (symbol? r)) r) + ((string= s (simple-format #f "~a" r)) + r) + (#t s)))) + ((list? s) + (map read-from-string s)) + (#t + (error "read-from-string" "encountered a not list/string")))) +(define (dsv-splitter s d) + (cond ((string? s) + (string-split s d)) + ((list? s) + (map (lambda(x) (dsv-splitter x d)) s)) + (#t + (error "dsv-splitter" "encountered a not list/string")))) +(define* (csv-parser s #:optional (r #f)) + (let ((l (dsv-splitter (delete "" (dsv-splitter s #\newline)) #\page))) ;; #\page = + (if r (read-from-string l) l))) +(define (k-v-parser s) + (read-from-string (dsv-splitter s #\=))) +(define (make-dotted-alist s) + (cond ((and (list? s) (= 2 (length s)) (symbol? (car s))) + (cons (car s) (cadr s))) + ((and (list? s) (> (length s) 2)) + (map make-dotted-alist s)) + (#t s))) + + + +(define (mysql-parse-row r) + (map read-from-string (string-split r mysql-col-sep))) +(define (mysql-parse-output s) + (map mysql-parse-row (drop-right (string-split s mysql-row-sep) 1))) +(define (mythconverg-execute+parse statement) + (mysql-parse-output (mythconverg-execute statement))) + + + +(define (mythconverg-select* table chanid starttime) + (mythconverg-execute+parse (simple-format #f "select * from ~a where chanid=~a and starttime=~a;" table chanid starttime))) +(define (mythconverg-get-recorded chanid starttime) + (apply (lambda(l1 l2) (map cons l1 l2)) (mythconverg-select* "recorded" chanid starttime))) +(define (mythconverg-get-recordedmarkup chanid starttime) + (map (lambda(x) (drop x 2)) (mythconverg-select* "recordedmarkup" chanid starttime))) + + + +(define (ffprobe-video-packets file filter-rule) + (let ((frame-info (csv-parser + (shell-command-to-string (simple-format #f "~a -v error -select_streams v:0 -show_entries frame=pkt_pts_time,pkt_pos,pict_type,coded_picture_number,interlaced_frame:side_data=nil -print_format csv=nokey=1:print_section=0:s=' ' -i '~a'" ffprobe-bin file))))) + (read-from-string (filter filter-rule frame-info)))) +(define (ffprobe-i-frames file) + (ffprobe-video-packets file (lambda(l) (string=? "I" (third l))))) + +(define (ffprobe-stream-info file) + (let* ((stream-info (shell-command-to-string (simple-format #f "~a -v error -show_streams -print_format csv=nokey=0:s=' ' -i '~a'" ffprobe-bin file)))) + (map make-dotted-alist (k-v-parser (csv-parser stream-info))))) + +;; (define (mythutil-get-cut/skip-list chanid starttime cut-or-skip) +;; (let ((drop (if (eq? cut-or-skip 'skip) 22 9)) +;; (lst (shell-command-to-string (simple-format #f "mythutil --quiet --get~alist --chanid ~a --starttime ~a" cut-or-skip chanid starttime)))) +;; (cond ((> (string-length lst) drop) +;; (read-from-string +;; (map (lambda (s) (string-split s #\-)) +;; (string-split +;; (string-drop-right (string-drop lst drop) 1) +;; #\,)))) +;; (#t +;; (error (simple-format #f "mythutil-get-cut/skip-list: mythutil returned '~a'\n" lst)))))) + +;; (define (mythutil-get-retention-list cs) +;; ;; if the first cut does not start at frame 0, add a pseudo cut +;; (let* ((l (if (eq? (caar cs) 0) cs (append (list (list 0 0)) cs)))) +;; (define (f x a) +;; ;;(simple-format #t "x=~a\n" x) +;; (if (or (null? x) (null? (cdr x))) +;; a +;; (f (cdr x) (append (list (list (cadar x) (caadr x))) a)))) +;; (cond ((= (length l) 1) +;; (list (list (cadar l) 'infinity))) +;; (#t +;; (reverse (f l '())))))) + + +(define (mysql-get-cut/skip-list chanid starttime cut-or-skip) + (let* ((s-e (if (eq? cut-or-skip 'cut) '(1 . 0) '(4 . 5))) + (s (mythconverg-execute+parse (simple-format #f "select mark,type from recordedmarkup where chanid=~a and starttime=~a and (type=~a or type=~a) order by mark;" chanid starttime (car s-e) (cdr s-e)))) + (f (mythconverg-execute+parse (simple-format #f "select data from recordedmarkup where chanid=~a and starttime=~a and type=34;" chanid starttime)))) + (list (if (null? s) s (cdr s)) (if (null? f) f (cdr f))))) + +(define (mythtv-make-concat-list s f) + (let* ((mark first) (type second) + (start-of-cut? (lambda(x) (or (eq? x 1) (eq? x 4)))) + (end-of-cut? (lambda(x) (or (eq? x 0) (eq? x 5)))) + (start 1) (end 0)) + (define (cl l acc) + (if (null? l) (reverse acc) + (cond ((end-of-cut? (cdar l)) + (cl (cddr l) (append (list (cons (caar l) (caadr l))) acc))) + (#t + (cl (cdr l) acc))))) + (if (start-of-cut? (cadar s)) + (set! s (append '((0 0)) s))) + (if (end-of-cut? (cadr (last s))) + (set! s (append s (list (list (if (null? f) (greatest-fixnum) (caar f)) 1))))) + (set! s (map (lambda(x) (if (start-of-cut? (cadr x)) (cons (car x) start) (cons (car x) end))) + s)) + (cl s '()))) + +(define (mythtv-get-retention-list chanid starttime cut-or-skip) + (apply mythtv-make-concat-list (mysql-get-cut/skip-list chanid starttime cut-or-skip))) + +(define (mythtv-find-nearest-i-frame-before/after idx frame-info i test i-frame) + (cond ((null? frame-info) i-frame) + (#t + (let ((cpn (fourth (car frame-info)))) + (if (test cpn idx) i-frame (mythtv-find-nearest-i-frame-before/after idx (cdr frame-info) cpn test(car frame-info))))))) +(define (mythtv-find-nearest-i-frame-before idx frame-info i) + (mythtv-find-nearest-i-frame-before/after idx frame-info i >= '())) +(define (mythtv-find-nearest-i-frame-after idx frame-info i) + (mythtv-find-nearest-i-frame-before/after idx (reverse frame-info) i <= '())) + +(define-immutable-record-type recording + (make-recording chanid starttime recorded-table streams-info i-frame-info retain-list) + recording? + (chanid recording-chanid set-recording-chanid!) + (starttime recording-starttime set-recording-starttime!) + (recorded-table recording-recorded-table set-recording-recorded-table!) + (streams-info recording-streams-info set-recording-streams-info!) + (i-frame-info recording-i-frame-info set-recording-i-frame-info!) + (retain-list recording-retain-list set-recording-retain-list!)) + +;; make a readable printer for the recording record +(define* (recording-printer rec #:optional (port #t)) + (define (rec-printer fg) + (let ((field (car fg)) (getter (cdr fg))) + (simple-format port "(~s . ~s)\n" field (getter rec)))) + (let ((fields+getters (list + (cons 'chanid recording-chanid) + (cons 'starttime recording-starttime) + (cons 'recorded-table recording-recorded-table) + (cons 'streams-info recording-streams-info) + (cons 'i-frame-info recording-i-frame-info) + (cons 'retain-list recording-retain-list)))) + (simple-format port "'(") + (map rec-printer fields+getters) + (simple-format port ")\n"))) + +(set-record-type-printer! recording recording-printer) + +(define (create-record-data chanid starttime cut-or-skip) + (let* ((rec-tbl (mythconverg-get-recorded chanid starttime)) + (recmkp-tbl (mythconverg-get-recordedmarkup chanid starttime)) + (input-file (simple-format #f "~a/~a" recordings-directory (assv-ref rec-tbl 'basename))) + (strms-inf (ffprobe-stream-info input-file)) + (i-frm-nfo (ffprobe-i-frames input-file)) + (rtn-lst (mythtv-get-retention-list chanid starttime cut-or-skip))) + (make-recording chanid starttime rec-tbl strms-inf i-frm-nfo rtn-lst))) + +(define (re-create-record-data r-d) + (let ((lookup (lambda (key) (assv-ref r-d key)))) + (apply make-recording (map lookup '(chanid starttime recorded-table streams-info i-frame-info retain-list))))) + +(define recording-file-endings3 '("mpg" "mp4" "mkv")) +(define recording-file-endings2 '("ts")) +(define transcoded-file-ending "mkv") + +(define (recording-basename rec) + (assv-ref (recording-recorded-table rec) 'basename)) + +(define (recording-new-file-name file-name ending) + (let* ((old-ending (substring file-name (- (string-length file-name) 3))) + (n (- (string-length file-name) (if (string=? old-ending ".ts") 3 4)))) + (simple-format #f "~a.~a" (substring file-name 0 n) ending))) + +(define* (create-record-data-for-transcode rec) + (let* ((rtn-list '()) + (tr-rec rec) + (rec-tbl (copy-tree (recording-recorded-table tr-rec))) + (basename (recording-basename tr-rec)) + (tr-basename (recording-new-file-name basename transcoded-file-ending)) + (input-file (simple-format #f "~a/~a" recordings-directory basename)) + (input-tr-file (simple-format #f "~a/~a" working-directory tr-basename)) + (tr-filesize (stat:size (stat input-tr-file))) + (strms-inf (ffprobe-stream-info input-tr-file)) + (i-frm-nfo (ffprobe-i-frames input-tr-file))) + (set! rec-tbl (assv-set! rec-tbl 'basename tr-basename)) + (set! rec-tbl (assv-set! rec-tbl 'filesize tr-filesize)) + (set-fields tr-rec ((recording-recorded-table) rec-tbl) + ((recording-streams-info) strms-inf) + ((recording-i-frame-info) i-frm-nfo) + ((recording-retain-list) rtn-list)))) + + ;; (define (ffmpeg-split+retain-recording rec) + ;; (let* ((basename (recording-basename rec)) + ;; (rootname+ext (string-split basename #\.)) + ;; (rootname (car rootname+ext)) (ext (cadr rootname+ext)) + ;; (in-file (simple-format #f "~a/~a" recordings-directory basename)) + ;; (out-file (simple-format #f "~a/~a.mkv" working-directory rootname)) + ;; (out-ffconcat (simple-format #f "~a/~a.ffconcat" working-directory rootname)) + ;; (frames-list (string-join (map (lambda(x)(simple-format #f "~a,~a" (car x)(cdr x))) (recording-retain-list rec)) "," 'infix)) + ;; (out-file-tmp (simple-format #f "~a/~a_%05d.~a" working-directory rootname ext)) + ;; (ffmpeg-cut (simple-format #f "ffmpeg -fflags '+genpts' -ignore_unknown -y -i \"~a\" -codec copy -map 0 -map -0:d -f segment -segment_list \"~a\" -segment_frames \"~a\" \"~a\"" in-file out-ffconcat frames-list out-file-tmp))) + ;; (shell-command-to-string ffmpeg-cut))) + +(define (myth-convert-i-frame-indices-to-times indices i-frame-info) + ;; index = ((a . b) ... ) + (let* ((start_time (caar i-frame-info)) + (normalize-times (lambda (l) + (cons (- (car l) start_time) (- (cdr l) start_time))))) + (define (m-c-i-f-i-t-t indices times) + (cond ((null? indices) times) + (#t + (m-c-i-f-i-t-t (cdr indices) + (append times + (list (cons (car (mythtv-find-nearest-i-frame-after (caar indices) i-frame-info 0)) (car (mythtv-find-nearest-i-frame-before (cdar indices) i-frame-info 0))))))))) + (map normalize-times (m-c-i-f-i-t-t indices '())))) + +(define (mythtv-recorded-table->metadata rec) + (let* ((r-t (recording-recorded-table rec)) + (m-d (map (lambda (x) (assv x r-t)) mythtv-recorded-table->metadata-list)) + (sanitize (lambda (s) (if (string? s) (string-delete (lambda(c) (or (eqv? c #\") (eqv? c #\'))) s) s)))) + (string-join (map (lambda (x) (simple-format #f "-metadata \"~a=~a\"" (car x) (sanitize (cdr x)))) m-d) " "))) + +(define* (ffmpeg-filter-streams streams-info #:optional (max 2) (filter-lst '(video audio))) + (let* ((codec-type (lambda (x) (assv-ref x 'codec_type) )) + (filter-fn (lambda(x) (memq (codec-type x) filter-lst)))) + (define (sorter l) + (stable-sort l (lambda (a b) (string> (symbol->string (codec-type a)) (symbol->string (codec-type b)))))) + (define (selector l max acc) + (cond ((or (= max 0) (null? l)) acc) (#t (selector (cdr l) (- max 1) (append acc (list (car l))))))) + (selector (sorter (filter filter-fn streams-info)) max '()))) + +(define (ffmpeg-outstreams-templates rec max-streams) + (let* ((streams-info (ffmpeg-filter-streams (recording-streams-info rec) max-streams)) + (s-i (map (lambda (x) (cons (substring (symbol->string (assv-ref x 'codec_type)) 0 1) (assv-ref x 'index))) streams-info)) + (concat-template (map (lambda(s) (simple-format #f "[~~a:~a]" (cdr s))) s-i)) + (i -1) (j -1) + (output-template (map (lambda(x) (set! j (+ 1 j)) (simple-format #f "[out~a]" j)) streams-info))) + (cons + (lambda(x) (set! i (+ 1 i)) (string-join (map (lambda(f) (simple-format #f f i)) concat-template) " ")) + output-template))) + +(define* (ffmpeg-split+transcode-recording rec #:optional (max-streams 4)) + (let* ((basename (recording-basename rec)) + (rootname+ext (string-split basename #\.)) + (rootname (car rootname+ext)) (ext (cadr rootname+ext)) + (in-file (simple-format #f "~a/~a" recordings-directory basename)) + (out-file (simple-format #f "~a/~a.~a" working-directory rootname transcoded-file-ending)) + (m-d (mythtv-recorded-table->metadata rec)) + (cut-times (myth-convert-i-frame-indices-to-times (recording-retain-list rec) (recording-i-frame-info rec))) + (seek-fn (lambda(c) (simple-format #f " -ss ~a -to ~a -i '~a'" (car c) (cdr c) in-file))) + (concat-info (ffmpeg-outstreams-templates rec max-streams)) + (instreams (string-join (map (car concat-info) cut-times) " ")) + (outstreams (cdr concat-info)) + (mappings (map (lambda (x) (simple-format #f " -map '~a'" x)) outstreams)) + (cmd (simple-format #f "~a -y ~a -filter_complex '~a concat=n=~a:v=1:a=~a ~a' -preset slow -crf 21 -c:a ac3 -g 60 -keyint_min 30 ~a ~a ~a" ffmpeg-bin (string-join (map seek-fn cut-times)) instreams (length cut-times) (- (length outstreams) 1) (string-join outstreams) (string-join mappings) m-d out-file))) + (shell-command-to-string cmd) + cmd)) + +(define (mythconverg-update-recorded-seek-table rec) + (let* ((i-frm-nfo (recording-i-frame-info rec)) + (start_pts (caar i-frm-nfo)) + (chanid (recording-chanid rec)) + (starttime (recording-starttime rec)) + (start-time (assv-ref (recording-recorded-table rec) 'starttime))) + (define (type-9/33-marks l acc) + (cond ((null? l) acc) + ;; for some reason, ffmpeg's i-frame # is 2 less than that mythtv reports + ;; after frame 0 + ;; (i-frame offset time) + ((null? acc) + (type-9/33-marks (cdr l) (list (list (fourth (car l)) (second (car l)) (inexact->exact (round (* (- (first (car l)) start_pts) 1000))))))) + (#t + (type-9/33-marks (cdr l) (append acc (list (list (+ 2 (fourth (car l))) (second (car l)) (inexact->exact (round (* (- (first (car l)) start_pts) 1000)))))))))) + (define (printer* tpe x) + (simple-format #f "insert into recordedseek (chanid,starttime,mark,offset,type) values (~a,~a,~a,~a,~a);\n" chanid starttime (car x) (if (= tpe 9) (cadr x) (caddr x)) tpe)) + (define (printer9 x) (printer* 9 x)) + (define (printer33 x) (printer* 33 x)) + (let* ((marks (type-9/33-marks i-frm-nfo '())) + (delete-recseek (simple-format #f "delete from recordedseek where chanid=~a and starttime=~a and (type=9 or type=33);\n" chanid starttime)) + (insert-9 (string-join (map printer9 marks))) + (insert-33 (string-join (map printer33 marks)))) + (mysql-continue (string-join (list delete-recseek insert-9 insert-33)))))) + +(define (HH:MM:SS.x->milliseconds t) + (let ((tm (read-from-string (string-split t #\:)))) + (roundx (* 1000 (+ (* 3600 (first tm)) (* 60 (second tm)) (third tm)))))) +(define (mythconverg-recordedmarkup-type34 rec) + (fourth (last (recording-i-frame-info rec)))) +(define (mythconverg-recordedmarkup-type33 rec) + (let* ((vid (car (filter (lambda(l) (eq? (assq-ref l 'codec_type) 'video)) (recording-streams-info rec)))) + (dur0 (assq-ref vid 'duration)) + (dur1 (assq-ref vid 'tag:DURATION))) + (cond ((number? dur0) (roundx (* 1000 dur0))) + ((string? dur1) (HH:MM:SS.x->milliseconds dur1)) + (#t 0)))) +(define (mythconverg-update-recordedmarkup-table rec) + (let* ((chanid (recording-chanid rec)) + (starttime (recording-starttime rec)) + (last-i-frame (mythconverg-recordedmarkup-type34 rec)) + (duration (mythconverg-recordedmarkup-type33 rec))) + (mysql-continue (simple-format #f "delete from ltbrecordedmarkup where chanid=~a and starttime=~a; insert into ltbrecordedmarkup (chanid,starttime,mark,type,data) select * from recordedmarkup where chanid=~a and starttime=~a and type>=0; delete from recordedmarkup where chanid=~a and starttime=~a and (type<=5 or type>=33); insert into recordedmarkup (chanid,starttime,mark,type,data) values (~a,~a,0,34,~a); insert into recordedmarkup (chanid,starttime,mark,type,data) values (~a,~a,0,33,~a);" chanid starttime chanid starttime chanid starttime chanid starttime last-i-frame chanid starttime duration)))) + + +(define* (mythconverg-update-recorded-table rec tr-rec #:optional (mv? #t)) + (let* ((chanid (recording-chanid rec)) + (starttime (recording-starttime rec)) + (basename (recording-basename rec)) + (tr-basename (recording-basename tr-rec)) + (input-file (simple-format #f "~a/~a" recordings-directory basename)) + (input-tr-file (simple-format #f "~a/~a" working-directory tr-basename)) + (tr-filesize (assv-ref (recording-recorded-table tr-rec) 'filesize))) + ;; change timestamp on transcoded file to original timestamp and move it to recordings directory + (if mv? (shell-command-to-string (simple-format #f "touch --reference='~a' '~a' && mv '~a' '~a'" input-file input-tr-file input-tr-file recordings-directory))) + (mysql-commit (simple-format #f "update recorded set cutlist=0, commflagged=0, bookmark=0, transcoded=1, filesize=~a, basename=\"~a\" where chanid=~a and starttime=~a;" tr-filesize tr-basename chanid starttime)))) + +(define (mythutil-rebuild rec) + (let* ((chanid (recording-chanid rec)) + (starttime (recording-starttime rec))) + (define (rebuild tbl) + (shell-command-to-string (simple-format #f "mythutil --chanid=~a --starttime=~a --clear~a" chanid starttime tbl))) + (map rebuild '(skiplist cutlist)))) + +(define* (mythconverg-pending-jobs #:optional (days 7)) + (let ((basenames (mythconverg-execute+parse (simple-format #f "select basename from recorded where cutlist=1 and lastmodified>=now() - interval ~a day;" days)))) + (define (parse-basename bn) + (read-from-string (string-split (car (string-split (car bn) #\.)) #\_))) + (cond ((null? basenames) + (simple-format #t "mythconverg-pending-jobs: no jobs.\n") (force-output) '()) + (#t (map parse-basename (cdr basenames)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (ffmpeg-myth0 chanid starttime cut-or-skip) + (let* ((rec (create-record-data chanid starttime cut-or-skip)) + (cmd (ffmpeg-split+transcode-recording rec)) + (tr-rec (create-record-data-for-transcode rec))) + (catch #t (lambda () + ;; mysql-start-transaction here + (mysql-start-transaction "") + (mythconverg-update-recorded-seek-table tr-rec) + (mythconverg-update-recordedmarkup-table tr-rec) + ;; mysql-commit in this step + (mythconverg-update-recorded-table rec tr-rec) + (mythconverg-execute mysql-cmd) + (list rec tr-rec)) + (lambda (key . args) + (list rec tr-rec 'error))))) + +(define (ffmpeg-myth-cut c-s) + (ffmpeg-myth0 (car c-s) (cadr c-s) 'cut)) +(define (ffmpeg-myth-skip c-s) + (ffmpeg-myth0 (car c-s) (cadr c-s) 'skip)) +(define* (ffmpeg-myth-do-pending-jobs #:optional (days 7)) + (let ((days (if (number? days) days 7))) + (map ffmpeg-myth-cut (mythconverg-pending-jobs days)))) +(define* (tmp-test #:optional (x 7)) + (simple-format #t "~a\n" x) (force-output)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (ffmpeg-myth args) + (display args) (newline) + (let* ((rgs (read-from-string (cdr args))) + (cmd (eval (car rgs) (interaction-environment))) + (result + (cond ((null? rgs) '()) + ((null? (cdr rgs)) (cmd)) + (#t (apply cmd (cdr rgs)))))) + (simple-format #t "~a" result) (force-output) + result))