+
+
+(defun null-output-stream ()
+ (when (probe-file #p"/dev/null")
+ (open #p"/dev/null" :direction :output :if-exists :overwrite))
+ )
+
+
+(defun directory-tree (filename)
+ "Returns a tree of pathnames for sub-directories of a directory"
+ (let* ((root (canonicalize-directory-name filename))
+ (subdirs (loop for path in (directory
+ (make-pathname :name :wild
+ :type :wild
+ :defaults root))
+ when (probe-directory path)
+ collect (canonicalize-directory-name path))))
+ (when (find nil subdirs)
+ (error "~A" subdirs))
+ (when (null root)
+ (error "~A" root))
+ (if subdirs
+ (cons root (mapcar #'directory-tree subdirs))
+ (if (probe-directory root)
+ (list root)
+ (error "root not directory ~A" root)))))
+
+
+(defmacro with-utime-decoding ((utime &optional zone) &body body)
+ "UTIME is a universal-time, ZONE is a number of hours offset from UTC, or NIL to use local time. Execute BODY in an environment where SECOND MINUTE HOUR DAY-OF-MONTH MONTH YEAR DAY-OF-WEEK DAYLIGHT-P ZONE are bound to the decoded components of the universal time"
+ `(multiple-value-bind
+ (second minute hour day-of-month month year day-of-week daylight-p zone)
+ (decode-universal-time ,utime ,@(if zone (list zone)))
+ (declare (ignorable second minute hour day-of-month month year day-of-week daylight-p zone))
+ ,@body))
+
+(defvar +datetime-number-strings+
+ (make-array 61 :adjustable nil :element-type 'string :fill-pointer nil
+ :initial-contents
+ '("00" "01" "02" "03" "04" "05" "06" "07" "08" "09" "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")))
+
+(defun is-dst (utime)
+ (with-utime-decoding (utime)
+ daylight-p))
+
+
+(defmacro with-utime-decoding-utc-offset ((utime utc-offset) &body body)
+ (with-gensyms (zone)
+ `(let* ((,zone (cond
+ ((eq :utc ,utc-offset)
+ 0)
+ ((null utc-offset)
+ nil)
+ (t
+ (if (is-dst ,utime)
+ (1- (- ,utc-offset))
+ (- ,utc-offset))))))
+ (if ,zone
+ (with-utime-decoding (,utime ,zone)
+ ,@body)
+ (with-utime-decoding (,utime)
+ ,@body)))))
+
+
+(defun write-utime-hms (utime &key utc-offset stream)
+ (if stream
+ (write-utime-hms-stream utime stream utc-offset)
+ (with-output-to-string (s)
+ (write-utime-hms-stream utime s utc-offset))))
+
+(defun write-utime-hms-stream (utime stream &optional utc-offset)
+ (with-utime-decoding-utc-offset (utime utc-offset)
+ (write-string (aref +datetime-number-strings+ hour) stream)
+ (write-char #\: stream)
+ (write-string (aref +datetime-number-strings+ minute) stream)
+ (write-char #\: stream)
+ (write-string (aref +datetime-number-strings+ second) stream)))
+
+(defun write-utime-hm (utime &key utc-offset stream)
+ (if stream
+ (write-utime-hm-stream utime stream utc-offset)
+ (with-output-to-string (s)
+ (write-utime-hm-stream utime s utc-offset))))
+
+(defun write-utime-hm-stream (utime stream &optional utc-offset)
+ (with-utime-decoding-utc-offset (utime utc-offset)
+ (write-string (aref +datetime-number-strings+ hour) stream)
+ (write-char #\: stream)
+ (write-string (aref +datetime-number-strings+ minute) stream)))
+
+
+(defun write-utime-ymdhms (utime &key stream utc-offset)
+ (if stream
+ (write-utime-ymdhms-stream utime stream utc-offset)
+ (with-output-to-string (s)
+ (write-utime-ymdhms-stream utime s utc-offset))))
+
+(defun write-utime-ymdhms-stream (utime stream &optional utc-offset)
+ (with-utime-decoding-utc-offset (utime utc-offset)
+ (write-string (prefixed-fixnum-string year nil 4) stream)
+ (write-char #\/ stream)
+ (write-string (aref +datetime-number-strings+ month) stream)
+ (write-char #\/ stream)
+ (write-string (aref +datetime-number-strings+ day-of-month) stream)
+ (write-char #\space stream)
+ (write-string (aref +datetime-number-strings+ hour) stream)
+ (write-char #\: stream)
+ (write-string (aref +datetime-number-strings+ minute) stream)
+ (write-char #\: stream)
+ (write-string (aref +datetime-number-strings+ second) stream)))
+
+(defun write-utime-ymdhm (utime &key stream utc-offset)
+ (if stream
+ (write-utime-ymdhm-stream utime stream utc-offset)
+ (with-output-to-string (s)
+ (write-utime-ymdhm-stream utime s utc-offset))))
+
+(defun write-utime-ymdhm-stream (utime stream &optional utc-offset)
+ (with-utime-decoding-utc-offset (utime utc-offset)
+ (write-string (prefixed-fixnum-string year nil 4) stream)
+ (write-char #\/ stream)
+ (write-string (aref +datetime-number-strings+ month) stream)
+ (write-char #\/ stream)
+ (write-string (aref +datetime-number-strings+ day-of-month) stream)
+ (write-char #\space stream)
+ (write-string (aref +datetime-number-strings+ hour) stream)
+ (write-char #\: stream)
+ (write-string (aref +datetime-number-strings+ minute) stream)))
+
+(defun copy-binary-stream (in out &key (chunk-size 16384))
+ (do* ((buf (make-array chunk-size :element-type '(unsigned-byte 8)))
+ (pos (read-sequence buf in) (read-sequence buf in)))
+ ((zerop pos))
+ (write-sequence buf out :end pos)))
+