changeset 693: |
5f81d888c31f |
parent: |
32bd859533b3
|
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Thu, 03 Oct 2024 19:04:57 -0400 |
permissions: |
-rw-r--r-- |
description: |
sndfile ffi |
1 ;;; std/file.lisp --- Standard File Library 9 ;; (reexport-from :uiop :include '(read-file-form read-file-forms slurp-stream-forms)) 12 "Create an anonymous temporary file of the given size. Returns a file descriptor." 13 (let (done fd pathname) 16 (setf (values fd pathname) (sb-posix:mkstemp "/dev/shm/tmp.XXXXXXXX")) 17 (sb-posix:unlink pathname) 18 (sb-posix:ftruncate fd size) 20 (when (and fd (not done)) (sb-posix:close fd))) 23 (declaim (inline octet-vector=/unsafe)) 24 (defun octet-vector=/unsafe (v1 v2 start1 end1 start2 end2) 25 (declare (optimize (speed 3) 28 (compilation-speed 0)) 29 (type octet-vector v1 v2) 30 (type array-index start1 start2) 31 (type array-length end1 end2)) 32 (and (= (- end1 start1) 34 (loop for i from start1 below end1 35 for j from start2 below end2 36 always (eql (aref v1 i) (aref v2 j))))) 38 (defun octet-vector= (v1 v2 &key (start1 0) end1 40 "Like `string=' for octet vectors." 41 (declare (octet-vector v1 v2) 42 (array-index start1 start2) 43 ((or array-length null) end1 end2) 45 (let* ((len1 (length v1)) 48 (end2 (or end2 len2))) 49 (assert (<= start1 end1 len1)) 50 (assert (<= start2 end2 len2)) 51 (octet-vector=/unsafe v1 v2 start1 end1 start2 end2))) 53 (defun file-size-in-octets (file) 54 (multiple-value-bind (path namestring) 56 (string (values (pathname file) 58 (pathname (values file 59 (sb-ext:native-namestring file)))) 60 (declare (ignorable path namestring)) 61 (sb-posix:stat-size (sb-posix:stat path)))) 63 (define-constant si-prefixes 90 :documentation "List as SI prefixes: power of ten, long form, short form.") 92 (define-constant si-prefixes-base-1000 93 (loop for (pow long short) in si-prefixes 94 unless (and (not (zerop pow)) 96 collect (list (truncate pow 3) long short)) 98 :documentation "The SI prefixes as powers of 1000, with centi, deci, deca and hecto omitted.") 100 (define-constant iec-prefixes 109 :documentation "The IEC binary prefixes, as powers of 2.") 113 "Is SEQ a sequence of one element?" 116 (defmacro si-prefix-rec (n base prefixes) 117 (cond ((null prefixes) (error "No prefixes!")) 119 (destructuring-bind ((power long short)) prefixes 120 `(values ,long ,short ,(expt base power)))) 123 (let* ((halfway (ceiling (length prefixes) 2)) 124 (lo (subseq prefixes 0 halfway)) 125 (hi (subseq prefixes halfway)) 126 (split (* (expt base (caar hi))))) 128 (si-prefix-rec ,n ,base ,lo) 129 (si-prefix-rec ,n ,base ,hi)))))) 131 (defun si-prefix (n &key (base 1000)) 132 "Given a number, return the prefix of the nearest SI unit. 134 Three values are returned: the long form, the short form, and the 137 (si-prefix 1001) => \"kilo\", \"k\", 1000d0 139 BASE can be 1000, 10, 1024, or 2. 1000 is the default, and prefixes 140 start at kilo and milli. Base 10 is mostly the same, except the 141 prefixes centi, deci, deca and hecto are also used. Base 1024 uses the 142 same prefixes as 1000, but with 1024 as the base, as in vulgar file 143 sizes. Base 2 uses the IEC binary prefixes." 144 (if (zerop n) (values "" "" 1d0) 145 (let ((n (abs (coerce n 'double-float)))) 147 (2 (si-prefix-rec n 2d0 #.iec-prefixes)) 148 (10 (si-prefix-rec n 10d0 #.si-prefixes)) 149 (1000 (si-prefix-rec n 1000d0 #.si-prefixes-base-1000)) 150 (1024 (si-prefix-rec n 1024d0 #.si-prefixes-base-1000)))))) 152 (defun human-size-formatter (size &key (flavor :si) 153 (space (eql flavor :si))) 154 "Auxiliary function for formatting quantities human-readably. 155 Returns two values: a format control and a list of arguments. 157 This can be used to integrate the human-readable printing of 158 quantities into larger format control strings using the recursive 159 processing format directive (~?): 161 (multiple-value-bind (control args) 162 (human-size-formatter size) 163 (format t \"~?\" control args))" 164 (let ((size (coerce size 'double-float)) 165 ;; Avoid printing exponent markers. 166 (*read-default-float-format* 'double-float) 171 (multiple-value-bind (long short factor) 172 (si-prefix size :base base) 173 (declare (ignore long)) 174 (let* ((size (/ size factor)) 177 (if (> (abs (- size int)) 181 (values (formatter "~:[~d~;~,1f~]~:[~; ~]~a") 182 (list (floatp size) size space short)))))) 184 (defun format-human-size (stream size 186 (space (eql flavor :si))) 187 "Write SIZE to STREAM, in human-readable form. 189 STREAM is interpreted as by `format'. 191 If FLAVOR is `:si' (the default) the base is 1000 and SI prefixes are used. 193 If FLAVOR is `:file', the base is 1024 and SI prefixes are used. 195 If FLAVOR is `:iec', the base is 1024 bytes and IEC prefixes (Ki, Mi, 198 If SPACE is non-nil, include a space between the number and the 199 prefix. (Defaults to T if FLAVOR is `:si'.)" 202 (multiple-value-bind (formatter args) 203 (human-size-formatter size :flavor flavor :space space) 204 (format stream "~?" formatter args)))) 206 (defun format-file-size-human-readable (stream file-size 208 (space (eql flavor :si)) 209 (suffix (if (eql flavor :iec) "B" ""))) 210 "Write FILE-SIZE, a file size in bytes, to STREAM, in human-readable form. 212 STREAM is interpreted as by `format'. 214 If FLAVOR is nil, kilobytes are 1024 bytes and SI prefixes are used. 216 If FLAVOR is `:si', kilobytes are 1000 bytes and SI prefixes are used. 218 If FLAVOR is `:iec', kilobytes are 1024 bytes and IEC prefixes (Ki, 221 If SPACE is non-nil, include a space between the number and the 222 prefix. (Defaults to T if FLAVOR is `:si'.) 224 SUFFIX is the suffix to use; defaults to B if FLAVOR is `:iec', 226 (check-type file-size (integer 0 *)) 227 (if (zerop file-size) 229 (let ((flavor (if (null flavor) :file flavor))) 230 (multiple-value-bind (formatter args) 231 (human-size-formatter file-size :flavor flavor :space space) 232 (format stream "~?~a" formatter args suffix))))) 234 (defun file-size-human-readable (file &key flavor space suffix stream) 235 "Format the size of FILE (in octets) using `format-file-size-human-readable'. 236 The size of file is found by `trivial-file-size:file-size-in-octets'. 238 Inspired by the function of the same name in Emacs." 239 (let ((file-size (file-size-in-octets file))) 240 (format-file-size-human-readable 247 (defmacro with-open-files ((&rest args) &body body) 248 "A simple macro to open one or more files providing the streams for the 249 BODY. The ARGS is a list of `(stream filespec options*)` as supplied to 255 `(with-open-file ,(first args) ,@body)) 256 (t `(with-open-file ,(first args) 258 ,(rest args) ,@body))))) 260 (defmacro with-open-file* ((stream filespec &key direction element-type 261 if-exists if-does-not-exist external-format) 263 "Just like WITH-OPEN-FILE, but NIL values in the keyword arguments 264 mean to use the default value specified for OPEN." 265 (once-only (direction element-type if-exists if-does-not-exist external-format) 267 (,stream (apply #'open ,filespec 270 (list :direction ,direction)) 271 (list :element-type (or ,element-type 272 +default-element-type+)) 274 (list :if-exists ,if-exists)) 275 (when ,if-does-not-exist 276 (list :if-does-not-exist ,if-does-not-exist)) 277 (when ,external-format 278 (list :external-format ,external-format))))) 281 (defmacro with-input-from-file ((stream-name file-name &rest args 282 &key (direction nil direction-p) 285 "Evaluate BODY with STREAM-NAME to an input stream on the file 286 FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT, 287 which is only sent to WITH-OPEN-FILE when it's not NIL." 288 (declare (ignore direction)) 290 (error "Can't specify :DIRECTION for WITH-INPUT-FROM-FILE.")) 291 `(with-open-file* (,stream-name ,file-name :direction :input ,@args) 294 (defmacro with-output-to-file ((stream-name file-name &rest args 295 &key (direction nil direction-p) 298 "Evaluate BODY with STREAM-NAME to an output stream on the file 299 FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT, 300 which is only sent to WITH-OPEN-FILE when it's not NIL." 301 (declare (ignore direction)) 303 (error "Can't specify :DIRECTION for WITH-OUTPUT-TO-FILE.")) 304 `(with-open-file* (,stream-name ,file-name :direction :output ,@args) 307 (defun write-stream-into-file (stream pathname &key (if-exists :error) if-does-not-exist) 308 "Read STREAM and write the contents into PATHNAME. 310 STREAM will be closed afterwards, so wrap it with 311 `make-concatenated-stream' if you want it left open." 312 (check-type pathname pathname) 313 (with-output-to-file (out pathname 314 :element-type (stream-element-type stream) 316 :if-does-not-exist if-does-not-exist) 317 (copy-stream stream out)) 320 (defun write-file-into-stream (pathname output &key (if-does-not-exist :error) 321 (external-format :default)) 322 "Write the contents of FILE into STREAM." 323 (check-type pathname pathname) 324 (with-input-from-file (input pathname 325 :element-type (stream-element-type output) 326 :if-does-not-exist if-does-not-exist 327 :external-format external-format) 328 (copy-stream input output :end (file-size-in-octets pathname)))) 330 (defun file= (file1 file2 &key (buffer-size 4096)) 331 "Compare FILE1 and FILE2 octet by octet, \(possibly) using buffers 333 (declare (ignorable buffer-size)) 334 (let ((file1 (truename file1)) 335 (file2 (truename file2))) 336 (or (equal file1 file2) 337 (and (= (file-size-in-octets file1) 338 (file-size-in-octets file2)) 339 #+ccl (file=/mmap file1 file2) 340 #-ccl (file=/loop file1 file2 :buffer-size buffer-size))))) 342 (defun file=/loop (file1 file2 &key (buffer-size 4096)) 343 "Compare two files by looping over their contents using a buffer." 345 (type pathname file1 file2) 346 (type array-length buffer-size) 347 (optimize (safety 1) (debug 0) (compilation-speed 0))) 348 (flet ((make-buffer () 349 (make-array buffer-size 351 :initial-element 0))) 352 (declare (inline make-buffer)) 353 (with-open-files ((file1 file1 :element-type 'octet :direction :input) 354 (file2 file2 :element-type 'octet :direction :input)) 355 (and (= (file-length file1) 357 (locally (declare (optimize speed)) 358 (loop with buffer1 = (make-buffer) 359 with buffer2 = (make-buffer) 360 for end1 = (read-sequence buffer1 file1) 361 for end2 = (read-sequence buffer2 file2) 362 until (or (zerop end1) (zerop end2)) 363 always (and (= end1 end2) 364 (octet-vector= buffer1 buffer2 368 (defun file-size (file &key (element-type '(unsigned-byte 8))) 369 "The size of FILE, in units of ELEMENT-TYPE (defaults to bytes). 371 The size is computed by opening the file and getting the length of the 374 If all you want is to read the file's size in octets from its metadata, 375 consider FILE-SIZE-IN-OCTETS instead." 376 (check-type file (or string pathname)) 377 (with-input-from-file (in file :element-type element-type) 380 (defun file-timestamp () 381 "Returns current timestamp as a string suitable as the name of a timestamped-file." 382 (multiple-value-bind (sec min hr day mon yr) 384 (format nil "~4d~2,'0d~2,'0d_~2,'0d~2,'0d~2,'0d" yr mon day hr min sec))) 387 "Returns current date as a string suitable as the name of a timestamped-file." 388 (multiple-value-bind (sec min hr day mon yr) 390 (declare (ignore sec min hr)) 391 (format nil "~4d~2,'0d~2,'0d" yr mon day))) 393 ;; see https://www.n16f.net/blog/counting-lines-with-common-lisp/ 395 (defun directory-path-p (path) 396 "Return T if PATH is a directory or NIL else." 397 (declare (type (or pathname string) path)) 398 (and (not (pathname-name path)) 399 (not (pathname-type path)))) 401 (defvar *hidden-paths* (list ".hg" ".git")) 403 (defun hidden-path-p (path &optional strict) 404 "Return T if PATH is strictly a hidden file or directory or NIL else." 405 (declare (type pathname path)) 406 (let ((name (if (directory-path-p path) 407 (car (last (pathname-directory path))) 408 (file-namestring path)))) 409 (and (plusp (length name)) 411 (eq (char name 0) #\.) 412 (member name *hidden-paths* :test 'equal))))) 414 (defun directory-path (path) 415 "If PATH is a directory pathname, return it as it is. If it is a file 416 pathname or a string, transform it into a directory pathname." 417 (declare (type (or pathname string) path)) 418 (if (directory-path-p path) 420 (make-pathname :directory (append (or (pathname-directory path) 422 (list (file-namestring path))) 423 :name nil :type nil :defaults path))) 425 (defun find-files (path &optional (hide *hidden-paths*)) 426 "Return a list of all files contained in the directory at PATH or any of its 428 (declare (type (or pathname string) path)) 429 (flet ((list-directory (path) 431 (make-pathname :defaults (directory-path path) 432 :type :wild :name :wild)))) 434 (children (list-directory (directory-path path)))) 435 (dolist (child children paths) 436 (unless (and hide (hidden-path-p child (eq t hide))) 437 (if (directory-path-p child) 438 (setf paths (append paths (find-files child))) 439 (push child paths))))))) 441 (defun count-file-lines (path) 442 "Count the number of non-empty lines in the file at PATH. A line is empty if 443 it only contains spaces or tab characters." 444 (declare (type pathname path)) 445 (with-open-file (stream path :element-type '(unsigned-byte 8)) 449 (let ((octet (read-byte stream nil))) 451 ((or (null octet) (eq octet #.(char-code #\Newline))) 455 (return-from count-file-lines nb-lines)) 457 ((and (/= octet #.(char-code #\Space)) 458 (/= octet #.(char-code #\Tab))) 459 (setf blank-line nil)))))))