[cl-irc-cvs] r189 - trunk
ehuelsmann at common-lisp.net
ehuelsmann at common-lisp.net
Sun Apr 22 08:12:25 UTC 2007
Author: ehuelsmann
Date: Sun Apr 22 04:12:22 2007
New Revision: 189
Modified:
trunk/protocol.lisp
trunk/utility.lisp
Log:
Move 2 utility routines.
Modified: trunk/protocol.lisp
==============================================================================
--- trunk/protocol.lisp (original)
+++ trunk/protocol.lisp Sun Apr 22 04:12:22 2007
@@ -334,46 +334,6 @@
(defun read-message-loop (connection)
(loop while (read-message connection)))
-(defun try-decode-line (line external-formats)
- (loop for external-format in external-formats
- for decoded = nil
- for error = nil
- do (multiple-value-setq (decoded error)
- (handler-case
- (flexi-streams:with-input-from-sequence (in line)
- (let* ((ex-fmt (external-format-fixup external-format))
- (flexi (flexi-streams:make-flexi-stream
- in
- ;; :element-type 'character
- :external-format ex-fmt)))
- (read-line flexi nil nil)))
- (flexi-streams:flexi-stream-encoding-error ()
- nil)))
- if decoded
- do (return decoded)))
-
-(defun read-protocol-line (connection)
- "Reads a line from the input network stream, returning a
-character array with the input read."
- (multiple-value-bind
- (buf buf-len)
- ;; Note: we cannot use read-line here (or any other
- ;; character based functions), since they may cause
- ;; (at this time unwanted) character conversion
- (read-sequence-until (network-stream connection)
- (make-array 1024
- :element-type '(unsigned-byte 8)
- :fill-pointer t)
- '(10))
- (when (< 0 buf-len)
- (setf (fill-pointer buf)
- ;; remove all trailing CR and LF characters
- ;; (This allows non-conforming clients to send CRCRLF
- ;; as a line separator too).
- (or (position-if #'(lambda (x) (member x '(10 13)))
- buf :from-end t :end buf-len)
- buf-len))
- (try-decode-line buf *default-incoming-external-formats*))))
(defmethod read-irc-message ((connection connection))
"Read and parse an IRC-message from the `connection'."
Modified: trunk/utility.lisp
==============================================================================
--- trunk/utility.lisp (original)
+++ trunk/utility.lisp Sun Apr 22 04:12:22 2007
@@ -106,6 +106,24 @@
(setf (getf (cdr new-format) :eol-style) :crlf)
new-format))
+(defun try-decode-line (line external-formats)
+ (loop for external-format in external-formats
+ for decoded = nil
+ for error = nil
+ do (multiple-value-setq (decoded error)
+ (handler-case
+ (flexi-streams:with-input-from-sequence (in line)
+ (let* ((ex-fmt (external-format-fixup external-format))
+ (flexi (flexi-streams:make-flexi-stream
+ in
+ ;; :element-type 'character
+ :external-format ex-fmt)))
+ (read-line flexi nil nil)))
+ (flexi-streams:flexi-stream-encoding-error ()
+ nil)))
+ if decoded
+ do (return decoded)))
+
(defun read-byte-no-hang (stream &optional eof-error-p eof-value)
(declare (optimize (speed 3) (debug 0) (safety 0)))
(when (listen stream)
@@ -140,6 +158,30 @@
(= limit-cur limit-max))
do (return (values target (1+ targ-cur) nil)))))
+(defun read-protocol-line (connection)
+ "Reads a line from the input network stream, returning a
+character array with the input read."
+ (multiple-value-bind
+ (buf buf-len)
+ ;; Note: we cannot use read-line here (or any other
+ ;; character based functions), since they may cause
+ ;; (at this time unwanted) character conversion
+ (read-sequence-until (network-stream connection)
+ (make-array 1024
+ :element-type '(unsigned-byte 8)
+ :fill-pointer t)
+ '(10))
+ (when (< 0 buf-len)
+ (setf (fill-pointer buf)
+ ;; remove all trailing CR and LF characters
+ ;; (This allows non-conforming clients to send CRCRLF
+ ;; as a line separator too).
+ (or (position-if #'(lambda (x) (member x '(10 13)))
+ buf :from-end t :end buf-len)
+ buf-len))
+ (try-decode-line buf *default-incoming-external-formats*))))
+
+
(defun substring (string start &optional end)
(let* ((end-index (if end end (length string)))
(seq-len (- end-index start)))
More information about the cl-irc-cvs
mailing list