;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Jun 2003
;;;;
-;;;; $Id: listener.lisp,v 1.6 2003/07/13 04:53:32 kevin Exp $
+;;;; $Id: listener.lisp,v 1.7 2003/07/16 16:01:37 kevin Exp $
;;;; *************************************************************************
(in-package #:kmrcl)
;; Low-level functions
(defun next-server-name (base-name)
- (format nil "~A-socket-server-~D" base-name (incf *listener-count*)))
+ (format nil "~D-~A-socket-server" (incf *listener-count*) base-name))
(defun next-worker-name (base-name)
- (format nil "~A-worker-~D" base-name (incf *worker-count*)))
+ (format nil "~D-~A-worker" (incf *worker-count*) base-name))
(defun make-socket-server (listener)
#+lispworks
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: package.lisp,v 1.50 2003/07/14 04:10:02 kevin Exp $
+;;;; $Id: package.lisp,v 1.51 2003/07/16 16:01:37 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
#:last-char
#:ensure-string
#:string-right-trim-one-char
+ #:string-strip-ending
#:flatten
#:init/listener
#:stop-all/listener
#:listener
+
+ ;; fformat.lisp
+ #:fformat
+
))
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: strings.lisp,v 1.47 2003/07/09 19:19:19 kevin Exp $
+;;;; $Id: strings.lisp,v 1.48 2003/07/16 16:01:37 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(declare (type (integer 0 15) n))
(schar +hex-chars+ n))
-(defconstant +char-code-0+ (char-code #\0))
+(defconstant +char-code-lower-a+ (char-code #\a))
(defconstant +char-code-upper-a+ (char-code #\A))
-(declaim (type fixnum +char-code-0+ +char-code-upper-a+))
+(defconstant +char-code-0+ (char-code #\0))
+(declaim (type fixnum +char-code-0+ +char-code-upper-a+
+ +char-code-0))
(defun charhex (ch)
"convert hex character to decimal"
(setf (schar str dpos) ch)))))
-(defconstant +char-code-a+ (char-code #\a))
-(defun random-string (&optional (len 10))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defvar +unambigous-charset+
+ "abcdefghjkmnpqrstuvwxyz123456789ABCDEFGHJKLMNPQSRTUVWXYZ")
+ (defconstant +unambigous-length+ (length +unambigous-charset+)))
+
+(defun random-char (&optional (set :lower-alpha))
+ (ecase set
+ (:lower-alpha
+ (code-char (+ +char-code-lower-a+ (random 26))))
+ (:lower-alphanumeric
+ (let ((n (random 36)))
+ (if (>= n 26)
+ (code-char (+ +char-code-0+ (- n 26)))
+ (code-char (+ +char-code-lower-a+ n)))))
+ (:upper-alpha
+ (code-char (+ +char-code-upper-a+ (random 26))))
+ (:unambigous
+ (schar +unambigous-charset+ (random +unambigous-length+)))
+ (:upper-lower-alpha
+ (let ((n (random 52)))
+ (if (>= n 26)
+ (code-char (+ +char-code-upper-a+ (- n 26)))
+ (code-char (+ +char-code-lower-a+ n)))))))
+
+
+(defun random-string (&key (length 10) (set :lower-alpha))
"Returns a random lower-case string."
(declare (optimize (speed 3)))
- (let ((s (make-string len)))
+ (let ((s (make-string length)))
(declare (simple-string s))
- (dotimes (i len s)
- (setf (schar s i)
- (code-char (+ +char-code-a+ (random 26)))))))
+ (dotimes (i length s)
+ (setf (schar s i) (random-char set)))))
(defun first-char (s)
str)))
+(defun string-strip-ending (str endings)
+ (if (stringp endings)
+ (setq endings (list endings)))
+ (let ((len (length str)))
+ (dolist (ending endings str)
+ (when (and (>= len (length ending))
+ (string-equal ending
+ (subseq str (- len
+ (length ending)))))
+ (return-from string-strip-ending
+ (subseq str 0 (- len (length ending))))))))
+
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: symbols.lisp,v 1.2 2003/06/06 21:59:30 kevin Exp $
+;;;; $Id: symbols.lisp,v 1.3 2003/07/16 16:01:37 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;; Symbol functions
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (when (char= #\a (symbol-name '#:a))
+ (pushnew :lowercase-reader *features*)))
+
+(defun string-default-case (str)
+ #+(and (not case-sensitive) (not lowercase-reader))
+ (string-upcase str)
+ #+(and (not case-sensitive) lowercase-reader)
+ (string-downcase str)
+ #+case-sensitive
+ str)
+
(defun concat-symbol-pkg (pkg &rest args)
(declare (dynamic-extent args))
(flet ((stringify (arg)
(symbol
(symbol-name arg)))))
(let ((str (apply #'concatenate 'string (mapcar #'stringify args))))
- (intern #-case-sensitive (string-upcase str)
- #+case-sensitive str
+ (intern (string-default-case str)
(if pkg pkg *package*)))))
"Returns keyword for a name"
(etypecase name
(keyword name)
- (string (intern #-case-sensitive (string-upcase name)
- #+case-sensitive name
- :keyword))
+ (string (intern (string-default-case name) :keyword))
(symbol (intern (symbol-name name) :keyword))))
(defun show (&optional (what :variables) (package *package*))
;;;; Author: Kevin M. Rosenberg
;;;; Date Started: Apr 2003
;;;;
-;;;; $Id: tests.lisp,v 1.21 2003/07/01 22:16:40 kevin Exp $
+;;;; $Id: tests.lisp,v 1.22 2003/07/16 16:01:37 kevin Exp $
;;;;
;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
;;;;
(deftest duqs.4 (decode-uri-query-string "abc+d") "abc d")
(deftest duqs.5 (decode-uri-query-string "abc%20d") "abc d")
+(deftest sse.1 (string-strip-ending "" nil) "")
+(deftest sse.2 (string-strip-ending "abc" nil) "abc")
+(deftest sse.3 (string-strip-ending "abc" "ab") "abc")
+(deftest sse.4 (string-strip-ending "abc" '("ab")) "abc")
+(deftest sse.5 (string-strip-ending "abcd" '("a" "cd")) "ab")
+
;;; MOP Testing
(eval-when (:compile-toplevel :load-toplevel :execute)