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

[Andreas Bernauer <andreas.bernauer@gmx.de>]

Here some comments on your script on my side:

Terrence Brannon wrote:
> ;; 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)))

There is actually a scsh function that does this.  With this, I don't
see why you need file-path:build-root, but your definition of root can
be replaced by the following.  Note that I pulled out the hardcode
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)))
>   
(define *root* "/cygdrive/c")
(define root
  (lambda (root . leaf)
    (path-list->file-name leaf root)))

> ;; 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")
     ...
>   ))
> 

You do here twice the same, thus we can abstract over the task.
Maybe like this:

(define (find-rooted-files rooted-path patterns)
  (let ((rooted-patterns               ; root the patterns
         (map (lambda (pattern) 
                (root rooted-path pattern))
              patterns)))
    (apply glob rooted-patterns)))

I have rooted the patterns instead of chdir before globbing, as your
script prepends the root later on at the definitions of mydocs-files
and cyg-home-files anyway.

> ;;; 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" 
> } ) ;

Although you could use a hash or a record here, I think a pair does
the task (although based on your script I don't see why you want to
have the root associated.)

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

The definitions of mydocs-files and cyg-home-files would look like
this now:

(define (make-rooted-file-list directory patterns)
  (let ((absolute-directory (absolute-file-name directory *root*)))
    (cons absolute-directory
          (find-rooted-files absolute-directory
                             patterns))))
(define file-list-root car)
(define file-list-list cdr)

(define mydocs
  (make-rooted-file-list
   "Documents and Settings/metaperl/My Documents"
   '("counting-principle.sxi"
     "hacks/scm/source-code-documenters.scm")))

(define cyg-home
  (make-rooted-file-list
   "cygwin/home/metaperl"
   '("psl/teaching/Praxis/study-questions/*.scm"
    "hacks/masonstar/*.scm"
    "psl/mydocs/*.tm"
    ".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")))

There is an overhead here in globbing some no-patterns, but I think
this is negligible here.

> 
> (define backup-files (append mydocs-files cyg-home-files))

(define backup-files 
  (append (file-list-list mydocs) 
          (file-list-list cyg-home)))

> (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)))
[I think your indentation is strange here.]


I don't know, if you want to use the the file list of mydocs and
cyg-home later on, but if you don't, you might want to consider
passing the patterns directly.   Your whole script would look like
this then.

(define *root* "/cygdrive/c")

;; Return a function that roots with the given directory.
(define root
  (lambda (root)
    (lambda directory
      (path-list->file-name directory root))))

(define backup-files
  (map (root *root*)
       (append 
        (map (root "Documents and Settings/metaperl/My Documents")
             '("counting-principle.sxi"
               "hacks/scm/source-code-documenters.scm"))
        (map (root "cygwin/home/metaperl")
             '("psl/teaching/Praxis/study-questions/*.scm"
               "hacks/masonstar/*.scm"
               "psl/mydocs/*.tm"
               ".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")))))

;; With this, all you need is that:

(define hosts
 (list
   "metaperl@urth.org"
   "princepawn@perlmonk.org"
   "metaperl@eskimo.com"))

;; the basename of the .tar and .gz files to be created
;; Note:  I root the tar file, too.
(define base-dump ((root *root*) "base-dump"))
(define tar-file (string-append base-dump ".tar"))
(define gz-file  (string-append tar-file  ".gz"))

;; no chdir necessary
(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)

;; [untested]

Hope this helps,

  Andreas.