[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [Logs-devel] rule macro attempt #1
From: |
Jim Prewett |
Subject: |
Re: [Logs-devel] rule macro attempt #1 |
Date: |
Sun, 4 Jun 2006 19:31:03 -0600 (MDT) |
Hi Vijay,
I've had fun playing with your code today (unfortunately, some yard work,
etc. kept me busy for too much of it :). I've made a few minor
modifications, and generally think your code has a nice feel to it :)
kudos!
Here is an example using some of the new things I've added:
(rule
name 'foo
match regexp ".+"
;; set variable var1 to 42
setenv var1 = 42
;; first action
doing (lambda (x) (format t "message: ~A var1: ~A~%" (message x)
var1))
;; second action
doing #'print-message
;; set continuep slot to t
continue)
;;; Paul Graham, On Lisp, p191
(defmacro aif (test-form then-form &optional else-form)
`(let ((it ,test-form))
(if it ,then-form ,else-form)))
;;; an 'accessor' for the handle-fns
(defmacro handle-fn (keyword)
`(get ,keyword 'handle-fn))
;;; Influenced by Peter Norvig's LOOP implementation
(defstruct rool
(name '())
(match '())
(timeout '())
(relative-timeout '())
(delete-rule '())
(continuep '())
(actions '())
(environment '()))
(defmacro rule (&rest exprs)
(let ((r (make-rool)))
(parse-rule r exprs)
(fill-rule-template r)))
(defun fill-rule-template (rool)
`(make-instance
'logs::rule
:environment ',(rool-environment rool)
:actions (rool-actions ,rool)
,@(loop as (key fn) in '((:match rool-match)
(:name rool-name)
(:timeout rool-timeout)
(:continuep rool-continuep)
(:relative-timeout rool-relative-timeout))
as res = (funcall fn rool)
if res append `(,key ,res))))
(defun parse-rule (rool exprs)
(unless (null exprs)
(parse-rule rool (parse-keyword rool (car exprs) (cdr exprs)))))
(defun parse-keyword (rool keyword exprs)
(aif (handle-fn keyword)
(funcall it rool exprs)
(error "Unknown keyword ~S" keyword)))
(defun handle-name (rool exprs)
(destructuring-bind (name . cdr) exprs
;; rule names don't have to be symbols
;; symbols are (obviously) a pretty good idea, but
;; strings, etc. should work as well
(if (null (rool-name rool))
(setf (rool-name rool) `,name)
(error "Invalid name ~S" name))
cdr))
(defun handle-match (rool exprs)
(let ((matches (rool-match rool)))
;; For now, we ignore. Later we add or something
(declare (ignore matches))
(destructuring-bind (car . cdr) exprs
(case car
(regexp (let ((msg (gensym "MESSAGE"))
(matches (gensym))
(sub-matches (gensym))
(regex (pop cdr)))
(setf (rool-match rool)
`(lambda (,msg)
(multiple-value-bind (,matches ,sub-matches)
(cl-ppcre:scan-to-strings ,regex (message ,msg))
(when ,matches
(values t
'((sub-matches ,sub-matches)))))))
cdr))
(message-length (let ((msg (gensym "MESSAGE"))
(relop (pop cdr))
(num (pop cdr)))
(setf (rool-match rool)
`(lambda (,msg)
(,relop (length (message ,msg)) ,num)))
cdr))
(t (setf (rool-match rool) car) cdr)))))
(defun handle-timeout (rool exprs)
(destructuring-bind (preposition . (time . cdr)) exprs
(case preposition
(in (setf (rool-relative-timeout rool) time))
(at (setf (rool-timeout rool) time)))
cdr))
(defun handle-setenv (rool exprs)
(destructuring-bind (variable equal value &rest rest) exprs
(pushnew (list variable value)
(rool-environment rool)
:test
(lambda (x y) (equal (car x) (car y))))
rest))
;; add the given function to the actions list
(defun handle-do (rool exprs)
(destructuring-bind (todo &rest rest) exprs
(format t "rool: ~A todo: ~A rest: ~A~%"
rool todo rest)
(append (rool-actions rool) (list (eval todo)))
rest))
;; set the continue slot to t
(defun handle-continue (rool exprs)
(setf (rool-continuep rool) t)
exprs)
(setf (handle-fn 'match) #'handle-match)
(setf (handle-fn 'name) #'handle-name)
(setf (handle-fn 'timeout) #'handle-timeout)
;; new
(setf (handle-fn 'continue) #'handle-continue)
(setf (handle-fn 'setenv) #'handle-setenv)
(setf (handle-fn 'doing) #'handle-do)
Jim
James E. Prewett address@hidden address@hidden
Systems Team Leader LoGS: http://www.hpc.unm.edu/~download/LoGS/
Designated Security Officer OpenPGP key: pub 1024D/31816D93
HPC Systems Engineer III UNM HPC 505.277.8210
On Sun, 4 Jun 2006, Vijay Lakshminarayanan wrote:
> On 6/4/06, Jim Prewett <address@hidden> wrote:
> > > > I was wondering how you're envisioning this working for rules that
> > create
> > > > rules ... that create rules?
> > > >
> > > > (make-instance 'rule
> > > > :actions
> > > > (list
> > > > (lambda (message)
> > > > (enqueue *root-ruleset* (make-instance 'rule ...)))))
> > >
> > > We just use the macro again, I guess.
> > >
> > > (rule performing (lambda (message) (enqueue *root-ruleset* (rule
> > ...))))
> > >
> >
> > I was hoping that was the answer :)
>
> Oh so it's a Good Thing? That's a relief :-)
>
> > > In time we should have a single function which does the enqueing.
> >
> > I don't think you're quite understanding the ruleset tree structure.
> > rulesets contain rules and other rulesets. You may want to have a rule
> > that creates a new rule on a completely different part of the tree.
>
> You're right. I completely forgot about this -- I was totally
> immersed into defining the macro's behavior itself.
>
> > In other words, I don't see specifying the ruleset you're adding the rule
> > to to be a loss.
> >
> > Jim
> >
>
> Will come up with more and better quality code soon, Jim.
>
> Thanks
> Vijay
>