diff options
| -rwxr-xr-x | reading-heap.scm | 4 | ||||
| -rw-r--r-- | reading-heap/client.scm | 18 | ||||
| -rw-r--r-- | reading-heap/heap.scm | 1 | ||||
| -rw-r--r-- | reading-heap/media.scm | 2 | ||||
| -rw-r--r-- | reading-heap/zmq.scm | 37 | ||||
| -rwxr-xr-x | scripts/rh-client.scm.in | 80 |
6 files changed, 106 insertions, 36 deletions
diff --git a/reading-heap.scm b/reading-heap.scm index 48ad8eb..a7e3044 100755 --- a/reading-heap.scm +++ b/reading-heap.scm @@ -67,6 +67,8 @@ (priorities (map media-priority media)) (heap (fold heap-insert 'E priorities media))) (server-setup (option-ref options 'service-socket)) - (rh-receive heap))))) + (rh-receive heap + (option-ref options 'media-library) + (string-append (option-ref options 'media-library) "/archive/")))))) (main (command-line)) diff --git a/reading-heap/client.scm b/reading-heap/client.scm deleted file mode 100644 index 92eb72b..0000000 --- a/reading-heap/client.scm +++ /dev/null @@ -1,18 +0,0 @@ -(define-module (reading-heap client)) - -(use-modules (simple-zmq)) - -(define context (zmq-create-context)) -(define client-socket (zmq-create-socket context ZMQ_REQ)) - -(zmq-connect client-socket (string-append "ipc://" - (or (getenv "XDG_RUNTIME_DIR") - "/tmp") - "/reading-zmq")) - -(define (rh-client-receive) - (zmq-send client-socket "next") - (let ((msg (zmq-receive-bytevector client-socket 100))) - (display (bv->string msg)))) - -(export rh-client-receive) diff --git a/reading-heap/heap.scm b/reading-heap/heap.scm index 770b055..2dcf2f7 100644 --- a/reading-heap/heap.scm +++ b/reading-heap/heap.scm @@ -1,4 +1,5 @@ (define-module (reading-heap heap) + #:export (heap-empty?) #:export (heap-insert) #:export (heap-get-min) #:export (heap-delete-min) diff --git a/reading-heap/media.scm b/reading-heap/media.scm index ec5ee92..a4ffad4 100644 --- a/reading-heap/media.scm +++ b/reading-heap/media.scm @@ -28,7 +28,7 @@ (define (filetree->media-list dirname) (define (enter? name stat result) - (not (member (basename name) '(".git" ".svn")))) + (not (member (basename name) '(".git" ".svn" "archive")))) (define (leaf name stat result) (cons (file->media name) result)) (define (down name stat result) result) diff --git a/reading-heap/zmq.scm b/reading-heap/zmq.scm index 208ed75..65cf60e 100644 --- a/reading-heap/zmq.scm +++ b/reading-heap/zmq.scm @@ -11,11 +11,38 @@ (define (server-setup sock) (zmq-bind-socket server-socket sock)) -(define (rh-receive heap) - (let ((command (zmq-receive server-socket 65335))) - (display command) - (zmq-send server-socket (media->json (heap-get-min heap)))) - (rh-receive heap)) +(define (rh-receive heap write-location archive-location) + (let ((command (zmq-receive server-socket 1500))) + (cond ((string= command "next") + (cond ((heap-empty? heap) + (zmq-send server-socket "no media in queue")) + (#t (zmq-send server-socket (media->json (heap-get-min heap))))) + (rh-receive heap write-location archive-location)) + ((string= command "new") + (zmq-send server-socket "ok") + (let* ((media-raw (zmq-receive server-socket 1500)) + (media-data (json->media media-raw)) + (heap-new (heap-insert (media-priority media-data) media-data heap))) + (call-with-output-file (string-append write-location + "/" + (media-title media-data)) + (lambda (port) + (display media-raw port))) + (zmq-send server-socket "ok") + (rh-receive heap-new write-location archive-location))) + ((string= command "consume") + (let ((media (cond ((heap-empty? heap) "no media in queue") + (#t (heap-get-min heap)))) + (heap-new (cond ((heap-empty? heap) heap) + (#t (heap-delete-min heap))))) + (rename-file (string-append write-location + "/" + (media-title media)) + (string-append archive-location + "/" + (media-title media))) + (zmq-send server-socket "ok") + (rh-receive heap-new write-location archive-location)))))) (export rh-receive server-setup) diff --git a/scripts/rh-client.scm.in b/scripts/rh-client.scm.in index d81acc4..64dfde6 100755 --- a/scripts/rh-client.scm.in +++ b/scripts/rh-client.scm.in @@ -1,12 +1,11 @@ #!/usr/bin/env guile !# -(define-module (reading-heap client)) - (use-modules (simple-zmq) (config) (config api) (config parser sexp) - (config licenses)) + (config licenses) + (json)) (define config (configuration @@ -27,12 +26,43 @@ (test boolean?) (character #f)) (switch + (name 'title) + (synopsis "title of the new media") + (default "Foundation Trilogy") + (test string?) + (character #t)) + (switch + (name 'author) + (synopsis "author of the new media") + (default "Isaac Asimov") + (test string?) + (character #t)) + (switch + (name 'location) + (synopsis "location of the new media") + (default "https://openlibrary.org/books/OL20930675M/The_foundation_trilogy") + (test string?) + (character #t)) + (switch + (name 'priority) + (synopsis "priority of the new media") + (default "1") + (test string?) + (character #t)))) + (subcommands + (list + (configuration (name 'next) (synopsis "get the next media to consume") - (default #f) - (test boolean?) - (character #t)) - )) + (wanted '((keywords . (service-socket))))) + (configuration + (name 'new) + (synopsis "add new media to the heap") + (wanted '((keywords . (service-socket title author location priority))))) + (configuration + (name 'consume) + (synopsis "remove the next media from the heap") + (wanted '((keywords . (service-socket))))))) (directory (list (in-home ".reading-heap/") (path (given (string-append (or (getenv "XDG_CONFIG_HOME") @@ -51,15 +81,43 @@ (define (rh-client-next) (zmq-send client-socket "next") - (let ((msg (zmq-receive-bytevector client-socket 65335))) + (let ((msg (zmq-receive-bytevector client-socket 1500))) (display (bv->string msg)))) +(define (rh-client-new json) + (zmq-send client-socket "new") + (zmq-receive client-socket 1500) + (zmq-send client-socket json) + (display (zmq-receive client-socket 1500)) + (zmq-send client-socket "next") + (display (zmq-receive client-socket 1500))) + +(define (rh-client-consumed) + (zmq-send client-socket "consume") + (display (zmq-receive client-socket 1500))) + +(define (json-from-args priority title author location) + (scm->json-string `(("priority" . ,priority) + ("title" . ,title) + ("author" . ,author) + ("location" . ,location)))) + (define (main cmd-line) (let ((options (getopt-config-auto cmd-line config))) (when (option-ref options 'write) (options-write options)) - (when (option-ref options 'next) - (client-setup (option-ref options 'service-socket)) - (rh-client-next)))) + (cond ((string=? (cadr (full-command options)) "next") + (client-setup (option-ref options 'service-socket)) + (rh-client-next)) + ((string=? (cadr (full-command options)) "new") + (client-setup (option-ref options 'service-socket)) + (rh-client-new (json-from-args (string->number (option-ref options 'priority)) + (option-ref options 'title) + (option-ref options 'author) + (option-ref options 'location)))) + ((string=? (cadr (full-command options)) "consume") + (client-setup (option-ref options 'service-socket)) + (rh-client-consumed)) + (#t (emit-help options))))) (main (command-line)) |