Index: ducttape/Makefile ================================================================== --- ducttape/Makefile +++ ducttape/Makefile @@ -13,12 +13,11 @@ clean: rm -f *.so *.import.scm test_ducttape test_example foo *.c *.o install: - echo tbd - /bin/false + chicken-install test: chicken-install -no-install csc test_ducttape.scm Index: ducttape/ducttape-lib.scm ================================================================== --- ducttape/ducttape-lib.scm +++ ducttape/ducttape-lib.scm @@ -1,14 +1,14 @@ (module ducttape-lib ( runs-ok - glib-debug-level - glib-debug-regex-filter - glib-silent-mode - glib-quiet-mode - glib-log-file - glib-color-mode + ducttape-debug-level + ducttape-debug-regex-filter + ducttape-silent-mode + ducttape-quiet-mode + ducttape-log-file + ducttape-color-mode iputs-preamble script-name idbg ierr iwarn @@ -19,12 +19,12 @@ keyword-skim skim-cmdline-opts-noarg-by-regex skim-cmdline-opts-withargs-by-regex concat-lists process-command-line - glib-append-logfile - glib-activate-logfile + ducttape-append-logfile + ducttape-activate-logfile isys do-or-die counter-maker dir-is-writable? mktemp @@ -53,11 +53,11 @@ (include "workweekdate.scm") (define ducttape-lib-version 1.00) (define (toplevel-command sym proc) (lambda () #f)) ;;;; utility procedures - ; begin credit: megatest's process.scm + ;; begin credit: megatest's process.scm (define (port->list fh ) (if (eof-object? fh) #f (let loop ((curr (read-line fh)) (result '())) (if (not (eof-object? curr)) @@ -68,11 +68,11 @@ (define (conservative-read port) (let loop ((res "")) (if (not (eof-object? (peek-char port))) (loop (conc res (read-char port))) res))) - ; end credit: megatest's process.scm + ;; end credit: megatest's process.scm (define (counter-maker) (let ((acc 0)) (lambda ( #!optional (increment 1) ) (set! acc (+ increment acc)) @@ -96,12 +96,12 @@ ;;http://bugs.call-cc.org/ticket/766 ;;close-[input|output]-port implicitly calling process-wait on process pipe ports. This leads to errors like ;;Error: (process-wait) waiting for child process failed - No child processes: 10872 (close-output-port outport) #f)))) - - ; weird - alist-ref changes signature csc vs. csi... explitly defining. + + ;; weird - alist-ref arg order changes signature csc vs. csi... explitly defining. (define (my-alist-ref key alist) (let ((res (assoc key alist))) (if res (cdr res) #f))) (define (keyword-skim-alist args alist) @@ -211,55 +211,55 @@ ;;; setup general_lib env var parameters ;; show warning/note/error/debug prefixes using ansi colors - (define glib-color-mode - (make-parameter (get-environment-variable "GLIB_COLORIZE"))) + (define ducttape-color-mode + (make-parameter (get-environment-variable "DUCTTAPE_COLORIZE"))) ;; if defined, has number value. if number value > 0, show debug messages ;; value should be decremented in subshells -- idea is raising debug level will show debug messages deeper and deeper in process call stack - (define glib-debug-level + (define ducttape-debug-level (make-parameter - (let ( (raw-debug-level (get-environment-variable "GLIB_DEBUG_LEVEL")) ) + (let ( (raw-debug-level (get-environment-variable "DUCTTAPE_DEBUG_LEVEL")) ) (if raw-debug-level (let ((num-debug-level (runs-ok (string->number raw-debug-level)))) (if (integer? num-debug-level) (begin (let ((new-num-debug-level (- num-debug-level 1))) (if (> new-num-debug-level 0) ;; decrement - (setenv "GLIB_DEBUG_LEVEL" (number->string new-num-debug-level)) - (unsetenv "GLIB_DEBUG_LEVEL"))) + (setenv "DUCTTAPE_DEBUG_LEVEL" (number->string new-num-debug-level)) + (unsetenv "DUCTTAPE_DEBUG_LEVEL"))) num-debug-level) ; it was set and > 0, mode is value (begin - (unsetenv "GLIB_DEBUG_LEVEL") ;; value was invalid, unset it + (unsetenv "DUCTTAPE_DEBUG_LEVEL") ;; value was invalid, unset it #f))) ; value was invalid, mode is f #f)))) ; var not set, mode is f - (define glib-debug-mode (if (glib-debug-level) #t #f)) + (define ducttape-debug-mode (if (ducttape-debug-level) #t #f)) - ;; glib-debug-regex-filter suppresses non-matching debug messages - (define glib-debug-regex-filter + ;; ducttape-debug-regex-filter suppresses non-matching debug messages + (define ducttape-debug-regex-filter (make-parameter - (let ((raw-debug-pattern (get-environment-variable "GLIB_DEBUG_PATTERN"))) + (let ((raw-debug-pattern (get-environment-variable "DUCTTAPE_DEBUG_PATTERN"))) (if raw-debug-pattern raw-debug-pattern ".")))) ;; silent mode suppresses Note and Warning type messages - (define glib-silent-mode - (make-parameter (get-environment-variable "GLIB_SILENT_MODE"))) + (define ducttape-silent-mode + (make-parameter (get-environment-variable "DUCTTAPE_SILENT_MODE"))) ;; quiet mode suppresses Note type messages - (define glib-quiet-mode - (make-parameter (get-environment-variable "GLIB_QUIET_MODE"))) + (define ducttape-quiet-mode + (make-parameter (get-environment-variable "DUCTTAPE_QUIET_MODE"))) ;; if log file is defined, warning/note/error/debug messages are appended ;; to named logfile. - (define glib-log-file - (make-parameter (get-environment-variable "GLIB_LOG_FILE"))) + (define ducttape-log-file + (make-parameter (get-environment-variable "DUCTTAPE_LOG_FILE"))) @@ -268,18 +268,18 @@ ; get the name of the current script/binary being run (define (script-name) (car (reverse (string-split (car (argv)) "/")))) - (define (glib-timestamp) + (define (ducttape-timestamp) (rfc3339->string (time->rfc3339 (seconds->local-time)))) (define (iputs-preamble msg-type #!optional (suppress-color #f)) (let ((do-color (and (not suppress-color) - (glib-color-mode) + (ducttape-color-mode) (terminal-port? (current-error-port))))) (case msg-type ((note) (if do-color (set-text (list 'fg-green 'bg-black 'bold) "Note:") @@ -299,32 +299,32 @@ (if do-color (set-text (list 'fg-blue 'bg-magenta) "Debug:") "Debug:" ))))) - (define (glib-append-logfile msg-type message #!optional (suppress-preamble #f)) + (define (ducttape-append-logfile msg-type message #!optional (suppress-preamble #f)) (let ((txt (string-join (list - (glib-timestamp) + (ducttape-timestamp) (script-name) (if suppress-preamble message (string-join (list (iputs-preamble msg-type #t) message) " "))) " | "))) - (if (glib-log-file) + (if (ducttape-log-file) (runs-ok - (call-with-output-file (glib-log-file) + (call-with-output-file (ducttape-log-file) (lambda (output-port) (format output-port "~A ~%" txt) ) #:append)) #t))) - (define (glib-activate-logfile #!optional (logfile #f)) + (define (ducttape-activate-logfile #!optional (logfile #f)) ;; from python ducttape-lib.py ; message = "START - pid=%d ppid=%d argv=(%s) pwd=%s user=%s host=%s"%(pid,ppid," ".join("'"+x+"'" for x in sys.argv),os.environ['PWD'],os.getenv('USER','nouser'),os.getenv('HOST','nohost') ) (let ((pid (number->string (current-process-id))) (ppid (number->string (parent-process-id))) (argv @@ -337,23 +337,23 @@ (pwd (or (get-environment-variable "PWD") "nopwd")) (user (or (get-environment-variable "USER") "nouser")) (host (or (get-environment-variable "HOST") "nohost"))) (if logfile (begin - (glib-log-file logfile) - (setenv "GLIB_LOG_FILE" (glib-log-file)))) - (glib-append-logfile 'note (format #f "START - pid=~A ppid=~A argv=(~A) pwd=~A user=~A host=~A" pid ppid argv pwd user host) #t))) + (ducttape-log-file logfile) + (setenv "DUCTTAPE_LOG_FILE" (ducttape-log-file)))) + (ducttape-append-logfile 'note (format #f "START - pid=~A ppid=~A argv=(~A) pwd=~A user=~A host=~A" pid ppid argv pwd user host) #t))) ;; immediately activate logfile (will be noop if logfile disabled) - (glib-activate-logfile) + (ducttape-activate-logfile) ;; log exit code (define (set-exit-handler) (let ((orig-exit-handler (exit-handler))) (exit-handler (lambda (exitcode) - (glib-append-logfile 'note (format #f "Exit ~A by sys.exit" exitcode) #t) + (ducttape-append-logfile 'note (format #f "Exit ~A by sys.exit" exitcode) #t) (orig-exit-handler exitcode))))) (set-exit-handler) ;; TODO: hook exception handler so we can log exception before we sign off. @@ -365,39 +365,39 @@ (cons first-message (cdr rest-args)) (list first-message)) ) (message (apply conc (map ->string message-list)))) - (glib-append-logfile 'dbg message) - (if (glib-debug-level) - (if (<= debug-level-threshold (glib-debug-level)) - (if (string-search (glib-debug-regex-filter) message) + (ducttape-append-logfile 'dbg message) + (if (ducttape-debug-level) + (if (<= debug-level-threshold (ducttape-debug-level)) + (if (string-search (ducttape-debug-regex-filter) message) (begin (format (current-error-port) "~A ~A (~A)~%" (iputs-preamble 'dbg) message (script-name)))))))) (define (ierr message-first . message-rest) (let* ((message (apply conc (map ->string (cons message-first message-rest))))) - (glib-append-logfile 'err message) + (ducttape-append-logfile 'err message) (format (current-error-port) "~A ~A (~A)~%" (iputs-preamble 'err) message (script-name)))) (define (iwarn message-first . message-rest) (let* ((message (apply conc (map ->string (cons message-first message-rest))))) - (glib-append-logfile 'warn message) - (if (not (glib-silent-mode)) + (ducttape-append-logfile 'warn message) + (if (not (ducttape-silent-mode)) (begin (format (current-error-port) "~A ~A (~A)~%" (iputs-preamble 'warn) message (script-name)))))) (define (inote message-first . message-rest) (let* ((message (apply conc (map ->string (cons message-first message-rest))))) - (glib-append-logfile 'note message) - (if (not (or (glib-silent-mode) (glib-quiet-mode))) + (ducttape-append-logfile 'note message) + (if (not (or (ducttape-silent-mode) (ducttape-quiet-mode))) (begin (format (current-error-port) "~A ~A (~A)~%" (iputs-preamble 'note) message (script-name)))))) (define (iputs kind message #!optional (debug-level-threshold 1)) @@ -725,56 +725,56 @@ result)) ;; recognize ducttape-lib command line switches (--quiet, --silent, --color, -d.., -dp.., -logfile) - ;; - reset parameters; reset GLIB_* env vars to match user specified intent + ;; - reset parameters; reset DUCTTAPE_* env vars to match user specified intent ;; - mutate (command-line-arguments) parameter to subtract these recognized and handled switches ;; * beware -- now (argv) and (command-line-arguments) are inconsistent... cannot mutate (argv) alas. Use (command-line-arguments) (define (process-command-line) ;; --quiet (let ((quiet-opts (skim-cmdline-opts-noarg-by-regex "--?quiet"))) (if (not (null? quiet-opts)) (begin - (setenv "GLIB_QUIET_MODE" "1") - (glib-quiet-mode "1")))) + (setenv "DUCTTAPE_QUIET_MODE" "1") + (ducttape-quiet-mode "1")))) ;; --silent (let ((silent-opts (skim-cmdline-opts-noarg-by-regex "--?silent"))) (if (not (null? silent-opts)) (begin - (setenv "GLIB_SILENT_MODE" "1") - (glib-silent-mode "1")))) + (setenv "DUCTTAPE_SILENT_MODE" "1") + (ducttape-silent-mode "1")))) ;; -color (let ((color-opts (skim-cmdline-opts-noarg-by-regex "--?colou?r(ize)?"))) (if (not (null? color-opts)) (begin - (setenv "GLIB_COLORIZE" "1") - (glib-color-mode "1")))) + (setenv "DUCTTAPE_COLORIZE" "1") + (ducttape-color-mode "1")))) ;; -nocolor (let ((nocolor-opts (skim-cmdline-opts-noarg-by-regex "--?nocolou?r(ize)?"))) (if (not (null? nocolor-opts)) (begin - (unsetenv "GLIB_COLORIZE" ) - (glib-color-mode #f)))) + (unsetenv "DUCTTAPE_COLORIZE" ) + (ducttape-color-mode #f)))) ;; -logfile (let ((logfile-opts (skim-cmdline-opts-withargs-by-regex "--?log(-?file)?"))) (if (not (null? logfile-opts)) (begin - (glib-log-file (car (reverse logfile-opts))) - (setenv "GLIB_LOG_FILE" (glib-log-file))))) + (ducttape-log-file (car (reverse logfile-opts))) + (setenv "DUCTTAPE_LOG_FILE" (ducttape-log-file))))) ;; -d -dd -d# (let ((debug-opts (skim-cmdline-opts-noarg-by-regex "-d(d*|\\d+)")) - (initial-debuglevel (if (glib-debug-level) (glib-debug-level) 0) )) + (initial-debuglevel (if (ducttape-debug-level) (ducttape-debug-level) 0) )) (if (not (null? debug-opts)) (begin - (glib-debug-level + (ducttape-debug-level (let loop ((opts debug-opts) (debuglevel initial-debuglevel)) (if (null? opts) debuglevel (let* ( (curopt (car opts)) @@ -782,20 +782,20 @@ (ds (string-match "-(d+)" curopt)) (dnum (string-match "-d(\\d+)" curopt))) (cond (ds (loop restopts (+ debuglevel (string-length (cadr ds))))) (dnum (loop restopts (string->number (cadr dnum))))))))) - (setenv "GLIB_DEBUG_LEVEL" (number->string (glib-debug-level)))))) + (setenv "DUCTTAPE_DEBUG_LEVEL" (number->string (ducttape-debug-level)))))) ;; -dp / --debug-pattern (let ((debugpat-opts (skim-cmdline-opts-withargs-by-regex "--?(debug-pattern|dp)"))) (if (not (null? debugpat-opts)) (begin - (glib-debug-regex-filter (string-join debugpat-opts "|")) - (setenv "GLIB_DEBUG_PATTERN" (glib-debug-regex-filter)))))) + (ducttape-debug-regex-filter (string-join debugpat-opts "|")) + (setenv "DUCTTAPE_DEBUG_PATTERN" (ducttape-debug-regex-filter)))))) ;; handle command line immediately; (process-command-line) ) ; end module Index: ducttape/mimetypes.scm ================================================================== --- ducttape/mimetypes.scm +++ ducttape/mimetypes.scm @@ -1,10 +1,10 @@ ;; gathered from macosx: ;; cat /etc/apache2/mime.types | grep -v '^#' | perl -ne 'print "(\"$2\" . \"$1\")\n" if /(\S+)\s+(\S+)/' > mimetypes.scm ;; + manual manipulation -(define glib_ext2mimetype '(("ez" . "application/andrew-inset") +(define ducttape_ext2mimetype '(("ez" . "application/andrew-inset") ("aw" . "application/applixware") ("atom" . "application/atom+xml") ("atomcat" . "application/atomcat+xml") ("atomsvc" . "application/atomsvc+xml") ("ccxml" . "application/ccxml+xml") @@ -776,7 +776,7 @@ ("movie" . "video/x-sgi-movie") ("smv" . "video/x-smv") ("ice" . "x-conference/x-cooltalk"))) (define (ext->mimetype ext) - (let ((x (assoc ext glib_ext2mimetype))) + (let ((x (assoc ext ducttape_ext2mimetype))) (if x (cdr x) "text/plain"))) Index: ducttape/test_ducttape.scm ================================================================== --- ducttape/test_ducttape.scm +++ ducttape/test_ducttape.scm @@ -6,69 +6,69 @@ (use trace) (set! systype (do-or-die (if (file-exists? "/bin/uname") "/bin/uname" "/usr/bin/uname"))) ;(trace skim-cmdline-opts-withargs-by-regex) ;(trace keyword-skim) ;(trace re-match?) -(define (reset-glib) - (unsetenv "GLIB_DEBUG_LEVEL") - (glib-debug-level #f) - - (unsetenv "GLIB_DEBUG_PATTERN") - (glib-debug-regex-filter ".") - - (unsetenv "GLIB_LOG_FILE") - (glib-log-file #f) - - (unsetenv "GLIB_SILENT_MODE") - (glib-silent-mode #f) - - (unsetenv "GLIB_QUIET_MODE") - (glib-quiet-mode #f) - - (unsetenv "GLIB_COLOR_MODE") - (glib-color-mode #f) -) - -(define (reset-glib-with-cmdline-list cmdline-list) - (reset-glib) +(define (reset-ducttape) + (unsetenv "ducttape_DEBUG_LEVEL") + (ducttape-debug-level #f) + + (unsetenv "ducttape_DEBUG_PATTERN") + (ducttape-debug-regex-filter ".") + + (unsetenv "ducttape_LOG_FILE") + (ducttape-log-file #f) + + (unsetenv "ducttape_SILENT_MODE") + (ducttape-silent-mode #f) + + (unsetenv "ducttape_QUIET_MODE") + (ducttape-quiet-mode #f) + + (unsetenv "ducttape_COLOR_MODE") + (ducttape-color-mode #f) +) + +(define (reset-ducttape-with-cmdline-list cmdline-list) + (reset-ducttape) (command-line-arguments cmdline-list) (process-command-line) ) (define (direct-iputs-test) - (glib-color-mode #f) + (ducttape-color-mode #f) (ierr "I'm an error") (iwarn "I'm a warning") (inote "I'm a note") - (glib-debug-level 1) + (ducttape-debug-level 1) (idbg "I'm a debug statement") - (glib-debug-level #f) + (ducttape-debug-level #f) (idbg "I'm a hidden debug statement") - (glib-silent-mode #t) + (ducttape-silent-mode #t) (iwarn "I shouldn't show up") (inote "I shouldn't show up either") (ierr "I should show up 1") - (glib-silent-mode #f) + (ducttape-silent-mode #f) - (glib-quiet-mode #t) + (ducttape-quiet-mode #t) (iwarn "I should show up 2") (inote "I shouldn't show up though") (ierr "I should show up 3") - (glib-quiet-mode #f) + (ducttape-quiet-mode #f) - (glib-debug-level 1) + (ducttape-debug-level 1) (idbg "foo") (iputs "dbg" "debug message") (iputs "e" "error message") (iputs "w" "warning message") (iputs "n" "note message") - (glib-color-mode #t) + (ducttape-color-mode #t) (ierr "I'm an error COLOR") (iwarn "I'm a warning COLOR") (inote "I'm a note COLOR") (idbg "I'm a debug COLOR") @@ -240,53 +240,53 @@ (define (test-argprocessor ) (test-group "Command line processor parameter settings" - (reset-glib-with-cmdline-list '()) - (test-assert "(nil) debug mode should be off" (not (glib-debug-level))) - (test-assert "(nil): debug pattern should be '.'" (equal? "." (glib-debug-regex-filter))) - (test-assert "(nil): colors should be off" (not (glib-color-mode))) - (test-assert "(nil): silent mode should be off" (not (glib-silent-mode))) - (test-assert "(nil): quiet mode should be off" (not (glib-quiet-mode))) - (test-assert "(nil): logfile should be off" (not (glib-log-file))) - - (reset-glib-with-cmdline-list '("-d")) - (test-assert "-d: debug mode should be on at level 1" (eq? 1 (glib-debug-level))) - - (reset-glib-with-cmdline-list '("-dd")) - (test "-dd: debug level should be 2" 2 (glib-debug-level)) - - (reset-glib-with-cmdline-list '("-ddd")) - (test "-ddd: debug level should be 3" 3 (glib-debug-level)) - - (reset-glib-with-cmdline-list '("-d2")) - (test "-d2: debug level should be 2" 2 (glib-debug-level)) - - (reset-glib-with-cmdline-list '("-d3")) - (test "-d3: debug level should be 3" 3 (glib-debug-level)) - - (reset-glib-with-cmdline-list '("-dp" "foo")) - (test "-dp foo: debug pattern should be 'foo'" "foo" (glib-debug-regex-filter)) - - (reset-glib-with-cmdline-list '("--debug-pattern" "foo")) - (test "--debug-pattern foo: debug pattern should be 'foo'" "foo" (glib-debug-regex-filter)) - - (reset-glib-with-cmdline-list '("-dp" "foo" "-dp" "bar")) - (test "-dp foo -dp bar: debug pattern should be 'foo|bar'" "foo|bar" (glib-debug-regex-filter)) - - (reset-glib-with-cmdline-list '("--quiet")) - (test-assert "-quiet: quiet mode should be active" (glib-quiet-mode)) - - (reset-glib-with-cmdline-list '("--silent")) - (test-assert "-silent: silent mode should be active" (glib-silent-mode)) - - (reset-glib-with-cmdline-list '("--color")) - (test-assert "-color: color mode should be active" (glib-color-mode)) - - (reset-glib-with-cmdline-list '("--log" "foo")) - (test "--log foo: logfile should be 'foo'" "foo" (glib-log-file)) + (reset-ducttape-with-cmdline-list '()) + (test-assert "(nil) debug mode should be off" (not (ducttape-debug-level))) + (test-assert "(nil): debug pattern should be '.'" (equal? "." (ducttape-debug-regex-filter))) + (test-assert "(nil): colors should be off" (not (ducttape-color-mode))) + (test-assert "(nil): silent mode should be off" (not (ducttape-silent-mode))) + (test-assert "(nil): quiet mode should be off" (not (ducttape-quiet-mode))) + (test-assert "(nil): logfile should be off" (not (ducttape-log-file))) + + (reset-ducttape-with-cmdline-list '("-d")) + (test-assert "-d: debug mode should be on at level 1" (eq? 1 (ducttape-debug-level))) + + (reset-ducttape-with-cmdline-list '("-dd")) + (test "-dd: debug level should be 2" 2 (ducttape-debug-level)) + + (reset-ducttape-with-cmdline-list '("-ddd")) + (test "-ddd: debug level should be 3" 3 (ducttape-debug-level)) + + (reset-ducttape-with-cmdline-list '("-d2")) + (test "-d2: debug level should be 2" 2 (ducttape-debug-level)) + + (reset-ducttape-with-cmdline-list '("-d3")) + (test "-d3: debug level should be 3" 3 (ducttape-debug-level)) + + (reset-ducttape-with-cmdline-list '("-dp" "foo")) + (test "-dp foo: debug pattern should be 'foo'" "foo" (ducttape-debug-regex-filter)) + + (reset-ducttape-with-cmdline-list '("--debug-pattern" "foo")) + (test "--debug-pattern foo: debug pattern should be 'foo'" "foo" (ducttape-debug-regex-filter)) + + (reset-ducttape-with-cmdline-list '("-dp" "foo" "-dp" "bar")) + (test "-dp foo -dp bar: debug pattern should be 'foo|bar'" "foo|bar" (ducttape-debug-regex-filter)) + + (reset-ducttape-with-cmdline-list '("--quiet")) + (test-assert "-quiet: quiet mode should be active" (ducttape-quiet-mode)) + + (reset-ducttape-with-cmdline-list '("--silent")) + (test-assert "-silent: silent mode should be active" (ducttape-silent-mode)) + + (reset-ducttape-with-cmdline-list '("--color")) + (test-assert "-color: color mode should be active" (ducttape-color-mode)) + + (reset-ducttape-with-cmdline-list '("--log" "foo")) + (test "--log foo: logfile should be 'foo'" "foo" (ducttape-log-file)) )) (define (test-wwdate) (test-group @@ -325,13 +325,13 @@ ; visually inspect this (direct-iputs-test) ; following use unit test test-egg - (reset-glib) + (reset-ducttape) (test-argprocessor-funcs) - (reset-glib) + (reset-ducttape) (test-argprocessor) (test-systemstuff) (test-misc) (test-wwdate) ) ; end main()