commit ae9de51ded25f0d4b0b1cadd21267dd07573324a jose <jose@linux-q5ep.lan> 2018-11-10 11:13:42 -0800 Full conversion capability.
README.md | 5 ++- librivox.asd | 2 - packages.lisp | 43 ++++---------------- src/bash.lisp | 4 +- src/ffmpeg.lisp | 111 ++++++++++++++++++++++++++++++++-------------------- src/html-parse.lisp | 42 -------------------- src/librivox.lisp | 18 ++------- src/persistent.lisp | 0 src/rss.lisp | 24 ------------ src/utils.lisp | 33 +++++++++++++--- src/workaround.lisp | 1 + src/youtube.lisp | 1 - 12 files changed, 112 insertions(+), 172 deletions(-)
diff --git a/README.md b/README.md index 2fc9c78..47e6ce5 100644 --- a/README.md +++ b/README.md @@ -5,4 +5,7 @@ Foreign command line applications: `bash` In your lisp: `Quicklisp` -`The LATEST CL+SSL, from the source repo. Quicklisp might not work.` \ No newline at end of file +`The LATEST CL+SSL, from the source repo. Quicklisp might not work.` +If CL+SSL doesn't work, +`curl` +command line application can be used as a workaround. \ No newline at end of file diff --git a/librivox.asd b/librivox.asd index 5b68d91..b5ffa0f 100644 --- a/librivox.asd +++ b/librivox.asd @@ -9,10 +9,8 @@ :description "Librivox auto downloader/youtube uploader." :components ((:file "packages") (:file "src/utils") - (:file "src/html-parse") (:file "src/bash") (:file "src/workaround") - (:file "src/rss") (:file "src/ffmpeg") (:file "src/librivox"))) diff --git a/packages.lisp b/packages.lisp index 9f19bf4..252da45 100644 --- a/packages.lisp +++ b/packages.lisp @@ -1,57 +1,28 @@ (defpackage :utils (:use :cl :cl-user) - (:export :remove-after :nth-digit :mvbind :dbind)) -(defpackage :html-parser - (:use :cl :cl-ppcre :utils) - (:import-from :cl-ppcre :scan-to-strings) - (:import-from :utils :dbind :mvbind) - (:export :html->lispy)) + (:export ::mvbind :dbind :list-directory :dolines + :with-gensyms :once-only :aif :awhen)) (defpackage :bash (:use :cl :uiop) (:export :run-line + :run-line-integer-output :*bash-output*)) (defpackage :workaround (:use :cl :bash) (:import-from :bash :run-line) (:export :http-request)) -(defpackage :rss - (:use :cl - #-cl+ssl-broken :drakma - #+cl+ssl-broken :workaround - :utils - :html-parser) - #-cl+ssl-broken (:import-from cl+ssl-broken :drakma :http-request) - #+cl+ssl-broken (:import-from :workaround :http-request) - (:import-from :utils :remove-after) - (:export :update! - :update - :parse-feed)) -(defpackage :youtube - (:use :cl - #+cl+ssl-broken :workaround - #-cl+ssl-broken :drakma - :utils - :html-parser) - (:import-from #+cl+ssl-broken :workaround - #-cl+ssl-broken :drakma - :http-request)) - (defpackage :librivox (:use :cl ;; Workaround for cl+ssl not working #+cl+ssl-broken :workaround #-cl+ssl-broken :drakma - :html-parser - :utils :uiop :youtube :rss :bordeaux-threads) + :utils :uiop :bordeaux-threads) #+cl+ssl-broken (:import-from :workaround :http-request) #-cl+ssl-broken (:import-from :drakma :http-request) - (:import-from :rss :parse-feed - :update - :update!) - (:import-from :html-parser :html->lispy) - (:import-from :utils :nth-digit) - (:import-from :bash :run-line :*bash-output*) + (:import-from :utils :list-directory :mvbind :dbind :dolines + :with-gensyms :once-only :aif :awhen) + (:import-from :bash :run-line :*bash-output* :run-line-integer-output) (:import-from :bordeaux-threads :make-thread :make-lock diff --git a/src/bash.lisp b/src/bash.lisp index 6173a89..aad307b 100644 --- a/src/bash.lisp +++ b/src/bash.lisp @@ -1,4 +1,4 @@ (in-package :bash) (defvar *bash-output* *debug-io*) -(defun run-line (code-string &key (output t) ignore-error-status) - (run-program code-string :output output :ignore-error-status t)) +(defun run-line (code &key (output t) (ignore-error-status t)) + (run-program code :output output :ignore-error-status ignore-error-status)) diff --git a/src/ffmpeg.lisp b/src/ffmpeg.lisp index 9316cc6..bca8619 100644 --- a/src/ffmpeg.lisp +++ b/src/ffmpeg.lisp @@ -1,45 +1,70 @@ (in-package :librivox) -(defvar *downloads-dir* "/home/jose/common-lisp/librivox/downloads/") -(defun run-line* (code-string &optional (output *bash-output*)) - (run-line (format nil code-string *downloads-dir*) :output output)) -(defun run-line*-integer-output (code-string) - (parse-integer (run-program (format nil code-string *downloads-dir*) - :output 'string) - :junk-allowed t)) -(defun hours (seconds) - (/ (- seconds (* 60 (minutes seconds)) (seconds seconds)) - 60 60)) -(defun minutes (seconds) - (nth-digit 1 seconds 60)) -(defun seconds (seconds) - (nth-digit 0 seconds 60)) -(defun processor-cores () - #+linux (run-line*-integer-output "grep -c ^processor /proc/cpuinfo~*") - #-linux 1) -(defun convert (&key image output zip) +(defvar *downloads-dir* "/run/media/raw-downloads/") +(defvar *max-seconds* (* 60 60 12)) +(defvar *image-types* (list "jpg")) +(defvar *archive-types* (list "m3u")) +(defvar *video-types* (list "mp4")) +(defun change-dir (dir code) + (format nil "cd ~A && ~A" dir code)) +(defun run-line* (code &optional (output *bash-output*)) + (run-line (change-dir *downloads-dir* code) :output output)) +(defun run-line*-integer-output (code) + (parse-integer (run-program (change-dir *downloads-dir* code) + :output :string) :junk-allowed t)) +(defun m3u-down (path) + (dolines (line path) + (run-line* (format nil "wget -nc ~A" line)) (print line))) +(defmacro with-dir (dir &body body) + (with-gensyms (old) + `(let ((,old ,*downloads-dir*)) + (setf *downloads-dir* ,dir) + ,@body + (setf *downloads-dir* ,old)))) +(defun convert (&key image input (dir *downloads-dir*)) "Convert the zip to video." - ;; ~A for the download directory, ~:*~A after the first. - ;; KLUDGE: if there is more than one zip - ;; KLUDGE: rm returns error code 1 for some reason, causing continuations. - ;; I would rather log those and automatically continue. - (ignore-errors (let ((output (merge-pathnames output *downloads-dir*)) - (image (merge-pathnames image *downloads-dir*)) - (zip (merge-pathnames zip *downloads-dir*))) - (run-line* (format nil "unzip ~A -d ~~A" zip)) - (run-line* "for f in ~A*.mp3; do echo \"file '$f'\" >> ~:*~Aconcat.txt; done") - (run-line* "ffmpeg -f concat -safe 0 -i ~Aconcat.txt -c copy ~:*~Aoutput1.mp3") - (let ((seconds (run-line*-integer-output "mp3info -p \"%S\" ~Aoutput1.mp3"))) - (run-line* (format nil "ffmpeg -loop 1 -i ~A -t ~D:~D:~D -c mjpeg ~~Atemp.mp4" ; - image - (hours seconds) - (minutes seconds) - (seconds seconds))) - (run-line* (format nil "ffmpeg -i ~~Atemp.mp4 -i ~~:*~~Aoutput1.mp3 -c copy ~A" - output)) - (run-line* "rm ~Atemp.mp4") - (run-line* "rm ~A*.mp3") - (run-line* "rm ~Aconcat.txt"))))) -;;; Example: -#|(bash:convert :image "abe_mawruss_1807.jpg" - :output "final-test-probably1.mp4" - :zip "abeandmawruss_1807_librivox.zip")|# + (unwind-protect + (with-dir dir + (m3u-down input) + (run-line* "for f in *.mp3; do echo \"file '$f'\" >> concat.txt; done") + (run-line* "ffmpeg -f concat -safe 0 -i concat.txt -c copy output1.mp3") + (let ((seconds (run-line*-integer-output "mp3info -p \"%S\" output1.mp3"))) + (if (>= *max-seconds* seconds) + (progn (run-line* (format nil "ffmpeg -loop 1 -i ~A -t ~D -c mjpeg temp.mp4" ; + image seconds)) + (run-line* (format nil "ffmpeg -i temp.mp4 -i output1.mp3 -c copy output.mp4"))) + (mvbind (times rem) (ceiling (/ seconds 4200)) + (let ((rem (1+ rem))) + (dotimes (n times) + (let ((duration (if (= times (1+ n)) + (* rem *max-seconds*) + *max-seconds*))) + (run-line* (format nil "ffmpeg -loop 1 -i ~A -t ~D -c mjpeg temp-~D.mp4" + image duration n)) + (run-line* (format nil "ffmpeg -ss ~D -t ~D -i output1.mp3 -c copy output-~D.mp3" + (* n *max-seconds*) duration n))))))))) + (progn (run-line* "rm temp*.mp4") + (run-line* "rm *.mp3") + (run-line* "rm concat.txt")))) +(defun pathname-type? (path type) + (string-equal (pathname-type path) type)) +(defun image-type? (path) + (some #'(lambda (x) (string-equal (pathname-type path) x)) *image-types*)) +(defun archive-type? (path) + (some #'(lambda (x) (string-equal (pathname-type path) x)) *archive-types*)) +(defun video-type? (path) + (some #'(lambda (x) (string-equal (pathname-type path) x)) *video-types*)) +(defun select (pred list) + (when (consp list) + (let ((car (car list))) + (if (funcall pred car) + car + (select pred (cdr list)))))) +(defun convert-all () + (dolist (downdir (list-directory *downloads-dir*)) + (dolist (dir (list-directory downdir)) + (let ((contents (list-directory dir))) + (when (not (some #'video-type? + contents)) + (convert :image (select #'image-type? contents) + :input (select #'archive-type? contents) + :dir downdir)))))) diff --git a/src/html-parse.lisp b/src/html-parse.lisp deleted file mode 100644 index 2420a04..0000000 --- a/src/html-parse.lisp +++ /dev/null @@ -1,42 +0,0 @@ -(in-package :html-parser) -;;; Specification: -;;; (("xml")("html" ("body" ("p" nil))) -;;; (ie. each one is a regex. -(defun tag-of (html-string) - (mvbind (success? tag-array) - (scan-to-strings"<(.*?\\w*).*?>" html-string) - (when success? (aref tag-array 0)))) -(defun content-of (tag-name html-string &key inside after) - (flet ((inner () (mvbind (output parens) - ;; If things are slow, it is this runtime regex expansion - (scan-to-strings (format nil "<~A\\w*.*?>(.*?)</~:*~A>(.*)" tag-name) html-string) - (declare (ignore output)) - (let ((inside-val (aref parens 0)) - (after-val (aref parens 1))) - (values inside-val after-val))))) - (mvbind (inside1 after1) (inner) - (if (and inside after) - (values inside1 after1) - (if inside inside1 after1))))) -(defun make-node (left right) - (cons left right)) -(defun make-tree (node1 node2) - (cons node1 node2)) -(defun get-tree (id tree &optional (test #'equal)) - (if (null tree) nil - (if (funcall test id (caar tree)) - (car tree) - (get-tree id (cdr tree) test)))) -(defun make-datum (id text) - (make-node id text)) -(defun html->lispy (html-string) - (if (string= "" html-string) - nil - (let ((tag-of (tag-of html-string))) - (if tag-of - (make-tree (make-datum tag-of (html->lispy (content-of tag-of - html-string - :inside t))) - (html->lispy (content-of tag-of html-string :after t))) - html-string)))) - diff --git a/src/librivox.lisp b/src/librivox.lisp index d8f609c..7d3d09e 100644 --- a/src/librivox.lisp +++ b/src/librivox.lisp @@ -3,18 +3,6 @@ ;; max threads. FFMPEG does it automatically. (defparameter *max-threads* #+multithreading (processor-cores) #- multithreading 1) -(defvar *url* "https://librivox.org/rss/latest_releases") - -(defun main-loop () - (if (= 1 *max-threads*) - ;; No multithreading: One book at a time. - (parse-feed (http-request *url*)) - ;; Multithreading: One thread per book method. - ())) -(defun rate (specification actual &optional (test #'eql)) - (if (or (null specification) (null actual)) - 0 - (if (and (consp (car specification)) (consp (car actual))) - (rate (car specification) (car actual) test) - (+ (if (funcall test (car specification) (car actual)) 1 0) - (rate (cdr specification) (cdr actual) test))))) +(defun processor-cores () + #+linux (run-line*-integer-output "grep -c ^processor /proc/cpuinfo~*") + #-linux 1) diff --git a/src/persistent.lisp b/src/persistent.lisp deleted file mode 100644 index e69de29..0000000 diff --git a/src/rss.lisp b/src/rss.lisp deleted file mode 100644 index a4729bc..0000000 --- a/src/rss.lisp +++ /dev/null @@ -1,24 +0,0 @@ -(in-package :rss) -(defvar *persistence* "persistent.lisp") -(defun previous-update () - "Get the most recent update." - (with-open-file (s *persistence* - :direction :input - :if-does-not-exist nil) - (unless (null s) - (car (read s nil nil))))) -(defun update! (update) - (with-open-file (s *persistence* - :direction :output - :if-does-not-exist :create - :if-exists :overwrite) - (prin1 update s))) -(defun parse-feed (url) - (http-request url)) -(defun update (url) - (let ((prev (previous-update)) - (feed (readable-feed (parse-fed url)))) - (cond (prev (let ((removed (remove-after prev - :test #'equal))) - (if removed (butlast removed) feed))) - (t feed)))) diff --git a/src/utils.lisp b/src/utils.lisp index 51357d9..6e50185 100644 --- a/src/utils.lisp +++ b/src/utils.lisp @@ -1,12 +1,33 @@ (in-package :utils) +(defmacro with-gensyms (symbols &body body) + "Create gensyms for those symbols." + `(let (,@(mapcar #'(lambda (sym) + `(,sym ',(gensym))) symbols)) + ,@body)) +(defmacro once-only ((&rest names) &body body) + "A macro-writing utility for evaluating code only once." + (let ((gensyms (loop for n in names collect (gensym)))) + `(let (,@(loop for g in gensyms collect `(,g (gensym)))) + `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n))) + ,(let (,@(loop for n in names for g in gensyms collect `(,n ,g))) + ,@body))))) +(defmacro dolines ((var path) &body body) + (with-gensyms (s) + `(with-open-file (,s ,path) + (do ((,var (read-line ,s nil nil) (read-line ,s nil nil))) + ((null ,var)) + ,@body)))) +(defmacro aif ((it conditional) then &optional else) + `(let ((,it ,conditional)) + (if ,it + ,then + ,else))) +(defmacro awhen ((it conditional) then) + `(aif (,it ,conditional) ,then)) (defmacro abbrev (short long) `(defmacro ,short (&rest args) `(,',long ,@args))) (abbrev mvbind multiple-value-bind) (abbrev dbind destructuring-bind) -(defun remove-after (item list &key (test #'eql)) - (subseq list (search (list item) list :test test))) -(defun nth-digit (digit number base) - (if (= 0 digit) - (mod number base) - (nth-digit (1- digit) (floor number base) base))) +(defun list-directory (directory) + (directory (merge-pathnames "*.*" directory))) diff --git a/src/workaround.lisp b/src/workaround.lisp index db18726..41d9d6c 100644 --- a/src/workaround.lisp +++ b/src/workaround.lisp @@ -1,3 +1,4 @@ (in-package :workaround) +;; Really would rather use a lisp library, but since BASH is so prevalent: (defun http-request (url) (run-line (format nil "curl '~A'" url) :output 'string)) diff --git a/src/youtube.lisp b/src/youtube.lisp deleted file mode 100644 index 98fb50a..0000000 --- a/src/youtube.lisp +++ /dev/null @@ -1 +0,0 @@ -(in-package :youtube)