Megatest

     iputs
     re-match?
                                        ;     launch-repl
     keyword-skim
     skim-cmdline-opts-noarg-by-regex
     skim-cmdline-opts-withargs-by-regex 
     concat-lists
     process-command-line
     ducttape-append-logfile
     ducttape-activate-logfile
     isys
     do-or-die
     counter-maker
     dir-is-writable?
     mktemp

     wwdate->isodate
     current-wwdate
     current-isodate
     
     )

  (import scheme chicken extras ports data-structures )
  (use posix regex ansi-escape-sequences test srfi-1 irregex slice srfi-13 rfc3339 scsh-process directory-utils uuid-lib filepath srfi-19 ) ; linenoise



  (include "mimetypes.scm") ; provides ext->mimetype
  (include "workweekdate.scm")
  (define ducttape-lib-version 1.00)
  (define (toplevel-command sym proc) (lambda () #f))
;;;; utility procedures

  ;; begin credit: megatest's process.scm

  (define (do-or-die command   #!key nodie (foreach-stdout #f) (stdin-proc #f))
    (let-values (((exit-code stdout-str stderr-str) (isys command foreach-stdout-thunk: foreach-stdout stdin-proc: stdin-proc )))
      (if (equal? 0 exit-code)
          stdout-str
          (begin
            (ierr (conc "Command  > " command " "  "< failed with " exit-code " because: \n" stderr-str) )
            (if nodie #f (exit exit-code))))))




  ;; this is broken.  one day i will fix it and thus understand run/collecting... don't use isys-broken.
  (define (isys-broken  command-list)

    (let-values ( ( (rv outport errport) (run/collecting (1 2) ("ls" "-l")  ) ) ) 
      (print "rv is " rv)
      (print "op is " outport)
      (print "ep is " errport)
      (values rv (port->string outport) (port->string errport))))



  ;; runs-ok: evaluate expression while suppressing exceptions.
                                        ;    on caught exception, returns #f
                                        ;    otherwise, returns expression value
  (define (runs-ok thunk)
    (handle-exceptions exn #f (begin (thunk) #t)))

          (host (or (get-environment-variable "HOST") "nohost")))
      (if logfile
          (begin
            (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)
  (ducttape-activate-logfile)

  ;; log exit code
  (define (set-exit-handler)
    (let ((orig-exit-handler (exit-handler)))
      (exit-handler 
       (lambda (exitcode) 
         (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.

  (define (idbg first-message  . rest-args)
    (let* ((debug-level-threshold
            (if (> (length rest-args) 0) (car rest-args) 1))
           (message-list
            (if (> (length rest-args) 1)
                (cons first-message (cdr rest-args))

                   (next-rest (cdr rest-path-items))
                   (candidate (conc this-dir "/" exe)))
              (if (file-execute-access? candidate)
                  candidate
                  (loop next-rest)))))))




  ;; (define (launch-repl )
  ;;   (use linenoise)
  ;;   (current-input-port (make-linenoise-port))

  ;;   (let ((histfile (conc (or (get-environment-variable "HOME") ".") "/." (script-name) "-hist")))
  
  ;;     (set-history-length! 30000)
  
  ;;     (load-history-from-file histfile)
  
  ;;     (let loop ((l (linenoise "> ")))
  ;;       (cond ((equal? l "bye")
  ;;              (save-history-to-file histfile)
  ;;              "Bye!")
  ;;             ((eof-object? l)
  ;;              (save-history-to-file histfile)
  ;;              (exit))
  ;;             (else
  ;;              (display l)
  ;;              (handle-exceptions exn
  ;;                  ;;(print-call-chain (current-error-port))
  ;;                  (let ((message ((condition-property-accessor 'exn 'message) exn)))
  ;;                    (print "exn> " message )
  ;;                    ;;(pp (condition->list exn))
  ;;                    ;;(exit)
  ;;                    ;;(display "Went wrong")
  ;;                    (newline))
  ;;                (print (eval l)))))
  ;;       (newline)
  ;;       (history-add l)
  ;;       (loop (linenoise "> ")))))
  
  ;; (define (launch-repl2 )
  ;;   (use readline)
  ;;   (use apropos)
  ;;   (use trace)
  ;;   ;(import csi)
  ;;   (current-input-port (make-readline-port (conc (script-name) "> ") "... "))
  ;;  ; (install-history-file #f (conc (or (get-environment-variable "HOME") ".") "/." (script-name) "_history"))
  ;;   (parse-and-bind "set editing-mode emacs")
  ;;   (install-history-file)
  ;;   (let loop ((foo #f))

  ;;     (let ((expr (read)))
  ;;       (cond
  ;;        ((eof-object? expr) (exit))
  ;;        (else
  ;;         (handle-exceptions exn
  ;;             ;;(print-call-chain (current-error-port))
  ;;             (let ((message ((condition-property-accessor 'exn 'message) exn)))
  ;;               (print "exn> " message )
  ;;               ;;(pp (condition->list exn))
  ;;               ;;(exit)
  ;;               ;;(display "Went wrong")
  ;;               (newline))
  ;;           (print (eval expr))))))
  ;;     (loop #f))
  ;;   )

;;;; process command line options

  ;; get command line switches (have no subsequent arg; eg. [-foo])
  ;;  assumes these are switches without arguments
  ;;  will return list of matches
  ;;  removes matches from command-line-arguments parameter
  (define (skim-cmdline-opts-noarg-by-regex switch-pattern)

  
  

  ;; recognize ducttape-lib command line switches (--quiet, --silent, --color, -d.., -dp.., -logfile)
  ;;    - 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 "DUCTTAPE_QUIET_MODE" "1")
            (ducttape-quiet-mode "1"))))

    ;; -dp <pat> / --debug-pattern <pat>
    (let ((debugpat-opts (skim-cmdline-opts-withargs-by-regex "--?(debug-pattern|dp)")))
      (if (not (null? debugpat-opts))
          (begin
            (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

  (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)
  (ducttape-color-mode #f)
  (ierr "I'm an error")
  (iwarn "I'm a warning")

   
   (let-values (((ec o e) (isys "/bin/ls /zzzzz")))
     (let ((expected-code
            (if (equal? systype "Darwin") 1 2))
           (expected-err
            (if (equal? systype "Darwin")
                "ls: /zzzzz: No such file or directory"
                "/bin/ls: cannot access /zzzzz: No such file or directory"))

           )
       (test "isys: /bin/ls /zzzzz should have exit code 2" expected-code ec)
       (test "isys: /bin/ls /zzzzz should have empty stdout" "" o)
       (test
        "isys: /bin/ls /zzzzz should have stderr"
        expected-err