1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
;; Copyright (c) 2002-2006, Edward Marco Baringer
;; All rights reserved.
(in-package :alexandria)
(defmacro with-open-file* ((stream filespec &key direction element-type
if-exists if-does-not-exist external-format)
&body body)
"Just like WITH-OPEN-FILE, but NIL values in the keyword arguments mean to use
the default value specified for OPEN."
(once-only (direction element-type if-exists if-does-not-exist external-format)
`(with-open-stream
(,stream (apply #'open ,filespec
(append
(when ,direction
(list :direction ,direction))
(when ,element-type
(list :element-type ,element-type))
(when ,if-exists
(list :if-exists ,if-exists))
(when ,if-does-not-exist
(list :if-does-not-exist ,if-does-not-exist))
(when ,external-format
(list :external-format ,external-format)))))
,@body)))
(defmacro with-input-from-file ((stream-name file-name &rest args
&key (direction nil direction-p)
&allow-other-keys)
&body body)
"Evaluate BODY with STREAM-NAME to an input stream on the file
FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT,
which is only sent to WITH-OPEN-FILE when it's not NIL."
(declare (ignore direction))
(when direction-p
(error "Can't specify :DIRECTION for WITH-INPUT-FROM-FILE."))
`(with-open-file* (,stream-name ,file-name :direction :input ,@args)
,@body))
(defmacro with-output-to-file ((stream-name file-name &rest args
&key (direction nil direction-p)
&allow-other-keys)
&body body)
"Evaluate BODY with STREAM-NAME to an output stream on the file
FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT,
which is only sent to WITH-OPEN-FILE when it's not NIL."
(declare (ignore direction))
(when direction-p
(error "Can't specify :DIRECTION for WITH-OUTPUT-TO-FILE."))
`(with-open-file* (,stream-name ,file-name :direction :output ,@args)
,@body))
(defun read-stream-content-into-string (stream &key (buffer-size 4096))
"Return the \"content\" of STREAM as a fresh string."
(check-type buffer-size positive-integer)
(let ((*print-pretty* nil))
(with-output-to-string (datum)
(let ((buffer (make-array buffer-size :element-type 'character)))
(loop
:for bytes-read = (read-sequence buffer stream)
:do (write-sequence buffer datum :start 0 :end bytes-read)
:while (= bytes-read buffer-size))))))
(defun read-file-into-string (pathname &key (buffer-size 4096) external-format)
"Return the contents of the file denoted by PATHNAME as a fresh string.
The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE
unless it's NIL, which means the system default."
(with-input-from-file
(file-stream pathname :external-format external-format)
(read-stream-content-into-string file-stream :buffer-size buffer-size)))
(defun write-string-into-file (string pathname &key (if-exists :error)
if-does-not-exist
external-format)
"Write STRING to PATHNAME.
The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE
unless it's NIL, which means the system default."
(with-output-to-file (file-stream pathname :if-exists if-exists
:if-does-not-exist if-does-not-exist
:external-format external-format)
(write-sequence string file-stream)))
(defun read-stream-content-into-byte-vector (stream &key ((%length length))
(initial-size 4096))
"Return \"content\" of STREAM as freshly allocated (unsigned-byte 8) vector."
(check-type length (or null non-negative-integer))
(check-type initial-size positive-integer)
(do ((buffer (make-array (or length initial-size)
:element-type '(unsigned-byte 8)))
(offset 0)
(offset-wanted 0))
((or (/= offset-wanted offset)
(and length (>= offset length)))
(if (= offset (length buffer))
buffer
(subseq buffer 0 offset)))
(unless (zerop offset)
(let ((new-buffer (make-array (* 2 (length buffer))
:element-type '(unsigned-byte 8))))
(replace new-buffer buffer)
(setf buffer new-buffer)))
(setf offset-wanted (length buffer)
offset (read-sequence buffer stream :start offset))))
(defun read-file-into-byte-vector (pathname)
"Read PATHNAME into a freshly allocated (unsigned-byte 8) vector."
(with-input-from-file (stream pathname :element-type '(unsigned-byte 8))
(read-stream-content-into-byte-vector stream '%length (file-length stream))))
(defun write-byte-vector-into-file (bytes pathname &key (if-exists :error)
if-does-not-exist)
"Write BYTES to PATHNAME."
(check-type bytes (vector (unsigned-byte 8)))
(with-output-to-file (stream pathname :if-exists if-exists
:if-does-not-exist if-does-not-exist
:element-type '(unsigned-byte 8))
(write-sequence bytes stream)))
(defun copy-file (from to &key (if-to-exists :supersede)
(element-type '(unsigned-byte 8)) finish-output)
(with-input-from-file (input from :element-type element-type)
(with-output-to-file (output to :element-type element-type
:if-exists if-to-exists)
(copy-stream input output
:element-type element-type
:finish-output finish-output))))
(defun copy-stream (input output &key (element-type (stream-element-type input))
(buffer-size 4096)
(buffer (make-array buffer-size :element-type element-type))
(start 0) end
finish-output)
"Reads data from INPUT and writes it to OUTPUT. Both INPUT and OUTPUT must
be streams, they will be passed to READ-SEQUENCE and WRITE-SEQUENCE and must have
compatible element-types."
(check-type start non-negative-integer)
(check-type end (or null non-negative-integer))
(check-type buffer-size positive-integer)
(when (and end
(< end start))
(error "END is smaller than START in ~S" 'copy-stream))
(let ((output-position 0)
(input-position 0))
(unless (zerop start)
;; FIXME add platform specific optimization to skip seekable streams
(loop while (< input-position start)
do (let ((n (read-sequence buffer input
:end (min (length buffer)
(- start input-position)))))
(when (zerop n)
(error "~@<Could not read enough bytes from the input to fulfill ~
the :START ~S requirement in ~S.~:@>" 'copy-stream start))
(incf input-position n))))
(assert (= input-position start))
(loop while (or (null end) (< input-position end))
do (let ((n (read-sequence buffer input
:end (when end
(min (length buffer)
(- end input-position))))))
(when (zerop n)
(if end
(error "~@<Could not read enough bytes from the input to fulfill ~
the :END ~S requirement in ~S.~:@>" 'copy-stream end)
(return)))
(incf input-position n)
(write-sequence buffer output :end n)
(incf output-position n)))
(when finish-output
(finish-output output))
output-position))
|
