mu-scm: add filename procedure for mime-part
This commit is contained in:
@ -121,10 +121,14 @@
|
|||||||
((index . 2) (content-type . "image/jpeg") (size . 21566) (filename . "custer.jpg")))
|
((index . 2) (content-type . "image/jpeg") (size . 21566) (filename . "custer.jpg")))
|
||||||
(map (lambda (part) (mime-part->alist part)) (mime-parts msg)))
|
(map (lambda (part) (mime-part->alist part)) (mime-parts msg)))
|
||||||
|
|
||||||
|
(test-equal "mime-part-0" (filename (list-ref (mime-parts msg) 0)))
|
||||||
|
(test-equal "sittingbull.jpg" (filename (list-ref (mime-parts msg) 1)))
|
||||||
|
(test-equal "custer.jpg" (filename (list-ref (mime-parts msg) 2)))
|
||||||
|
|
||||||
(let* ((part (list-ref (mime-parts msg) 1))
|
(let* ((part (list-ref (mime-parts msg) 1))
|
||||||
(alist (mime-part->alist part))
|
(alist (mime-part->alist part))
|
||||||
(fname (format #f "~a/~a" tmpdir (assoc-ref alist 'filename))))
|
(fname (format #f "~a/~a" tmpdir (assoc-ref alist 'filename))))
|
||||||
(write-to-file part #:filename fname)
|
(write-to-file part #:path fname)
|
||||||
(test-assert (access? fname R_OK))
|
(test-assert (access? fname R_OK))
|
||||||
;; note, the 23881 is the _encoded_ size.
|
;; note, the 23881 is the _encoded_ size.
|
||||||
(test-equal 17674 (stat:size (stat fname))))
|
(test-equal 17674 (stat:size (stat fname))))
|
||||||
|
|||||||
@ -28,6 +28,7 @@
|
|||||||
<mime-part>
|
<mime-part>
|
||||||
mime-part->alist
|
mime-part->alist
|
||||||
make-port
|
make-port
|
||||||
|
filename
|
||||||
write-to-file
|
write-to-file
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Message
|
;; Message
|
||||||
@ -159,27 +160,33 @@ If DECODE? is #t, decode the content (from e.g., base64); in that case,
|
|||||||
CONTENT-ONLY? is implied to be #t."
|
CONTENT-ONLY? is implied to be #t."
|
||||||
(cc-mime-make-stream-port (slot-ref mime-part 'mimepart) content-only? decode?))
|
(cc-mime-make-stream-port (slot-ref mime-part 'mimepart) content-only? decode?))
|
||||||
|
|
||||||
(define* (make-output-file mime-part #:key (filename #f) (overwrite? #f))
|
(define-method (filename (mime-part <mime-part>))
|
||||||
|
"Determine the file-name for MIME-part.
|
||||||
|
Either the 'filename' field in the mime-part and if that does not exist, use
|
||||||
|
'mime-part-<index>' with <index> being the number of the mime-part."
|
||||||
|
(let ((alist (mime-part->alist mime-part)))
|
||||||
|
(or (assoc-ref alist 'filename)
|
||||||
|
(format #f "mime-part-~d" (assoc-ref alist 'index)))))
|
||||||
|
|
||||||
|
(define* (make-output-file mime-part #:key (path #f) (overwrite? #f))
|
||||||
"Create a port for the file to write MIME-PART to.
|
"Create a port for the file to write MIME-PART to.
|
||||||
|
|
||||||
FILENAME is the path to the file name. If not specified, use the 'filename'
|
PATH is file-name or path to the file name. If not specified, use the 'filename'
|
||||||
field in the mime-part and if that does not exist, use 'mime-part-<index>' with
|
field in the mime-part and if that does not exist, use 'mime-part-<index>' with
|
||||||
<index> being the number of the mime-part.
|
<index> being the number of the mime-part.
|
||||||
|
|
||||||
OVERWRITE? specifies whether existing files by the same name or overwritten.
|
OVERWRITE? specifies whether existing files by the same name or overwritten.
|
||||||
Otherwise, trying to overwrite an existing file raises an error."
|
Otherwise, trying to overwrite an existing file raises an error."
|
||||||
(let* ((alist (mime-part->alist mime-part))
|
(let* ((alist (mime-part->alist mime-part))
|
||||||
(filename (or filename
|
(path (or path (filename mime-part))))
|
||||||
(assoc-ref alist 'filename)
|
|
||||||
(format #f "mime-part-~d" (assoc-ref alist 'index)))))
|
|
||||||
;; we need an fd-based port since we want to support overwrite?
|
;; we need an fd-based port since we want to support overwrite?
|
||||||
(open filename
|
(open path
|
||||||
(logior O_WRONLY O_CREAT O_TRUNC (if overwrite? O_EXCL 0)) #o644)))
|
(logior O_WRONLY O_CREAT O_TRUNC (if overwrite? O_EXCL 0)) #o644)))
|
||||||
|
|
||||||
(define* (write-to-file mime-part #:key (filename #f) (overwrite? #f))
|
(define* (write-to-file mime-part #:key (path #f) (overwrite? #f))
|
||||||
"Write MIME-PART to a file.
|
"Write MIME-PART to a file.
|
||||||
|
|
||||||
FILENAME is the path to the file name. If not specified, use the 'filename'
|
PATH is the path/filename for the file. If not specified, use the 'filename'
|
||||||
field in the mime-part and if that does not exist, use 'mime-part-<index>' with
|
field in the mime-part and if that does not exist, use 'mime-part-<index>' with
|
||||||
<index> being the number of the mime-part.
|
<index> being the number of the mime-part.
|
||||||
|
|
||||||
@ -187,7 +194,7 @@ OVERWRITE? specifies whether existing files by the same name or overwritten.
|
|||||||
Otherwise, trying to overwrite an existing file raises an error."
|
Otherwise, trying to overwrite an existing file raises an error."
|
||||||
(let* ((input (make-port mime-part))
|
(let* ((input (make-port mime-part))
|
||||||
(output (make-output-file mime-part
|
(output (make-output-file mime-part
|
||||||
#:filename filename #:overwrite? overwrite?))
|
#:path path #:overwrite? overwrite?))
|
||||||
(buf (make-bytevector 4096)) ;; just a guess...
|
(buf (make-bytevector 4096)) ;; just a guess...
|
||||||
(bytes 0))
|
(bytes 0))
|
||||||
(while (not (eof-object? bytes)) ;; XXX do this in a more elegant way.
|
(while (not (eof-object? bytes)) ;; XXX do this in a more elegant way.
|
||||||
|
|||||||
@ -515,12 +515,20 @@ case, @code{content-only?} is implied to be #t.
|
|||||||
Write MIME-part to file.
|
Write MIME-part to file.
|
||||||
|
|
||||||
Use @code{filename} is the file/path to use for writing; if this is @code{#f},
|
Use @code{filename} is the file/path to use for writing; if this is @code{#f},
|
||||||
the name is taken from the @t{filename} property of the MIME-part alist. If that
|
the name using the @code{filename} procedure.
|
||||||
does not exist, a generic name is chosen.
|
|
||||||
|
|
||||||
If @code{overwrite?} is true, overwrite existing files of the same name;
|
If @code{overwrite?} is true, overwrite existing files of the same name;
|
||||||
otherwise, raise an error if the file already exists.
|
otherwise, raise an error if the file already exists.
|
||||||
|
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} filename mime-part
|
||||||
|
@end deffn
|
||||||
|
Determine a filename for the given MIME-part.
|
||||||
|
|
||||||
|
This is either taken from the @t{filename} property of the MIME-part alist, or,
|
||||||
|
If that does not exist, a generic name.
|
||||||
|
|
||||||
|
|
||||||
@subsection Contacts
|
@subsection Contacts
|
||||||
|
|
||||||
Message fields @t{To:}, @t{From:}, @t{Cc:} and @t{Bcc:} contain @emph{contacts}.
|
Message fields @t{To:}, @t{From:}, @t{Cc:} and @t{Bcc:} contain @emph{contacts}.
|
||||||
|
|||||||
Reference in New Issue
Block a user