506 lines
24 KiB
Scheme
Executable File
506 lines
24 KiB
Scheme
Executable File
#!/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 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))))
|
||
|
||
(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 (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 (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)))))
|
||
(read-from-string (filter filter-rule 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 (string=? "I" (third l)) (not (string=? "N/A" (first l))) (not (string=? "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 (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) (if (< (caar l) (caadr l)) (append (list (cons (caar l) (caadr l))) acc) acc)))
|
||
(#t
|
||
(cl (cdr l) acc)))))
|
||
(if (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)
|
||
(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-filesize rec)
|
||
(assv-ref (recording-recorded-table rec) 'filesize))
|
||
|
||
(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! 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))
|
||
(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 -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' -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)
|
||
((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;" 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 rec tr-rec))
|
||
(lambda (key . args)
|
||
(list rec tr-rec 'error)))))
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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))
|