io.lisp

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