commit 00ae577c5fd0983ef797dcace4156971c7e371ee
Spenser Truex <struex0@gmail.com>
2018-08-01 22:10:50 -0700
Html now parses.
librivox.asd | 6 ++--
packages.lisp | 11 ++++++--
rss/rss.lisp | 16 -----------
src/html-parse.lisp | 40 +++++++++++++++++++++++++++
src/librivox.lisp | 50 ++--------------------------------
persistent.lisp => src/persistent.lisp | 0
src/rss.lisp | 24 ++++++++++++++++
src/utils.lisp | 13 ++++++++-
{youtube => src}/youtube.lisp | 0
utils.lisp | 7 -----
youtube/utils.lisp | 1 -
11 files changed, 91 insertions(+), 77 deletions(-)
diff --git a/librivox.asd b/librivox.asd
index ac2095d..5b68d91 100644
--- a/librivox.asd
+++ b/librivox.asd
@@ -3,14 +3,16 @@
(asdf:defsystem :librivox
:serial t
:depends-on (#-cl+ssl-broken :drakma
- :cl-feedparser
+ :cl-ppcre
:uiop
:bordeaux-threads)
:description "Librivox auto downloader/youtube uploader."
:components ((:file "packages")
- (:file "utils")
+ (: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 9a57e72..03e9009 100644
--- a/packages.lisp
+++ b/packages.lisp
@@ -1,6 +1,10 @@
(defpackage :utils
(:use :cl :cl-user)
(:export :remove-after :nth-digit))
+(defpackage :html-parser
+ (:use :cl :cl-ppcre :trivia :utils)
+ (:import-from :cl-ppcre :scan-to-strings)
+ (:import-from :utils :dbind :mvbind))
(defpackage :bash
(:use :cl :uiop)
(:export :run-line
@@ -15,7 +19,8 @@
#-cl+ssl-broken :drakma
#+cl+ssl-broken :workaround
:utils
- :feedparser)
+ :feedparser
+ :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)
@@ -26,7 +31,8 @@
(:use :cl
#+cl+ssl-broken :workaround
#-cl+ssl-broken :drakma
- :utils)
+ :utils
+ :html-parser)
(:import-from #+cl+ssl-broken :workaround
#-cl+ssl-broken :drakma
:http-request))
@@ -36,6 +42,7 @@
;; Workaround for cl+ssl not working
#+cl+ssl-broken :workaround
#-cl+ssl-broken :drakma
+ :html-parser
:utils :uiop :youtube :rss :bordeaux-threads)
#+cl+ssl-broken (:import-from :workaround :http-request)
#-cl+ssl-broken (:import-from :drakma :http-request)
diff --git a/rss/rss.lisp b/rss/rss.lisp
deleted file mode 100644
index 91fab74..0000000
--- a/rss/rss.lisp
+++ /dev/null
@@ -1,16 +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) (read s nil nil))))
-(defun update! (url)
- (previous-update))
-(defun parse-feed (url)
- (feedparser:parse-feed (http-request url)))
-(defun update (url)
- (remove-after (previous-update)
- (readable-feed (parse-feed url))
- :test #'equal))
diff --git a/src/html-parse.lisp b/src/html-parse.lisp
new file mode 100644
index 0000000..8001bee
--- /dev/null
+++ b/src/html-parse.lisp
@@ -0,0 +1,40 @@
+(in-package :html-parser)
+;;; Specification:
+;;; (("xml")("html" ("body" ("p" nil)))
+;;; (ie. each one is a regex.
+(defun rate (specification tree)
+ (declare (ignore specification tree)))
+(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)
+ (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)))
+ (cond ((and (not inside) after) after)
+ ((and inside (not after)) inside)
+ (t (values inside-val after-val))))))
+(defun push-tree (node tree)
+ (if node (cons node tree) tree))
+(defun push-node (atom node)
+ (if node
+ (cons node atom)
+ atom))
+(defun adjoin-trees (tree1 tree2)
+ (append tree1 tree2))
+(declaim (inline get-node))
+(defun get-node (key node)
+ (assoc key node))
+(defun html->lispy (html-string &optional node)
+ (if (string= "" html-string)
+ node
+ (let ((tag-of (tag-of html-string)))
+ (if tag-of
+ (mvbind (inside after) (content-of tag-of html-string)
+ (push-tree (push-node (html->lispy inside tag-of) node)
+ (html->lispy after)))
+ (push-node html-string node)))))
diff --git a/src/librivox.lisp b/src/librivox.lisp
index 41c24dc..52529b1 100644
--- a/src/librivox.lisp
+++ b/src/librivox.lisp
@@ -1,55 +1,9 @@
(in-package :librivox)
-;; As far as I can tell this is a common way of determining max threads.
-;; FFMPEG does it automatically.
-(defvar *downloads-dir* "/home/jose/common-lisp/librivox/downloads/")
+;; As far as I can tell counting processor cores is a common way of determining
+;; max threads. FFMPEG does it automatically.
(defparameter *max-threads* #+multithreading (processor-cores)
#- multithreading 1)
(defvar *url* "https://librivox.org/rss/latest_releases")
-(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 ()
- #+(and linux multithreading) (run-line*-integer-output "grep -c ^processor /proc/cpuinfo~*")
- #-linux 1
- #-multithreading 1)
-(defun convert (&key image output zip)
- "Convert the zip to video."
- ;; ~A for the download directory, ~:*~A after the first.
- ;; KLUDGE: Better to do a PART 1, PART 2, ETC system, since books are often >12 hours.
- ;; 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")|#
(if (= 1 *max-threads*)
;; No multithreading: One book at a time.
diff --git a/persistent.lisp b/src/persistent.lisp
similarity index 100%
rename from persistent.lisp
rename to src/persistent.lisp
diff --git a/src/rss.lisp b/src/rss.lisp
new file mode 100644
index 0000000..a4729bc
--- /dev/null
+++ b/src/rss.lisp
@@ -0,0 +1,24 @@
+(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
deleted file mode 120000
index 5b43057..0000000
--- a/src/utils.lisp
+++ /dev/null
@@ -1 +0,0 @@
-utils.lisp
\ No newline at end of file
diff --git a/src/utils.lisp b/src/utils.lisp
new file mode 100644
index 0000000..51357d9
--- /dev/null
+++ b/src/utils.lisp
@@ -0,0 +1,12 @@
+(in-package :utils)
+(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)))
diff --git a/youtube/youtube.lisp b/src/youtube.lisp
similarity index 100%
rename from youtube/youtube.lisp
rename to src/youtube.lisp
diff --git a/utils.lisp b/utils.lisp
deleted file mode 100644
index c853ba1..0000000
--- a/utils.lisp
+++ /dev/null
@@ -1,7 +0,0 @@
-(in-package :utils)
-(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)))
diff --git a/youtube/utils.lisp b/youtube/utils.lisp
deleted file mode 120000
index 5b43057..0000000
--- a/youtube/utils.lisp
+++ /dev/null
@@ -1 +0,0 @@
-utils.lisp
\ No newline at end of file