cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

commit 03c9ce8bbd88b44f10c05975a24159a6fb6beaf0
parent e03abfde2ac5800dff931f921ef5dda7470ea7a5
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun, 27 Oct 2013 15:49:48 +0100

rw.os improvements and features

Diffstat:
Mos.lisp | 61++++++++++++++++++++++++++++++++++++++++++++++++++++---------
1 file changed, 52 insertions(+), 9 deletions(-)

diff --git a/os.lisp b/os.lisp @@ -22,8 +22,11 @@ (defpackage :rw.os (:use :cl) - (:export :make-program + (:export :cmp + :cp + :make-program :make-temporary-file + :md5sum :run-command :sha1sum :with-program-output @@ -137,9 +140,11 @@ (close (close p)))))) (defun throw-error (cmd args code error-plist) - (when error-plist - (let ((reason (or (cdr (assoc code error-plist)) ""))) - (error (format nil "~a error ~d: ~a ~s" cmd code reason args))))) + (unless (eq t error-plist) + (error (format nil "~a error ~d: ~a ~s" cmd code + (when error-plist + (or (cdr (assoc code error-plist)) "")) + args)))) (defun call-with-program-output (output cmd args error-plist fn) (let ((p (make-program nil output cmd args))) @@ -155,20 +160,39 @@ (throw-error cmd args code error-plist))) (funcall p :close)))) -(defun run-command (cmd args &optional error-plist) +(defun run-command (cmd &optional args error-plist) (call-with-program-output nil cmd args error-plist nil)) -(defmacro with-program-output ((var cmd args &optional error-plist) &body body) +(defmacro with-program-output ((var cmd &optional args error-plist) &body body) `(call-with-program-output :stream ,cmd ,args ,error-plist (lambda (,var) ,@body))) -(defun sha1sum (file) - (with-program-output (s "sha1sum" (list (format nil "~a" file))) - (rw:till (rw:peek-reader (rw:char-reader s)) '(#\space)))) +(defun %namestring (x) ;; TODO why not NAMESTRING directly usable? + (with-output-to-string (*standard-output*) + (do (c (r (rw:reader (namestring x)))) + ((not (setq c (rw:next r)))) + (when (eql #\\ c) + (setq c (rw:next r))) + (write-char c)))) + +(defun %sum (command pathname) + (with-program-output (s command (list (%namestring pathname))) + (let ((x (rw:till (rw:peek-reader (rw:char-reader s)) '(#\space)))) + (when x + (coerce x 'string))))) + +(defun sha1sum (pathname) + (%sum "sha1sum" pathname)) ;;(sha1sum "/etc/passwd") ;;(sha1sum "/etc/passwd2") +(defun md5sum (pathname) + (%sum "md5sum" pathname)) + +;;(md5sum "/etc/passwd") +;;(md5sum "/etc/passwd2") + (defun make-temporary-file (&key directoryp template) (with-program-output (s "mktemp" (append (when directoryp '("-d")) (when template (list template)))) @@ -177,8 +201,27 @@ ;;(make-temporary-file) ;;(make-temporary-file :directoryp t) ;;(make-temporary-file :template "/tmp/hi-XXXXX.log") +;;(make-temporary-file :template "hi-XXXXX.log") ;; TODO fix error (defmacro with-temporary-file ((var &key directoryp template) &body body) `(let ((,var (make-temporary-file :directoryp directoryp :template template))) (unwind-protect (progn ,@body) (delete-file ,var)))) + +(defun %binary (command pathname1 pathname2 error-plist) + (when (and pathname1 pathname2) + (run-command command + (list (%namestring pathname1) (%namestring pathname2)) + error-plist))) + +(defun cmp (pathname1 pathname2) + (%binary "cmp" pathname1 pathname2 t)) + +;;(cmp "/etc/passwd" "/etc/passwd") +;;(cmp "/etc/passwd" "/etc/hosts") + +(defun cp (from to) + (%binary "cp" from to nil)) + +;;(cp "/etc/passwd" "/tmp/a") +;;(cp "/asdf" "/tmp/a")