[isidorus-cvs] r702 - trunk/playground

lgiessmann at common-lisp.net lgiessmann at common-lisp.net
Tue Aug 2 08:06:00 UTC 2011


Author: lgiessmann
Date: Tue Aug  2 01:05:59 2011
New Revision: 702

Log:
trunk: playground: replaced string-starts-with and string-ends-with by the correpondings functions defined in 'base-tools'

Modified:
   trunk/playground/tcp-connector.lisp

Modified: trunk/playground/tcp-connector.lisp
==============================================================================
--- trunk/playground/tcp-connector.lisp	Tue Aug  2 00:54:16 2011	(r701)
+++ trunk/playground/tcp-connector.lisp	Tue Aug  2 01:05:59 2011	(r702)
@@ -84,11 +84,11 @@
   (handler-case
       (let ((client-data (read-from-client client-socket)))
 	(let ((response
-	       (cond ((string-starts-with (first (getf client-data :headers))
-					  "GET /json/psis")
+	       (cond ((tools:string-starts-with (first (getf client-data :headers))
+						"GET /json/psis")
 		      (get-psis))
-		     ((string-starts-with (first (getf client-data :headers))
-					  "GET /json/get/")
+		     ((tools-string-starts-with (first (getf client-data :headers))
+						"GET /json/get/")
 		      (get-fragment (get-requested-psi-of-http-header
 				     (first (getf client-data :headers)))))
 		     (t
@@ -133,49 +133,15 @@
 
 (defun get-requested-psi-of-http-header (first-header-line)
   (declare (String first-header-line))
-  (when (and (string-starts-with first-header-line "GET /json/get/")
-	     (or (string-ends-with first-header-line "HTTP/1.0")
-		 (string-ends-with first-header-line "HTTP/1.1")))
+  (when (and (tools:string-starts-with first-header-line "GET /json/get/")
+	     (or (tools:string-ends-with first-header-line "HTTP/1.0")
+		 (tools:string-ends-with first-header-line "HTTP/1.1")))
     (let ((psi (subseq first-header-line
 		       (length "GET /json/get/")
 		       (- (length first-header-line) (length "HTTP/1.0")))))
       (hunchentoot:url-decode (string-trim '(#\space) psi)))))
     
 
-(defun string-starts-with (str prefix &key (ignore-case nil))
-  "Checks if string str starts with a given prefix."
-  (declare (String str prefix)
-	   (Boolean ignore-case))
-  (let ((str-i (if ignore-case
-		   (string-downcase str :start 0 :end (min (length str)
-							   (length prefix)))
-		   str))
-	(prefix-i (if ignore-case
-		      (string-downcase prefix)
-		      prefix)))
-    (string= str-i prefix-i :start1 0 :end1
-	     (min (length prefix-i)
-		  (length str-i)))))
-
-
-(defun string-ends-with (str suffix &key (ignore-case nil))
-  "Checks if string str ends with a given suffix."
-  (declare (String str suffix)
-	   (Boolean ignore-case))
-  (let ((str-i (if ignore-case
-		   (string-downcase str :start (max (- (length str)
-						       (length suffix))
-						    0)
-				    :end (length str))
-		   str))
-	(suffix-i (if ignore-case
-		      (string-downcase suffix)
-		      suffix)))
-    (string= str-i suffix-i :start1 (max (- (length str)
-					    (length suffix))
-					 0))))
-
-
 (defun main()
   (format t ">> entered (main)")
   (base-tools:open-tm-store "/home/lukas/.sbcl/site/isidorus/trunk/src/data_base")




More information about the Isidorus-cvs mailing list