Add trigger support

This commit is contained in:
Ray Miller 2025-01-11 21:21:48 +00:00
parent 04a75984cb
commit 3565109071
Signed by: ray
GPG key ID: 043F786C4CD681B8

View file

@ -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))))))