Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2010-08-08

KMRCLを眺める(185) COPY-FILE

| 21:42 | KMRCLを眺める(185) COPY-FILE - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(185) COPY-FILE - わだばLisperになる

今回は、KMRCLのimpl.lispからCOPY-FILEです。

名前からしてファイルをコピーするもののようです。

定義は、

(defun copy-file (from to &key link overwrite preserve-symbolic-links
                  (preserve-time t) remove-destination force verbose)
  #+allegro (sys:copy-file from to :link link :overwrite overwrite
                           :preserve-symbolic-links preserve-symbolic-links
                           :preserve-time preserve-time
                           :remove-destination remove-destination
                           :force force :verbose verbose)
  #-allegro
  (declare (ignore verbose preserve-symbolic-links overwrite))
  (cond
    ((and (typep from 'stream) (typep to 'stream))
     (copy-binary-stream from to))
    ((not (probe-file from))
     (error "File ~A does not exist." from))
    ((eq link :hard)
     (run-shell-command "ln -f ~A ~A" (namestring from) (namestring to)))
    (link
     (multiple-value-bind (stdout stderr status)
         (command-output "ln -f ~A ~A" (namestring from) (namestring to))
       (declare (ignore stdout stderr))
       ;; try symbolic if command failed
       (unless (zerop status)
         (run-shell-command "ln -sf ~A ~A" (namestring from) (namestring to)))))
    (t
     (when (and (or force remove-destination) (probe-file to))
       (delete-file to))
     (let* ((options (if preserve-time
                         "-p"
                         ""))
            (cmd (format nil "cp ~A ~A ~A" options (namestring from) (namestring to))))
       (run-shell-command cmd)))))

となっています。

Allegro CLだと同名の関数があるようですが、それを模した感じになっていて、基本的には、CLからUnixのコマンドを実行しています。

動作は、

(KL:COPY-FILE "/etc/fstab" "/tmp/")
;⇒ 0

$ ls /tmp
... fstab ...

となっています。