cl-rw

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:
M
os.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")