<mind:reply 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" xml:space="default">
<xsl:variable name="selected">
<dsssl:copy-of select="#CONTENT">
(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"))
</dsssl:copy-of>
</xsl:variable>
<!--
The new value for the selected persons roles is constructed from the
incoming form data and the old role assignment.
The new role set in the form data is encoded as "<as>" nodes
containing a nick name. The actual rights are selected from the xsl
variable "roles".
The oid field, once set, becomes unchangeable.
Other fields are accepted from the form content.
-->
<xsl:variable name="new-value">
<person>
<xsl:attribute name="id">
<dsssl:copy-of select="
(let* ((f (form-field 'id (current-node)))
(v (and f (data f))))
(if (member v '(#f "#f" "none" ""))
(error "no id specified")
(literal v)))"></dsssl:copy-of>
</xsl:attribute>
<dsssl:copy-of select="#CONTENT">
(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"))))
</dsssl:copy-of>
</person>
</xsl:variable>
<!--
In the new style sheet, we exchange the "<persons>" element adding or
replacing the new value.
dsssl is sort of lousy (read verbose) at that, but xslt is not much
better. We'll need some magic here.
What we do is actually not quite the right thing, because we can't
tell whether the role assignment will succeed. We should store it in
pending queue and wait for an according reply. This looks like
something to automate and subsume in service markup like bigwig.
-->
<dsssl:copy-of select="#CONTENT">
(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)))))
</dsssl:copy-of>
<!--
Now we send a SOAP request to the users place asking to perform the
actual grant operation. This is needed because Askemos currently
knows only direct trust between parties. But control is supposed to
be an extra application.
The SOAP message is sent to the user place of creator of the message
as retrieved from in the DublinCore attribute dc-creator.
The mind:send element conceptually encodes a SOAP envelope and sends
the request. The actualy implementation defers this redundant
operation until it has to really transfer the body out of process.
-->
<mind:send xmlns:env="http://www.w3.org/2001/09/soap-envelope" type="write">
<to>
<dsssl:copy-of select="(msg 'dc-creator)"></dsssl:copy-of>
</to>
<env:Body>
<m:Modification xmlns:m="urn:RightsAdministration">
<dsssl:copy-of select="#CONTENT">
(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)))))
</dsssl:copy-of>
</m:Modification>
</env:Body>
</mind:send>
<!--
;;; Local Variables: ***
;;; mode: dsssl ***
;;; End: ***
-->
</mind:reply>
Diese Seite findet man von: overview, .