util.scm
(module util mzscheme
        (require (lib "string.ss"  "srfi" "13"))
        (require (lib "pregexp.ss"))
        (require (lib "servlet.ss" "web-server"))
        (require "debug.scm")
        
        (provide normalize
                 good-name?
                 last
                 copy-to
                 read-whole-string
                 extract-binding/choice
                 )
        
        (define (good-name? name)
          (debug "good-name? :" name)
          (let ((N (string-downcase (string-trim-both name))))
            (if (pregexp-match "\\s|[/\\\\]" N)
                #f
                (if (string=? N "")
                    #f
                    #t))))
        
        (define (normalize name)
          (let ((N (string-downcase (string-trim-both name))))
            (if (string=? N "")
                ""
                (pregexp-replace* "\\s|[/\\\\]" N "_"))))
        
        (define (last L)
          (if (null? L)
              '%no-last%
              (car (reverse L))))
        
        (define (copy-to filename dest-file)
          (display (format "copy-to: ~a ~a~%" filename dest-file))
          (let ((fh1 (open-input-file filename))
                (fh2 (open-output-file dest-file 'replace)))
            (letrec ((f (lambda ()
                          (let ((r (read-bytes 10240 fh1)))
                            (if (eof-object? r)
                                #t
                                (begin
                                  (write-bytes r fh2)
                                  (f)))))))
              (f)
              (close-input-port fh1)
              (close-output-port fh2))))
        
        (define (read-whole-string fh)
          (letrec ((f (lambda ()
                        (let ((r (read-string 10240 fh)))
                          (if (eof-object? r)
                              ""
                              (string-append r (f)))))))
            (f)))
        
        (define (extract-binding/choice possibilities binding . default)
          ;(debug "extract-binding/choice:" possibilities binding default)
          (letrec ((f (lambda (possibilities)
                        (if (null? possibilities)
                            (if (null? default)
                                #f
                                (car default))
                            (if (exists-binding? (car possibilities) binding)
                                (cons (symbol->string (car possibilities)) (extract-binding/single (car possibilities) binding))
                                (f (cdr possibilities)))))))
            (f (map (lambda (x) (string->symbol (format "~a" x))) possibilities))))

        )