147 lines
4.0 KiB
Scheme
Executable File
147 lines
4.0 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)
|
|
(lieferhund util)
|
|
(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 default-interval "1h")
|
|
|
|
(define check-interval (make-time time-duration 0 5))
|
|
(define new-database #t)
|
|
|
|
(define program-stopping #f)
|
|
|
|
(false-if-exception (mkdir (dirname (dirname default-db-path))))
|
|
(false-if-exception (mkdir (dirname default-db-path)))
|
|
|
|
(define (parse-time-interval str-interval)
|
|
(let* ((numeric-part-l (string-tokenize str-interval char-set:digit))
|
|
(letter-part-l (string-tokenize str-interval char-set:letter))
|
|
(numeric-part (car=> numeric-part-l))
|
|
(letter-part (car=> letter-part-l)))
|
|
(match
|
|
`(,(length numeric-part-l)
|
|
,(length letter-part-l)
|
|
,letter-part)
|
|
((1 1 (or "s" "m" "h"))
|
|
(make-time
|
|
time-duration 0
|
|
(* (string->number numeric-part)
|
|
(match letter-part
|
|
("s" 1)
|
|
("m" 60)
|
|
("h" 3600)))))
|
|
((1 0 #f)
|
|
(make-time time-duration 0
|
|
(string->number numeric-part)))
|
|
(_ #f))))
|
|
|
|
(define (main args)
|
|
(let* ((option-spec '((help (single-char #\h) (value #f))
|
|
(interval (single-char #\t) (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))
|
|
(interval (option-ref options 'interval default-interval))
|
|
(config-file (option-ref options 'config-file
|
|
default-config-path))
|
|
(db-file (option-ref options 'db-file
|
|
default-db-path))
|
|
(time-interval (parse-time-interval interval)))
|
|
(if (or help-wanted (equal? interval #f))
|
|
(begin
|
|
(display "\
|
|
lieferhund.scm (version 0.6)
|
|
|
|
Usage: ./lieferwelpe.scm -c <config file> -b <db file> -t <interval>
|
|
<config file> - path to the configuration file
|
|
<db file> - path to the database file
|
|
<interval> - time interval (can be expressed in s,m,h)
|
|
")
|
|
(exit 0)))
|
|
|
|
;; Sanity checks and settings
|
|
(if (not time-interval)
|
|
(begin
|
|
(display "malformed time interval\n")
|
|
(exit 1)))
|
|
(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)))
|
|
|
|
;; Actions
|
|
(sigaction (or SIGINT SIGTERM)
|
|
(lambda (_)
|
|
(format #t "lieferwelpe stopping...\n")
|
|
(set! program-stopping #t)))
|
|
|
|
;; Preparing the timer
|
|
(define last-time
|
|
(subtract-duration
|
|
(current-time)
|
|
time-interval))
|
|
(while #t
|
|
(if (time>=?
|
|
(current-time)
|
|
(add-duration last-time time-interval))
|
|
(let* ((conf (read-config-file config-file))
|
|
(db (if new-database
|
|
(begin
|
|
(set! new-database #f)
|
|
(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")
|
|
(if program-stopping
|
|
(begin
|
|
(display "stopped\n")
|
|
(exit 0)))
|
|
(set! last-time (current-time))))
|
|
(if program-stopping
|
|
(begin
|
|
(display "stopped\n")
|
|
(exit 0)))
|
|
(sleep (time-second check-interval)))))
|