I have written a script which I feel could be written in a cleaner
fashion in Scheme. In particular, the area labelled FIXME is what I want
to fix the most.
;;; Written to run under the Scheme Shell scsh (http://www.scsh.net)
;; the hosts we will copy to
(define hosts
(list
"metaperl@urth.org"
"princepawn@perlmonk.org"
"metaperl@eskimo.com"))
;; the basename of the .tar and .gz files to be created
(define base-dump "base-dump")
(define tar-file (string-append base-dump ".tar"))
(define gz-file (string-append tar-file ".gz"))
;; A generic function to take a root and optional path and join them
;; with "/". A more general solution would use SRFI-13.
(define file-path:build-root
(lambda (root . leaf)
(if (> (length leaf) 0)
(format #f "~a/~a" root (car leaf))
root)))
;; A function to build a path consisting of the root plus an optional leaf.
(define root
(lambda leaf
(apply file-path:build-root "/cygdrive/c" leaf)))
;; 2 root-relative directories
(define mydocs (root "Documents and Settings/metaperl/My Documents"))
(define cyg-home (root "cygwin/home/metaperl"))
(chdir mydocs)
(define mydocs-files
(list
"counting-principle.sxi"
"hacks/scm/source-code-documenters.scm"))
(chdir cyg-home)
(define cyg-home-files
(append
(glob "psl/teaching/Praxis/study-questions/*.scm")
(glob "hacks/masonstar/*.scm")
(glob "psl/mydocs/*.tm")
(list
".bashrc"
"sbin/netdump"
"hacks/scheme/transpose.scm"
"psl/teaching/M.Ed-Schools/drexel-sla-ref.doc"
"psl/teaching/M.Ed-Schools/drexel-stmtofpurpose.sxw"
"psl/metaphysics/kriya-questions.txt"
"psl/diary.scm"
)
))
;;; FIXME: good programming sense dictates that there should be someway
;;; to simplify the binding of mydocs-files and cyg-home-files.
;;; My ultimate goal is to associate two things with mydocs-files and
;;; cyg-home-files
;;; (1) a list of files (2) the root directory of each set of files
;;; In Perl-speak:
;;; %file = ( "mydocs" => { files => [ qw(a b c) ], root_dir => "/roo" }
;;; "cyghom" => { files => [ qw(d e f) ], root_dir => "/zoo"
} ) ;
(define mydocs-files
(map
(lambda (F) (file-path:build-root mydocs F))
mydocs-files))
(define cyg-home-files
(map (lambda (F) (file-path:build-root cyg-home F))
cyg-home-files))
(define backup-files (append mydocs-files cyg-home-files))
(chdir (root))
(run (tar cvf ,tar-file ,@backup-files))
(run (gzip --best --force ,tar-file))
(for-each
(lambda (host)
(let ( (scp-host (string-append host ":")) )
(run (scp ,gz-file ,scp-host))))
hosts)))
|