diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | debbugs/cache.scm | 49 | ||||
| -rw-r--r-- | debbugs/config.scm | 5 | ||||
| -rw-r--r-- | debbugs/soap.scm | 11 |
4 files changed, 63 insertions, 3 deletions
diff --git a/Makefile.am b/Makefile.am index cc5de7d..0fc86ad 100644 --- a/Makefile.am +++ b/Makefile.am @@ -24,6 +24,7 @@ godir=$(libdir)/guile/@GUILE_EFFECTIVE_VERSION@/ccache SOURCES = \ debbugs/base64.scm \ debbugs/bug.scm \ + debbugs/cache.scm \ debbugs/config.scm \ debbugs/email.scm \ debbugs/operations.scm \ diff --git a/debbugs/cache.scm b/debbugs/cache.scm new file mode 100644 index 0000000..7dfd375 --- /dev/null +++ b/debbugs/cache.scm @@ -0,0 +1,49 @@ +;;; Guile-Debbugs --- Guile bindings for Debbugs +;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> +;;; +;;; This file is part of Guile-Debbugs. +;;; +;;; Guile-Debbugs is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation; either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; Guile-Debbugs is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Guile-Debbugs. If not, see <http://www.gnu.org/licenses/>. + +(define-module (debbugs cache) + #:use-module (debbugs config) + #:use-module (ice-9 match) + #:export (cached? cache! forget! forget-all!)) + +(define %cache (make-hash-table)) + +(define (cached? key) + "Return the value matching KEY from the cache if it has not yet +expired or return #F." + (let ((t (current-time))) + (match (hash-ref %cache key) + ((#:expires time #:value value) + (if (< t time) value #f)) + (_ #f)))) + +(define* (cache! key value + #:optional (ttl (config 'cache-ttl))) + "Store VALUE for the given KEY and mark it to expire after TTL +seconds." + (let ((t (current-time))) + (hash-set! %cache key `(#:expires ,(+ t ttl) #:value ,value)) + value)) + +(define (forget! key) + "Delete KEY from the cache." + (hash-remove! %cache key)) + +(define (forget-all!) + "Reset the cache." + (set! %cache (make-hash-table))) diff --git a/debbugs/config.scm b/debbugs/config.scm index 96f9624..217e725 100644 --- a/debbugs/config.scm +++ b/debbugs/config.scm @@ -1,5 +1,5 @@ ;;; Guile-Debbugs --- Guile bindings for Debbugs -;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of Guile-Debbugs. ;;; @@ -20,7 +20,8 @@ #:export (config)) (define %config - `((debug . #f))) + `((debug . #f) + (cache-ttl . 240))) (define (config key) (assoc-ref %config key)) diff --git a/debbugs/soap.scm b/debbugs/soap.scm index 97dabd1..27c5fce 100644 --- a/debbugs/soap.scm +++ b/debbugs/soap.scm @@ -1,5 +1,5 @@ ;;; Guile-Debbugs --- Guile bindings for Debbugs -;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of Guile-Debbugs. ;;; @@ -18,6 +18,8 @@ (define-module (debbugs soap) #:use-module (debbugs base64) + #:use-module (debbugs config) + #:use-module (debbugs cache) #:use-module (sxml simple) #:use-module (sxml xpath) #:use-module (web client) @@ -33,6 +35,7 @@ soap-request-callback soap-invoke + soap-invoke* soap->scheme)) ;; (define (parse-wsdl file) @@ -105,6 +108,12 @@ response body." ((soap-request-callback request) (xml->sxml body #:trim-whitespace? #t))))) +(define (soap-invoke* . args) + "Cache the return value of SOAP-INVOKE. Return the cached value if +it is still fresh." + (or (cached? args) + (cache! args (apply soap-invoke args)))) + (define* (soap->scheme sxml #:optional (plain #f)) "Convert a SOAP sxml expression for a named value to a Scheme value. If PLAIN is #T return only the value, otherwise return a pair of a |