(blog ‘lucindo)

Como programador ele é um ótimo businessman

Um snippet de teste que eu fiz para um serviço REST usando Hunchentoot.

Usando função genérica é possível fazer um “pattern matching” e a implementação fica parecida com Erlang/YAWS (a vir no BedDB).

(eval-when (:load-toplevel :compile-toplevel :execute)
  (require ‘hunchentoot))

(defpackage :ht-rest
  (:use :common-lisp :hunchentoot))

(in-package :ht-rest)

(defun add-dispatcher (dispatcher-fn)
  “Helper function to add dispatcher functions to dispatch table”
  (nconc *dispatch-table* (list dispatcher-fn)))

(defun create-dispatcher (url-prefix handler &key (regexp nil))
  “Creates a dispatcher and add it to dispatch table given the
url prefix and handler function. The url prefix can be a regular
expression (in this case set the :regexp keyword).”
  (let ((dispatcher-fn
         (funcall
          (if regexp ‘create-regexex-dispatcher ‘create-prefix-dispatcher)
          url-prefix handler)))
    (add-dispatcher dispatcher-fn)))

(defun handle-rest ()
  “Simply delegate to appropriate handler”
  (handle (request-method)))

(defgeneric handle (request-method)
  (:documentation “Generic REST handler”))

(defmethod handle :before (request-method)
  (log-message :info “REST in: [method ~a] [target ~a] [qs ~s]”
               (request-method) (script-name) (query-string)))

(defmethod handle :after (request-method)
  (log-message :info “REST out: [code ~a] [method ~a] [target ~a] [qs ~s]”
               (return-code) (request-method)
               (script-name) (query-string)))

(defmethod handle ((request-method (eql :get)))
  (string (request-method)))

(defmethod handle ((request-method (eql :post)))
  (string (request-method)))

(defmethod handle ((request-method (eql :put)))
  (string (request-method)))

(defmethod handle ((request-method (eql :delete)))
  (string (request-method)))

(defmethod handle (request-method)
  (setf (return-code) +http-method-not-allowed+))

(defvar *ht-server* nil)

(defun setup ()
  (create-dispatcher “/rest” ‘handle-rest))

(defun start (&optional (setup-p t))
  (prog1
      (setq  *show-lisp-errors-p* t
             *show-lisp-backtraces-p* t
             *dispatch-table* (list ‘dispatch-easy-handlers)
             *ht-server* (start-server :port 8080))
    (when setup-p (setup))))

(defun stop ()
  (stop-server *ht-server*))

(defun re-start ()
  (progn
    (stop)
    (start nil)))