Function: CREATE-DB-ASSOC-CALLBACK

Source

(defun create-db-assoc-callback (fun &optional name)
  (let ((callback-fun (if name name (gensym "DB_ASSOC_CALLBACK"))))
      (get-callback
       (eval
	`(defcallback ,callback-fun :int ((secondary :pointer)
					  (key-dbt :pointer)
					  (data-dbt :pointer)
					  (ret-dbt :pointer))
	  (with-foreign-slots ((data size) key-dbt DBT)
	    (let ((key-data data)
		  (key-size size))
	      (with-foreign-slots ((data size) data-dbt DBT)
		(let ((data-data data)
		      (data-size size))
		  (multiple-value-bind (use-data ret-ptr ret-size)
		      (funcall ,fun
			       secondary
			       key-data key-size
			       data-data data-size)
		    (if use-data
			(progn
			  (with-foreign-slots ((data size flags) ret-dbt DBT)
			    (setf data ret-ptr ;;buffer is freed by DB
				  size ret-size
				  flags 1))	;;DB_DBT_APPMALLOC
			  0)
			-30998)))))))))))