Tatsuya BIZENN
bizen****@arthu*****
2004年 1月 23日 (金) 17:52:13 JST
はじめまして。備前と申します。
rfc.mimeを使って添付ファイルを処理するフィルタを作成中、
ある程度以上大きなMIMEパートをmime-retrieve-bodyで処理
しようとすると、
*** ERROR: too many arguments (42626) to apply
といわれて落ちることに気がつきました。原因になっているのは
string-concatenateの実装なのですが、以下の方がいいのでは
ないかと考えます。
Index: lib/srfi-13/revapp.scm
===================================================================
RCS file: /cvsroot/gauche/Gauche/lib/srfi-13/revapp.scm,v
retrieving revision 1.5
diff -u -r1.5 revapp.scm
--- lib/srfi-13/revapp.scm 5 Jul 2003 03:29:12 -0000 1.5
+++ lib/srfi-13/revapp.scm 22 Jan 2004 10:06:46 -0000
@@ -53,10 +53,18 @@
(string-substitute! s start rev))))
(define (string-concatenate list)
- (apply string-append list)) ;; fixme
+ (let loop ((l list)
+ (out (open-output-string))
+ (incomplete? #f))
+ (if (null? l)
+ (if incomplete?
+ (string-complete->incomplete (get-output-string out))
+ (get-output-string out))
+ (let ((e (car l)))
+ (display e out)
+ (loop (cdr l) out (or incomplete? (string-incomplete? e)))))))
-(define (string-concatenate/shared list)
- (apply string-append list)) ;; fixme
+(define string-concatenate/shared string-concatenate)
(define string-append/shared string-append)
本当はapplyの最後の引数のリスト長制限をなくす方がいいのかもしれ
ませんが、わたしの手には余りました。
また、mime-retrieve-body内のread-base64はbase64なパート全体を
いったん文字列のリストにした後つないでいるので、ややもったい
ない気がします。全てをオンメモりに読み込んで処理するなら、
Index: lib/rfc/mime.scm
===================================================================
RCS file: /cvsroot/gauche/Gauche/lib/rfc/mime.scm,v
retrieving revision 1.5
diff -u -r1.5 mime.scm
--- lib/rfc/mime.scm 16 Dec 2003 06:05:19 -0000 1.5
+++ lib/rfc/mime.scm 23 Jan 2004 06:01:11 -0000
@@ -245,13 +245,16 @@
(loop (reader inp) #t))))
(define (read-base64)
- (let ((lines (port->list reader inp)))
- (with-output-to-port outp
- (lambda ()
- (with-input-from-string (string-concatenate lines)
- (lambda ()
- (with-port-locking (current-input-port)
- base64-decode)))))))
+ (define (base64-output string out)
+ (with-input-from-string string
+ (lambda () (with-output-to-port out base64-decode))))
+ (let ((buf (open-output-string)))
+ (let loop ((line (reader inp)))
+ (unless (eof-object? line)
+ (display line buf)
+ (loop (reader inp))))
+ (base64-output (get-output-string buf) outp))
+ )
(with-port-locking inp
(lambda ()
パートが大きくても一定量のメモリで処理するなら遅いですが
Index: lib/rfc/mime.scm
===================================================================
RCS file: /cvsroot/gauche/Gauche/lib/rfc/mime.scm,v
retrieving revision 1.5
diff -u -r1.5 mime.scm
--- lib/rfc/mime.scm 16 Dec 2003 06:05:19 -0000 1.5
+++ lib/rfc/mime.scm 23 Jan 2004 06:12:28 -0000
@@ -245,13 +245,14 @@
(loop (reader inp) #t))))
(define (read-base64)
- (let ((lines (port->list reader inp)))
- (with-output-to-port outp
- (lambda ()
- (with-input-from-string (string-concatenate lines)
- (lambda ()
- (with-port-locking (current-input-port)
- base64-decode)))))))
+ (define (base64-output string out)
+ (with-input-from-string string
+ (lambda () (with-output-to-port out base64-decode))))
+ (let loop ((line (reader inp)))
+ (unless (eof-object? line)
+ (base64-output line outp)
+ (loop (reader inp))))
+ )
(with-port-locking inp
(lambda ()
とでもした方が良いのではないかと思います。
--
備前 達矢