Add trigger support
This commit is contained in:
parent
04a75984cb
commit
3565109071
1 changed files with 25 additions and 10 deletions
|
@ -2,10 +2,10 @@
|
|||
#:use-module (ice-9 exceptions)
|
||||
#:use-module (logging logger)
|
||||
#:use-module (oop goops)
|
||||
#:use-module (ordo connection)
|
||||
#:use-module (srfi srfi-1) ; list utils
|
||||
#:use-module (srfi srfi-26) ; cut
|
||||
#:use-module (srfi srfi-69) ; hash-tables
|
||||
#:use-module (ordo connection)
|
||||
#:export (task
|
||||
act
|
||||
play
|
||||
|
@ -22,9 +22,11 @@
|
|||
(or (null? +filter-tags+)
|
||||
(not (null? (lset-intersection eqv? +filter-tags+ tags)))))
|
||||
|
||||
(define +playbook-vars+ #f)
|
||||
(define +act-triggers+ #f)
|
||||
|
||||
(define +play-vars+ #f)
|
||||
(define (add-act-triggers triggers)
|
||||
(set! +act-triggers+ (apply lset-adjoin equal? (or +act-triggers+ '())
|
||||
triggers)))
|
||||
|
||||
(define +act-vars+ #f)
|
||||
|
||||
|
@ -33,11 +35,15 @@
|
|||
(log-msg 'DEBUG "Registering act variable " var-name)
|
||||
(hash-table-set! +act-vars+ var-name v)))
|
||||
|
||||
(define +play-vars+ #f)
|
||||
|
||||
(define (register-play-var var-name)
|
||||
(lambda (v)
|
||||
(log-msg 'DEBUG "Registering play variable " var-name)
|
||||
(hash-table-set! +play-vars+ var-name v)))
|
||||
|
||||
(define +playbook-vars+ #f)
|
||||
|
||||
(define (register-playbook-var var-name)
|
||||
(lambda (v)
|
||||
(log-msg 'DEBUG "Registering playbook variable " var-name)
|
||||
|
@ -85,7 +91,13 @@ variable (in that order). Raise an exception if the variable is not found."
|
|||
(when (slot-bound? t 'register)
|
||||
((task-register t) result))
|
||||
(when (slot-bound? t 'triggers)
|
||||
(for-each (lambda (f) (f)) (task-triggers t))))))))
|
||||
(add-act-triggers (task-triggers t))))))))
|
||||
|
||||
(define-class <handler> ()
|
||||
(name #:init-keyword #:name #:getter handler-name)
|
||||
(action #:init-keyword #:action #:getter handler-action))
|
||||
|
||||
(define (handler . args) (apply make <handler> args))
|
||||
|
||||
(define-class <act> ()
|
||||
(name #:init-keyword #:name #:getter act-name)
|
||||
|
@ -114,10 +126,15 @@ variable (in that order). Raise an exception if the variable is not found."
|
|||
(set! +act-vars+ (alist->hash-table (act-vars a) equal?))))
|
||||
(lambda ()
|
||||
(for-each (cut perform <> c) (act-tasks a))
|
||||
;; TODO: run any triggered handlers
|
||||
)
|
||||
(when (slot-bound? a 'handlers)
|
||||
(for-each (lambda (h)
|
||||
(when (member (handler-name h) +act-triggers+)
|
||||
(log-msg 'INFO "Running handler " (handler-name h))
|
||||
((handler-action h) c)))
|
||||
(act-handlers a))))
|
||||
(lambda ()
|
||||
(set! +act-vars+ #f)))))))
|
||||
(set! +act-vars+ #f)
|
||||
(set! +act-triggers+ #f)))))))
|
||||
|
||||
(define-class <play> ()
|
||||
(name #:init-keyword #:name #:getter play-name)
|
||||
|
@ -137,9 +154,7 @@ variable (in that order). Raise an exception if the variable is not found."
|
|||
(set! +play-vars+ (alist->hash-table (play-vars p) equal?)))
|
||||
(init-connection! (play-connection p)))
|
||||
(lambda ()
|
||||
(for-each (cut perform <> (play-connection p)) (play-acts p))
|
||||
;; TODO: run any triggered handlers
|
||||
)
|
||||
(for-each (cut perform <> (play-connection p)) (play-acts p)))
|
||||
(lambda ()
|
||||
(set! +play-vars+ #f)
|
||||
(close-connection! (play-connection p))))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue