#!/usr/local/bin/clisp -ansi -q -E iso-8859-1 ;;;; -*- mode:lisp; coding:utf-8 -*- (shadow 'copy-file) (DEFUN COPY-STREAM (FROM TO) "Copy into TO from FROM until end of the input file. Do not translate or otherwise maul anything. AUTHORS: Daniel Barlow, Xarch" (LET ((BUF (MAKE-ARRAY 4096 :ELEMENT-TYPE (STREAM-ELEMENT-TYPE FROM)))) (DO ((POS (READ-SEQUENCE BUF FROM) (READ-SEQUENCE BUF FROM))) ((= 0 POS) NIL) (WRITE-SEQUENCE BUF TO :END POS)))) (defun copy-file (src dst &key (if-exists :error) (external-format :default) (element-type 'character)) " DO: Copy the contents of the file at path SRC to the file at path DST. " (with-open-file (inp src :direction :input :if-does-not-exist :error :external-format external-format :element-type element-type) (with-open-file (out dst :direction :output :if-does-not-exist :create :if-exists if-exists :external-format external-format :element-type element-type) (copy-stream inp out)))) (defun process-file (encoding file) (let* ((file (truename file)) (file.bak (merge-pathnames (make-pathname :type "BAK" :case :common) file))) (ignore-errors (delete-file file.bak)) (handler-case (rename-file file file.bak) (error (err) (format *error-output* "Cannot rename the file ~A to a backup file ~A~%~A" file file.bak err) (return-from process-file 1))) (handler-case (copy-file file.bak file :external-format encoding) (error (err) (format *error-output* "Error while copying the file ~A to ~A~%~A~%" file.bak file err) (return-from process-file 1))) 0)) (defun process-stream (encoding input output) (setf (stream-external-format output) encoding) (handler-case (copy-stream input output) (error (err) (format *error-output* "Error while copying the input stream to the output stream~%~A" err) (return-from process-stream 1))) 0) (defun main (&optional args) (labels ((ef (line-terminator) (ext:make-encoding :charset charset:iso-8859-1 :line-terminator line-terminator)) (usage () (format *standard-output* "~A usage:~ ~ ~& ~:*~A -u|-m|-p|-h [file...] | < input > output~ ~&" (if *LOAD-PATHNAME* (FILE-NAMESTRING *LOAD-PATHNAME*) "lc"))) (err (fctrl &rest args) (apply (function format) *error-output* fctrl args) (usage) (return-from main 1))) (loop :with got-file-p = nil :with status = 0 :with ef = nil :for arg :in args :do (cond ((string= "-u" arg) (setf ef (ef :unix))) ((string= "-m" arg) (setf ef (ef :mac))) ((string= "-p" arg) (setf ef (ef :dos))) ((string= "-h" arg) (usage) (return-from main 0)) ((string= "-" arg :end2 1) (err "Unknown option: ~A" arg)) (t (let ((new-status (process-file ef arg))) (setf got-file-p t status (if (zerop new-status) status new-status))))) :finally (cond ((null ef) (err "I need an option~%")) (got-file-p (return-from main status)) (t (return-from main (process-stream ef *standard-input* *standard-output*))))))) (WHEN (BOUNDP 'EXT:*ARGS*) (EXT:EXIT (MAIN EXT:*ARGS*))) ;;otherwise, we're not in a script!