write.lisp

   1 (in-package :clldap)
   2
   3 (defun write-attributes (attributes &optional (stream *standard-output*))
   4   (dolist (attribute attributes)
   5       (let ((attribute-name (car attribute)))
   6         (dolist (attribute-value (cdr attribute))
   7           (format stream "~A: ~A~%" attribute-name (cadr attribute-value))))))
   8
   9 (defun write-record (record &optional (stream *standard-output*))
  10   "Writes the data record RECORD as LDIF to STREAM."
  11   (destructuring-bind (distinguished-name object-classes attributes)
  12       record
  13     (format stream "dn: ~A~%" distinguished-name)
  14     (format stream "~{objectClass: ~A~%~}" (mapcar 'cadr object-classes))
  15     (write-attributes attributes stream)
  16     (terpri stream)))
  17
  18 (defun fold-object-classes-and-attributes (object-classes attributes)
  19   (if object-classes
  20               (cons (cons "objectClass" object-classes)
  21                     attributes)
  22               attributes))
  23
  24 (defun write-change-record (record &optional (stream *standard-output*))
  25   "Writes the change record RECORD as LDIF to STREAM."
  26   (destructuring-bind (distinguished-name change-type attributes)
  27       record
  28     (format stream "dn: ~A~%" distinguished-name)
  29     (format stream "changetype: ~A~%" (ecase change-type
  30                                         ((add delete modify)
  31                                          (string-downcase (symbol-name change-type)))))
  32     (ecase change-type
  33       (add (write-attributes attributes stream))
  34       (delete (assert (null attributes)))
  35       (modify
  36        (dolist (attribute attributes)
  37          (destructuring-bind (attribute-name attribute-action &rest attribute-values)
  38              attribute
  39            (format stream "~A: ~A~%"
  40                    (ecase attribute-action
  41                      ((add replace delete)
  42                       (string-downcase (symbol-name attribute-action))))
  43                    attribute-name)
  44            (dolist (attribute-value attribute-values)
  45              (format stream "~A: ~A~%" attribute-name (cadr attribute-value))))
  46          (format stream "-~%"))))
  47     (terpri stream)))