113 lines
3.3 KiB
Scheme
Executable File
113 lines
3.3 KiB
Scheme
Executable File
#!/usr/bin/guile \
|
|
-e main -s
|
|
!#
|
|
|
|
;;
|
|
;; Copyright © 2021 kitzman <kitzman @ disroot . org>
|
|
;;
|
|
|
|
(use-modules (lieferhund config)
|
|
(lieferhund db)
|
|
(lieferhund processor)
|
|
(lieferhund proto)
|
|
(lieferhund hooks printer)
|
|
(srfi srfi-19)
|
|
(srfi srfi-26)
|
|
(srfi srfi-98)
|
|
(ice-9 match)
|
|
(ice-9 getopt-long))
|
|
|
|
(define default-config-path (string-append
|
|
(get-environment-variable "HOME")
|
|
"/.config/lieferhund/config.scm"))
|
|
(define default-db-path (string-append
|
|
(get-environment-variable "HOME")
|
|
"/.share/lieferhund/db.scm"))
|
|
|
|
(define new-database #t)
|
|
|
|
(false-if-exception (mkdir (dirname (dirname default-db-path))))
|
|
(false-if-exception (mkdir (dirname default-db-path)))
|
|
|
|
(define (main args)
|
|
(let* ((option-spec '((help (single-char #\h) (value #f))
|
|
(command (single-char #\x) (value #t))
|
|
(config-file (single-char #\c) (value #t))
|
|
(db-file (single-char #\b) (value #t))))
|
|
(options (getopt-long args option-spec))
|
|
(help-wanted (option-ref options 'help #f))
|
|
(command (option-ref options 'command #f))
|
|
(config-file (option-ref options 'config-file
|
|
default-config-path))
|
|
(db-file (option-ref options 'config-file
|
|
default-db-path)))
|
|
(if (or help-wanted (equal? command #f))
|
|
(begin
|
|
(display "\
|
|
lieferhund.scm (version 0.6)
|
|
|
|
Usage: ./lieferhund.scm -c <config file> -b <db file> -x <command>
|
|
<config file> - path to the configuration file
|
|
<db file> - path to the database file
|
|
<command> - one of \"pull\",\"read\",\"give-treat\"
|
|
")
|
|
(exit 0)))
|
|
(if (not (access? config-file R_OK))
|
|
(begin
|
|
(display "config file not found\n")
|
|
(flush-all-ports)
|
|
(exit 1)))
|
|
(if (access? (dirname db-file) (logior R_OK W_OK))
|
|
(if (file-exists? db-file)
|
|
(if (access? db-file (logior R_OK W_OK))
|
|
(set! new-database #f)
|
|
(begin
|
|
(display "unable to find/access db file\n")
|
|
(flush-all-ports)
|
|
(exit 1)))
|
|
(set! new-database #t))
|
|
(begin
|
|
(display "unable to find/access db directory\n")
|
|
(flush-all-ports)
|
|
(exit 1)))
|
|
(match command
|
|
("pull"
|
|
(let* ((conf (read-config-file config-file))
|
|
(db (if new-database
|
|
(make-channel-database
|
|
(database-tables-list->database-tables '()))
|
|
(read-database db-file)))
|
|
(new-news-items
|
|
(map-in-order
|
|
(cut retrieve-feed-entries <> conf db)
|
|
(configuration-entries conf))))
|
|
(process conf new-news-items)
|
|
(save-database db-file db)
|
|
(display "database saved\n")))
|
|
("read"
|
|
(let* ((conf (read-config-file config-file))
|
|
(db (if new-database
|
|
(begin
|
|
(display "cannot read from an empty database\n")
|
|
(exit 1))
|
|
(read-database db-file)))
|
|
(news-items (map
|
|
(lambda (conf-entry)
|
|
(let* ((entry-name (config-entry-name conf-entry))
|
|
(entry-table (database-get db entry-name)))
|
|
(if (equal? entry-table #f)
|
|
(begin
|
|
(format #t "could not find entry with name \"~a\"\n" entry-name)
|
|
`(,conf-entry ()))
|
|
`(,conf-entry ,(channel-table-entries entry-table)))))
|
|
(configuration-entries conf))))
|
|
(process conf news-items (make-printer-hook))))
|
|
("give-treat"
|
|
(begin
|
|
(display "woof woof\n")
|
|
(exit 0)))
|
|
(_
|
|
(begin
|
|
(display "unknown command\n")
|
|
(exit 1))))))
|