GCAI

A00000000000000000000000000000011 Müller Frank A00000000000000000000000000000000 A00000000000000000000000000000000 Always unreadable except for me.

Take Care!

You operate with full rights, usually that's dangerously too much.

gcai role form

::

Id:

Right:

Take Care!

You operate with full rights, usually that's dangerously too much.

gcai

Name Vorname
Vorname (select-elements (children (node-list-first (xsl-variable "selected"))) 'firstname)
Name
Kürzel
Oid

Benutzer-Optionen

(let ((roles (xsl-variable "roles")) (rights (node-list-reduce (children (select-elements (children (xsl-variable "selected")) 'rights)) (lambda (c n) (let ((v (node-list->right n))) (or (and v (cons v c)) c))) '()))) (node-list-map (lambda (node) (node-list (make element gi: 'input attributes: `(,@(if (member (node-list->right (node-list-first (select-elements (children node) 'right))) rights) '((checked "checked")) '()) (value ,(attribute-string 'id node)) (name "as") (type "checkbox"))) (children (select-elements (children node) 'description)) (make element gi: 'br))) roles))

(node-list (let ((id (data (form-field 'id (current-node))))) (node-list-filter (lambda (node) (and (match-element? 'person node) (equal? (attribute-string 'id node) id))) (xsl-variable "persons"))) (xsl-variable "schema")) (node-list-map (lambda (node) (cond ((eq? (gi node) 'rights) (make element gi: (gi node) ns: (ns node) (node-list-map (lambda (id) (let ((entry (node-list-filter (lambda (n) (equal? (attribute-string 'id n) id)) (xsl-variable "roles")))) (select-elements (children entry) 'right))) (node-list-map data (form-field 'as (current-node)))))) ((eq? (gi node) 'id) (let ((old (select-elements (children (node-list-first (xsl-variable "selected"))) 'id))) (if (node-list-empty? (children old)) (let ((v (data (node-list-first (form-field 'oid (current-node)))))) (if (and v (string->oid v)) (make element gi: 'id ns: 'mind (literal v)) old)) old))) (else (let ((v (node-list-first (form-field (gi node) (current-node))))) (if (and v (not (equal? (data v) ""))) v (select-elements (xsl-variable "selected") (gi node))))))) (children (node-list-first (xsl-variable "schema")))) (root (let ((this-root (document-element (grove-root (current-node))))) (make element gi: (gi this-root) ns: (ns this-root) attributes: (let loop ((atts (named-node-list-names (attributes this-root)))) (if (null? atts) '() (let* ((name (car atts)) (nms (attribute-ns name this-root)) (value (attribute-string name this-root))) (if value (cons (list nms name value) (loop (cdr atts))) (loop (cdr atts)))))) (node-list-map (lambda (node) (cond ((match-element? 'persons node) (let ((id (attribute-string 'id (node-list-first (xsl-variable "selected"))))) (make element gi: (gi node) ns: (ns node) (if (equal? id "none") (node-list (xsl-variable "new-value") (children node)) (node-list-map (lambda (node) (if (and (match-element? 'person node) (equal? (attribute-string 'id node) id)) (xsl-variable "new-value") node)) (children node)))))) (else node))) ;; The children of the root of the style sheet. (children this-root))))) (root (let* ((reducer (lambda (c n) (let ((v (node-list->right n))) (or (and v (cons v c)) c)))) (roles (node-list-reduce (select-elements (children (xsl-variable "roles")) 'right) reducer '())) (is-in-roles? (lambda (x) (member x roles))) (old (filter is-in-roles? (node-list-reduce (children (select-elements (children (xsl-variable "selected")) 'rights)) reducer '()))) (new (filter is-in-roles? (node-list-reduce (children (select-elements (children (xsl-variable "new-value")) 'rights)) reducer '()))) (whom (literal (string->oid (data (select-elements (children (xsl-variable "new-value")) 'id)))))) (node-list (let loop ((old old)) (if (null? old) (empty-node-list) (if (not (member (car old) new)) (node-list (make element gi: 'revoke ns: 'mind (make element gi: 'from whom) (right->node-list (car old))) (loop (cdr old)))) (loop (cdr old)))) (let loop ((new new)) (if (null? new) (empty-node-list) (if (not (member (car new) old)) (node-list (make element gi: 'grant ns: 'mind (make element gi: 'to whom) (right->node-list (car new)))) (loop (cdr new))))) (loop (cdr new))))) (node-list (let ((id (data (form-field 'id (current-node))))) (node-list-filter (lambda (node) (and (match-element? 'role node) (equal? (attribute-string 'id node) id))) (xsl-variable "roles"))) (xsl-variable "role-schema")) (make element gi: 'role attributes: `((id ,(let* ((f (form-field 'id (current-node))) (v (and f (data f)))) (if (member v '(#f "#f" "none" "")) (error "no id specified") v)))) (node-list (let* ((f (form-field 'right (current-node))) (v (and f (data f)))) (if (member v '(#f "#f" "none" "")) (select-elements (children (node-list-first (xsl-variable "selected"))) 'right) (right->node-list (map string->oid (parsed-locator v))))) (let* ((f (form-field 'description (current-node))) (v (and f (xml-parse (data f))))) (if (equal? "" (data v)) (select-elements (children (node-list-first (xsl-variable "selected"))) 'description) (make element gi: 'description v))))) (root (let ((this-root (document-element (grove-root (current-node))))) (make element gi: (gi this-root) ns: (ns this-root) attributes: (copy-attributes (current-node)) (node-list-map (lambda (node) (cond ((match-element? 'roles node) (let ((id (attribute-string 'id (node-list-first (xsl-variable "selected"))))) (make element gi: (gi node) ns: (ns node) (if (equal? id "none") (node-list (xsl-variable "new-value") (children node)) (node-list-map (lambda (node) (if (and (match-element? 'role node) (equal? (attribute-string 'id node) id)) (xsl-variable "new-value") node)) (children node)))))) (else node))) ;; The children of the root of the style sheet. (children this-root)))))

Source code:

<xsl:stylesheet xmlns:dsssl="http://www.askemos.org/2000/NameSpaceDSSSL" xmlns:mind="http://www.askemos.org/2000/CoreAPI" xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0" xml:space="default">
 <persons>
  <person id="mue">
   <mind:id>A00000000000000000000000000000011</mind:id>
   <name>Müller</name>
   <firstname>Frank</firstname>
   <rights>
    <mind:right>
     <mind:id>A00000000000000000000000000000000</mind:id>
    </mind:right>
   </rights>
  </person>
 </persons>
 <roles>
  <role id="private">
   <mind:right>
    <mind:id>A00000000000000000000000000000000</mind:id>
   </mind:right>
   <description>Always unreadable except for me.</description>
  </role>
 </roles>
 <xsl:variable name="role-schema">
  <role id="none">
   <mind:right></mind:right>
   <description></description>
  </role>
 </xsl:variable>
 <xsl:variable name="schema">
  <person id="none">
   <mind:id></mind:id>
   <name></name>
   <firstname></firstname>
   <rights></rights>
  </person>
 </xsl:variable>
 <xsl:variable name="persons">
  <dsssl:copy-of select="
  (children
   (select-elements (children (grove-root (current-node))) &apos;persons)) "></dsssl:copy-of>
 </xsl:variable>
 <xsl:variable name="roles">
  <dsssl:copy-of select="
  (children
   (select-elements (children (grove-root (current-node))) &apos;roles)) "></dsssl:copy-of>
 </xsl:variable>
 <xsl:template match="*[@type=&quot;read&quot;]">
  <xsl:choose>
   <dsssl:when test="(and (is-meta-form? msg) (service-level))">
<!--
 TODO granted, this MUST be hidden!  -->
    <dsssl:copy-of select="(cdr (assq &apos;body/parsed-xml (car (metaview me msg))))"></dsssl:copy-of>
   </dsssl:when>
   <dsssl:when test="(and (pair? (msg &apos;destination))
                          (equal? (car (msg &apos;destination))
                                  &quot;roles&quot;))">@RoleForm</dsssl:when>
   <xsl:otherwise>@GCAIForm</xsl:otherwise>
  </xsl:choose>
 </xsl:template>
 <xsl:template match="*[@type=&quot;write&quot;]">
  <xsl:choose>
   <dsssl:when test="(and (service-level) (is-meta-form? msg))">
    <xsl:choose>@ChangeCtrl@ProtectCtrl</xsl:choose>
   </dsssl:when>
   <dsssl:when test="
   (and (service-level (me &apos;get &apos;id))
        (equal? (data (form-field &apos;action (current-node)))
                &quot;change-entry&quot;))">@GCAICtrl</dsssl:when>
   <dsssl:when test="
   (and (service-level (me &apos;get &apos;id))
        (equal? (data (form-field &apos;action (current-node)))
                &quot;change-role&quot;))">@RoleCtrl</dsssl:when>
   <xsl:otherwise>
    <dsssl:copy-of select="(error &quot;request not understood&quot;)"></dsssl:copy-of>
   </xsl:otherwise>
  </xsl:choose>
 </xsl:template>
<!--

 ;;; Local Variables: ***
 ;;; mode: dsssl ***
 ;;; End: ***

-->
</xsl:stylesheet>

Diese Seite findet man von: overview, .



Letzte Modifikation: Thu, 06 Feb 2003 14:42:20 +0100

Autor(en):

Dokument Nummer A67bb0753e1676f81983e0ecf3a15b391 geliefert an public um Fri, 25 Jul 2008 16:24:12 +0200