Skip to content
Browse files

cl-ppcre を外さないとタイムアウトしちゃう。

イメージダンプが欲しい。
  • Loading branch information...
1 parent cb66ce3 commit c566012c58ee043709ed69541d233bd39b72ab95 @quek committed Dec 13, 2009
Showing with 15 additions and 8 deletions.
  1. +1 −1 war/WEB-INF/lisp/gae.asd
  2. +14 −7 war/WEB-INF/lisp/servlet.lisp
View
2 war/WEB-INF/lisp/gae.asd
@@ -8,4 +8,4 @@
(:file "foo")
(:file "bar")
)
- :depends-on (abcl-helper cl-who cl-ppcre))
+ :depends-on (abcl-helper cl-who))
View
21 war/WEB-INF/lisp/servlet.lisp
@@ -14,15 +14,22 @@
;; (asdf:oos 'asdf:load-op :gae)
(handler-case
(progn
- (let ((url (j:jcc *request* |getRequestURL| |toString|)))
- (ppcre:register-groups-bind
- ((#'string-upcase package-name symbol-name))
- (".*/([^/]+)/([^?#/]+)" url)
- (let ((symbol (intern symbol-name package-name)))
- (funcall symbol)
- (force-output)))))
+ (let* ((url (j:jcc *request* |getRequestURL| |toString|))
+ (symbol (compute-route url)))
+ (funcall symbol)
+ (force-output)))
(java::java-exception (x)
(format t "Java Exception: ~a~%" x)
(|printStackTrace| (java:java-exception-cause x)))
(condition (x)
(format t "Error: ~a~%" x))))
+
+(defun compute-route (url)
+ (let* ((p1 (position #\/ url :from-end t))
+ (p2 (position #\/ url :from-end t :end p1))
+ (package (subseq url (1+ p2) p1))
+ (symbol (subseq url (1+ p1))))
+ (dolist (i '(#\? #\#))
+ (let ((p (position i symbol)))
+ (when p (setf symbol (subseq symbol 0 p)))))
+ (intern (string-upcase symbol) (string-upcase package))))

0 comments on commit c566012

Please sign in to comment.
Something went wrong with that request. Please try again.