summaryrefslogtreecommitdiff
path: root/service/menu-service.lisp
blob: 8ea0515b128a82e9472add10e23c858fd0d1c12d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(declaim (optimize (speed 0) (safety 3) (debug 3)))

(in-package #:ldapadmin)

(defparameter *menu-config* '((:id "a_menu_home" :label "Home" :url "/home" :handler "/home" :permission "t")
                              (:id "a_menu_login" :label "Login" :url "/login" :handler "/login" :permission "anonymous")
                              (:id "a_menu_logout" :label "Logout" :url "/logout" :handler "/logout" :permission "admin")
                              (:id "a_menu_inetorg_view" :label "View InetOrg Entries" :url "/inetorg/view" :handler "/inetorg/view" :permission "admin")
                              (:id "a_menu_inetorg_add" :label "Add InetOrg Entry" :url "/inetorg/add" :handler "/inetorg/add" :permission "admin")))

(defclass menuitem ()
  ((id :initarg :id
       :initform nil
       :accessor id)
   (label :initarg :label
          :initform nil
          :accessor label)
   (url :initarg :url
        :initform nil
        :accessor url)
   (handler :initarg :handler
            :initform nil
            :accessor handler)
   (permissions :initarg :permissions
                :initform nil
                :accessor permissions)
   (children :initarg :children
             :initform nil
             :accessor children))
  (:documentation ""))
  
(defclass menu-service (base-service)
  ((menuitems :initarg :menuitems
              :initform nil
              :accessor menuitems))
  (:documentation ""))

(defmethod initialize-instance :after ((menu-service menu-service) &key)
  (setf (menuitems menu-service)
        (mapcar (lambda (x)
                  (make-instance 'menuitem
                                 :id (getf x :id)
                                 :label (getf x :label)
                                 :url (getf x :url)
                                 :handler (getf x :handler)))
                (remove-if 'null (mapcar (lambda (x)
                                           (when (find-if (lambda (y)
                                                            (string= (getf x :permission) y))
                                                          `("t" ,(session-value :permissions)))
                                             x))
                                         *menu-config*)))))

(defun menu-json ()
  (org-ckons-json::objects-to-json `(,(make-instance 'menu-service))))