ffmpeg-mythtv/ffmpeg-myth.scm
Leo Butler 23d4e73ed6 improve RECORDING-NEW-FILE-NAME
With the new file endings, we need to split file names at #\. and pick
up the beginning (e.g. 1031_20210405000300) and add
ending (e.g. h264.ts) but drop any middle parts.
2021-04-18 06:55:59 -05:00

539 lines
26 KiB
Scheme
Executable File
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

#!/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/bin/ffmpeg")
(define ffprobe-bin "/usr/bin/ffprobe")
(define ffprobe-separator #\page) ;;
(define ffmpeg-transcoding-options "-c:v libx264 -preset veryfast -crf 21 -c:a ac3 -g 60 -keyint_min 30")
(define ffmpeg-transcoded-file-muxer 'mpegts) ;; 'matroska
(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 (write-to-file obj filename)
(let ((port (open-file filename "w")))
(catch 'write-error
;; thunk
(lambda () (simple-format port "~a" obj) (force-output) (close port))
;; handler
(lambda () (close port) 'write-error))))
(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))
(cond (shell-command-log
(simple-format #t "shell-command-to-string result: ~a\n" str) (force-output)))
str))
;; handler
(lambda (key cmd str)
(simple-format #t "ERROR: in command ~a\nstring: ~a\n" cmd str)
(throw 'error-in-shell-command-to-string 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* (ffprobe-out-parser s)
(dsv-splitter (delete "" (dsv-splitter s #\newline)) ffprobe-separator))
(define (k-v-parser s)
(read-from-string (dsv-splitter s #\=)))
(define (map-cons l)
(apply (lambda(x y) (map cons x y)) l))
(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)
(map-cons (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 (read-from-string (ffprobe-out-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='~a' -i '~a'" ffprobe-bin ffprobe-separator file)))))
(c -1))
(define (add-coded_picture_number l)
(set! c (+ c 1))
(list (first l) (second l) (third l) c (fifth l)))
(filter filter-rule (map add-coded_picture_number frame-info))))
(define (ffprobe-i-frames file)
;; filter out bad I-frames with N/A data in either the time (1) or frame number slot (2)
(ffprobe-video-packets file (lambda(l) (and (eq? 'I (third l)) (not (eq? 'N/A (first l))) (not (eq? 'N/A (second 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='~a' -i '~a'" ffprobe-bin ffprobe-separator file))))
(map make-dotted-alist (k-v-parser (ffprobe-out-parser stream-info)))))
(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) (if (< (caar l) (caadr l)) (append (list (cons (caar l) (caadr l))) acc) acc)))
(#t
(cl (cdr l) acc)))))
(cond ((null? s)
(set! s '((0 0))))
((and (start-of-cut? (cadar s)) (> (caar s) 0))
(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 test i-frame)
(cond ((null? frame-info) i-frame)
(#t
(let* ((i-frame (car frame-info))
(cpn (fourth i-frame)))
(if (test cpn idx) i-frame (mythtv-find-nearest-i-frame-before/after idx (cdr frame-info) test i-frame))))))
(define (mythtv-find-nearest-i-frame-before idx frame-info)
(mythtv-find-nearest-i-frame-before/after idx frame-info >= (first frame-info)))
(define (mythtv-find-nearest-i-frame-after idx frame-info)
(mythtv-find-nearest-i-frame-before/after idx (reverse frame-info) <= (last frame-info)))
(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)
(if (recording? r-d) 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" "h264-ts" "h264.ts" "h265.ts"))
(define recording-file-endings2 '("ts"))
(define transcoded-file-ending "h264.ts") ;; mkv
(define remuxed-ts-file-ending "h264.ts")
(define (recording-basename rec)
(assv-ref (recording-recorded-table rec) 'basename))
(define (recording-filesize rec)
(assv-ref (recording-recorded-table rec) 'filesize))
(define (recording-av-stream-info rec type)
(define (rvsi s r) (cond ((null? s) r)
((eqv? (assv-ref (car s) 'codec_type) type)
(rvsi (cdr s) (cons (car s) r)))
(#t (rvsi (cdr s) r))))
(rvsi (recording-streams-info rec) '()))
(define (recording-video-stream-ffmpeg-filt rec scale?)
(define (iter f l i acc)
(cond ((null? l) (reverse acc))
(#t
(iter f (cdr l) (+ 1 i) (cons (f i) acc)))))
(let* ((v (car (recording-av-stream-info rec 'video)))
(a (reverse (recording-av-stream-info rec 'audio)))
(rtn (recording-retain-list rec))
;;(sar (assv-ref v 'sample_aspect_ratio))
(dar (assv-ref v 'display_aspect_ratio))
(height (assv-ref v 'height))
(width (assv-ref v 'width))
(idx (assv-ref v 'index))
(aidx (map (lambda(s) (assv-ref s 'index)) a))
(scale-flt (if scale? (let ((fmt (simple-format #f "[~~a:~a] scale=w=~a:h=~a,setdar=~a,setpts=PTS-STARTPTS [v~~a];" idx width height dar)))
(lambda (i) (simple-format #f fmt i i))) (lambda (i) "")))
(av-ptr (lambda (i) (string-join (cons (if scale? (simple-format #f "[v~a]" i) (simple-format #f "[~a:~a]" idx i)) (map (lambda (a) (simple-format #f "[~a:~a]" i a)) aidx)))))
(out-ptr (lambda (i) (simple-format #f "[out~a]" i)))
(n (length rtn))
(concat (simple-format #f "concat=n=~a:v=1:a=~a [out0]" n (length aidx)))
(mappings (lambda (i) (simple-format #f "-map '[out~a]'" i))))
(string-join (append (list "'") (iter scale-flt rtn 0 '()) (iter av-ptr rtn 0 '()) (list concat) (iter out-ptr aidx 1 '()) (list "' ") (iter mappings (cons 0 aidx) 0 '())))))
(define* (ffmpeg-split+scale+transcode-recording rec #:optional (scale? #f))
(let* ((basename (recording-basename rec))
(rootname+ext (string-split basename #\.))
(rootname (car 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 -t ~a -i '~a'" (car c) (- (cdr c) (car c)) in-file)))
(filter (recording-video-stream-ffmpeg-filt rec scale?))
(options ffmpeg-transcoding-options)
(cmd (simple-format #f "~a -y ~a -filter_complex ~a ~a ~a ~a" ffmpeg-bin (string-join (map seek-fn cut-times)) filter options m-d out-file)))
(shell-command-to-string cmd)
cmd))
(define (recording-new-file-name file-name ending)
(let* ((base+exts (string-split file-name #\.))
(base (car base+exts)))
(simple-format #f "~a.~a" base 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! rec-tbl (assv-set! rec-tbl 'cutlist 0))
(set! rec-tbl (assv-set! rec-tbl 'commflagged 0))
(set! rec-tbl (assv-set! rec-tbl 'bookmark 0))
(set! rec-tbl (assv-set! rec-tbl 'transcoded 1))
(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)) (car (mythtv-find-nearest-i-frame-before (cdar indices) i-frame-info)))))))))
(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)
(transcoded-file-ending transcoded-file-ending)
(ffmpeg-transcoded-file-muxer ffmpeg-transcoded-file-muxer))
(let* ((basename (recording-basename rec))
(rootname+ext (string-split basename #\.))
(rootname (car 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 (if (eq? ffmpeg-transcoded-file-muxer 'matroska) (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 -t ~a -i '~a'" (car c) (- (cdr c) (car 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' ~a ~a ~a -f ~a ~a" ffmpeg-bin (string-join (map seek-fn cut-times)) instreams (length cut-times) (- (length outstreams) 1) (string-join outstreams) ffmpeg-transcoding-options (string-join mappings) m-d ffmpeg-transcoded-file-muxer 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)
((not (number? (first (car l))))
(type-9/33-marks (cdr l) acc))
((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 #:optional (continuation mysql-continue))
(let* ((chanid (recording-chanid rec))
(starttime (recording-starttime rec))
(last-i-frame (mythconverg-recordedmarkup-type34 rec))
(duration (mythconverg-recordedmarkup-type33 rec)))
(continuation (simple-format #f "delete from ltbrecordedmarkup where chanid=~a and starttime=~a; insert into ltbrecordedmarkup (chanid,starttime,mark,type,data) select chanid,starttime,mark,type,data 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))))
;; should be identical to above, except the tables are reversed
(define (mythconverg-update-recordedmarkup-table-rollback rec)
(let ((sanitize+continue (lambda (s)
(mysql-continue (string-downcase
(regexp-substitute/global #f " recordedmarkup"
(regexp-substitute/global #f " ltbrecordedmarkup" s 'pre " RECORDEDMARKUP" 'post) 'pre " LTBRECORDEDMARKUP" 'post))))))
(mythconverg-update-recordedmarkup-table rec sanitize+continue)))
(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 and not(recgroup = 'Deleted');" 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))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ROLLBACK ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The recording records for old+new are written to the log file after a ;;
;; transcoding. Use rollback-transcoding to rollback to the old recording. ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define* (rollback-transcoding old+new #:optional (update-database #f))
;; rec = old recording
;; tr-rec = transcoded recording
(let* ((rec (re-create-record-data (car old+new)))
(tr-rec (re-create-record-data (cadr old+new))))
(catch #t (lambda ()
;; mysql-start-transaction here
(mysql-start-transaction "")
(mythconverg-update-recorded-seek-table rec)
(mythconverg-update-recordedmarkup-table-rollback rec)
;; last arg is #f so that no mv/touch is done
(mythconverg-update-recorded-table tr-rec rec #f)
;; mysql-commit in this step
(if update-database (mythconverg-execute mysql-cmd))
(list 'updated (recording-basename rec)))
(lambda (key . args)
(list 'error (recording-basename rec))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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)
;;(shell-command-to-string #t "printenv") (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))