scsh-users
[Top] [All Lists]

associating a symbol to a list and a string : script critique requested

Subject: associating a symbol to a list and a string : script critique requested
From: Terrence Brannon <metaperl@urth.org>
Date: Fri, 16 Apr 2004 10:03:21 -0400
Cc: scsh@zurich.csail.mit.edu
Newsgroups: comp.lang.scheme


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)))






<Prev in Thread] Current Thread [Next in Thread>