src/view/admin/logs.lisp

DOWNLOAD
(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))))