changeset 342: |
254cca648492 |
parent: |
a0dfde3cb3c4
|
child: |
770f2d03efd8 |
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Mon, 13 May 2024 21:10:33 -0400 |
permissions: |
-rw-r--r-- |
description: |
homer fixups |
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 BODY. The ARGS is a list of `(stream filespec options*)` as supplied to WITH-OPEN-FILE." 253 `(with-open-file ,(first args) ,@body)) 254 (t `(with-open-file ,(first args) 256 ,(rest args) ,@body))))) 258 (defmacro with-open-file* ((stream filespec &key direction element-type 259 if-exists if-does-not-exist external-format) 261 "Just like WITH-OPEN-FILE, but NIL values in the keyword arguments 262 mean to use the default value specified for OPEN." 263 (once-only (direction element-type if-exists if-does-not-exist external-format) 265 (,stream (apply #'open ,filespec 268 (list :direction ,direction)) 269 (list :element-type (or ,element-type 270 +default-element-type+)) 272 (list :if-exists ,if-exists)) 273 (when ,if-does-not-exist 274 (list :if-does-not-exist ,if-does-not-exist)) 275 (when ,external-format 276 (list :external-format ,external-format))))) 279 (defmacro with-input-from-file ((stream-name file-name &rest args 280 &key (direction nil direction-p) 283 "Evaluate BODY with STREAM-NAME to an input stream on the file 284 FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT, 285 which is only sent to WITH-OPEN-FILE when it's not NIL." 286 (declare (ignore direction)) 288 (error "Can't specify :DIRECTION for WITH-INPUT-FROM-FILE.")) 289 `(with-open-file* (,stream-name ,file-name :direction :input ,@args) 292 (defmacro with-output-to-file ((stream-name file-name &rest args 293 &key (direction nil direction-p) 296 "Evaluate BODY with STREAM-NAME to an output stream on the file 297 FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT, 298 which is only sent to WITH-OPEN-FILE when it's not NIL." 299 (declare (ignore direction)) 301 (error "Can't specify :DIRECTION for WITH-OUTPUT-TO-FILE.")) 302 `(with-open-file* (,stream-name ,file-name :direction :output ,@args) 305 (defun write-stream-into-file (stream pathname &key (if-exists :error) if-does-not-exist) 306 "Read STREAM and write the contents into PATHNAME. 308 STREAM will be closed afterwards, so wrap it with 309 `make-concatenated-stream' if you want it left open." 310 (check-type pathname pathname) 311 (with-open-stream (in stream) 312 (with-output-to-file (out pathname 313 :element-type (stream-element-type in) 315 :if-does-not-exist if-does-not-exist) 316 (copy-stream in out))) 319 (defun write-file-into-stream (pathname output &key (if-does-not-exist :error) 320 (external-format :default)) 321 "Write the contents of FILE into STREAM." 322 (check-type pathname pathname) 323 (with-input-from-file (input pathname 324 :element-type (stream-element-type output) 325 :if-does-not-exist if-does-not-exist 326 :external-format external-format) 327 (copy-stream input output))) 329 (defun file= (file1 file2 &key (buffer-size 4096)) 330 "Compare FILE1 and FILE2 octet by octet, \(possibly) using buffers 332 (declare (ignorable buffer-size)) 333 (let ((file1 (truename file1)) 334 (file2 (truename file2))) 335 (or (equal file1 file2) 336 (and (= (file-size-in-octets file1) 337 (file-size-in-octets file2)) 338 #+ccl (file=/mmap file1 file2) 339 #-ccl (file=/loop file1 file2 :buffer-size buffer-size))))) 341 (defun file=/loop (file1 file2 &key (buffer-size 4096)) 342 "Compare two files by looping over their contents using a buffer." 344 (type pathname file1 file2) 345 (type array-length buffer-size) 346 (optimize (safety 1) (debug 0) (compilation-speed 0))) 347 (flet ((make-buffer () 348 (make-array buffer-size 350 :initial-element 0))) 351 (declare (inline make-buffer)) 352 (with-open-files ((file1 file1 :element-type 'octet :direction :input) 353 (file2 file2 :element-type 'octet :direction :input)) 354 (and (= (file-length file1) 356 (locally (declare (optimize speed)) 357 (loop with buffer1 = (make-buffer) 358 with buffer2 = (make-buffer) 359 for end1 = (read-sequence buffer1 file1) 360 for end2 = (read-sequence buffer2 file2) 361 until (or (zerop end1) (zerop end2)) 362 always (and (= end1 end2) 363 (octet-vector= buffer1 buffer2 367 (defun file-size (file &key (element-type '(unsigned-byte 8))) 368 "The size of FILE, in units of ELEMENT-TYPE (defaults to bytes). 370 The size is computed by opening the file and getting the length of the 373 If all you want is to read the file's size in octets from its 374 metadata, consider `trivial-file-size:file-size-in-octets' instead." 375 (check-type file (or string pathname)) 376 (with-input-from-file (in file :element-type element-type) 379 (defun file-timestamp () 380 "Returns current timestamp as a string suitable as the name of a timestamped-file." 381 (multiple-value-bind (sec min hr day mon yr) 383 (format nil "~4d~2,'0d~2,'0d_~2,'0d~2,'0d~2,'0d" yr mon day hr min sec))) 386 "Returns current date as a string suitable as the name of a timestamped-file." 387 (multiple-value-bind (sec min hr day mon yr) 389 (declare (ignore sec min hr)) 390 (format nil "~4d~2,'0d~2,'0d" yr mon day))) 392 ;; see https://www.n16f.net/blog/counting-lines-with-common-lisp/ 394 (defun directory-path-p (path) 395 "Return T if PATH is a directory or NIL else." 396 (declare (type (or pathname string) path)) 397 (and (not (pathname-name path)) 398 (not (pathname-type path)))) 400 (defvar *hidden-paths* (list ".hg" ".git")) 402 (defun hidden-path-p (path &optional strict) 403 "Return T if PATH is strictly a hidden file or directory or NIL else." 404 (declare (type pathname path)) 405 (let ((name (if (directory-path-p path) 406 (car (last (pathname-directory path))) 407 (file-namestring path)))) 408 (and (plusp (length name)) 410 (eq (char name 0) #\.) 411 (member name *hidden-paths* :test 'equal))))) 413 (defun directory-path (path) 414 "If PATH is a directory pathname, return it as it is. If it is a file 415 pathname or a string, transform it into a directory pathname." 416 (declare (type (or pathname string) path)) 417 (if (directory-path-p path) 419 (make-pathname :directory (append (or (pathname-directory path) 421 (list (file-namestring path))) 422 :name nil :type nil :defaults path))) 424 (defun find-files (path &optional (hide *hidden-paths*)) 425 "Return a list of all files contained in the directory at PATH or any of its 427 (declare (type (or pathname string) path)) 428 (flet ((list-directory (path) 430 (make-pathname :defaults (directory-path path) 431 :type :wild :name :wild)))) 433 (children (list-directory (directory-path path)))) 434 (dolist (child children paths) 435 (unless (and hide (hidden-path-p child (eq t hide))) 436 (if (directory-path-p child) 437 (setf paths (append paths (find-files child))) 438 (push child paths))))))) 440 (defun count-file-lines (path) 441 "Count the number of non-empty lines in the file at PATH. A line is empty if 442 it only contains space or tabulation characters." 443 (declare (type pathname path)) 444 (with-open-file (stream path :element-type '(unsigned-byte 8)) 448 (let ((octet (read-byte stream nil))) 450 ((or (null octet) (eq octet #.(char-code #\Newline))) 454 (return-from count-file-lines nb-lines)) 456 ((and (/= octet #.(char-code #\Space)) 457 (/= octet #.(char-code #\Tab))) 458 (setf blank-line nil)))))))