src/view/admin/logs.lisp
(in-package :murja.view.admin.logs)
(defroute post-logs-groups ("/api/logs/groups" :method :post
:decorators (murja.middleware.db:@db
murja.middleware.auth:@ssr-authenticated)) ()
(let ((form (lisp-fixup:formdata->hashmap (hunchentoot:raw-post-data :force-text t))))
;;(postmodern:execute "DELETE FROM blog.log_group;")
(postmodern:execute "INSERT INTO blog.log_group (name, alarmy) VALUES ($1, $2) ON CONFLICT DO NOTHING"
(gethash "name" form)
(equalp
(gethash "alarmy" form) "on")))
(hunchentoot:redirect "/blog/logs"))
(deftab blog/logs (:url "/logs"
:title "Logs"
:params (&get ungroup)
:captured-url-params (ungroup)
:require-login t
:needed-abilities ("update-settings"))
(let* ((groups (unless ungroup
(get-groups)))
(whole-log (get-logs))
(groups-with-logs (alexandria:hash-table-alist
(reduce
(lambda (acc group)
(let ((name (gethash "name" group)))
(setf (gethash group acc)
(remove-if-not (lambda (line)
(cl-ppcre:all-matches-as-strings name line))
whole-log))
acc))
groups
:initial-value (cl-hash-util:hash))))
(grouped-lines (apply #'concatenate 'list (map 'list
#'cdr
groups-with-logs)))
(untitled-group (cons (let ((hash (make-hash-table :test 'equal)))
(setf (gethash "name" hash) "Untitled")
hash)
(remove-if (lambda (line)
(member line grouped-lines :test 'equal))
whole-log)))
(groups-with-logs (cons untitled-group groups-with-logs)))
(:a :href (str:replace-all "?ungroup=NIL" ""
(murja.genurl:route->url
'blog/logs :ungroup (not ungroup)))
(if ungroup
"Show grouped logs"
"Ungroup logs"))
(:h* ("Groups (~d)" (length groups-with-logs)))
(:ul
(dolist (group-log groups-with-logs)
(log-group group-log)))
(:form :method "post" :action "/api/logs/groups" :onsubmit "location.reload()"
(:label "Log regexp " (:input :type "text" :name "name" :id "name"))
(:label "Hits cause alarm " (:input :type "checkbox" :name "alarmy" :id "alarmy"))
(:input :type :submit))))