Changeset 35148 in project


Ignore:
Timestamp:
02/18/18 06:58:30 (10 months ago)
Author:
kon
Message:

add get-shell-variable , register-shell-variable-feature! , register-environment-variable-feature! , char-set:software-eol , string-trim-eol

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/posix-utils/trunk/posix-utils.scm

    r24131 r35148  
    11;;;; posix-utils.scm
    22;;;; Kon Lovett, Nov '10
     3;;;; Kon Lovett, Feb '18
    34
    45;; Issues
     
    78(module posix-utils
    89
    9   (;export
    10     environment-variable-bound?
    11     environment-variable-true?)
     10(;export
     11  ;
     12  char-set:software-eol
     13  string-trim-eol
     14  ;
     15  environment-variable-bound?
     16  environment-variable-true?
     17  ;
     18  get-shell-variable
     19  ;
     20  register-environment-variable-feature!
     21  register-shell-variable-feature!)
    1222
    13   (import
    14     scheme chicken)
     23(import scheme chicken)
     24(use
     25  (only posix process process-wait)
     26  (only utils read-all)
     27  (only (srfi 13) string-index string-take string-null?)
     28  (only (srfi 14) list->char-set) )
    1529
    1630;;
    1731
    18 (define (environment-variable-bound? varnam)
    19   (let ((varval (get-environment-variable varnam)))
    20     (and varval (not (string=? "" varval))
    21          varval) ) )
     32(define software-eol-chars
     33  (cond-expand
     34    (windows
     35     '(#\return #\newline))
     36    (unix
     37     '(#\newline))
     38    (else
     39     '(#\return)) ) )
     40
     41(define software-eol-chars-length (length software-eol-chars))
     42
     43(define char-set:software-eol (list->char-set software-eol-chars))
     44
     45(define (string-trim-eol str)
     46  (let* (
     47    (end (string-length str))
     48    (start (fx- end software-eol-chars-length)) )
     49    (if (or (fx< start 0) (fx>= start end))
     50      str
     51      (let ((eol (string-index str char-set:software-eol start end)))
     52        (if (not eol)
     53          str
     54          (string-take str eol) ) ) ) ) )
    2255
    2356;;
    2457
     58(: environment-variable-bound? (string -> (or boolean string)))
     59(define (environment-variable-bound? varnam)
     60  (and-let* (
     61    (varval (get-environment-variable varnam))
     62    ((not (string-null? varval))) )
     63    varval ) )
     64
     65;;
     66
     67(: environment-variable-true? (string -> boolean))
    2568(define (environment-variable-true? varnam)
    2669  (and-let* ((varval (environment-variable-bound? varnam)))
    2770    (let ((1stch (string-ref varval 0)))
    28       (or (char=? #\Y 1stch)
    29           (char=? #\1 1stch)
    30           (char=? #\y 1stch))) ) )
     71      (case 1stch
     72        ((#\N #\n #\0)  #f)
     73        (else           #t) ) ) ) )
     74
     75;;
     76
     77(: get-shell-variable (string -> (or boolean string)))
     78(define (get-shell-variable nam)
     79  (let-values (((in out pid) (process (string-append "echo $" nam))))
     80    (let* (
     81      (instr (read-all in))
     82      (varval (string-trim-eol instr))
     83      (varval (and (not (string-null? varval)) varval)) )
     84      ;
     85      (process-wait pid)      ;FIXME timeout
     86      ;
     87      (close-input-port in)
     88      (close-output-port out)
     89      ;
     90      varval ) ) )
     91
     92;;
     93
     94(: register-environment-variable-feature! (string -> (or boolean symbol)))
     95(define (register-environment-variable-feature! nam)
     96  (and-let* (
     97    (varval (environment-variable-bound? nam))
     98    (varsym (string->symbol varval)) )
     99    (register-feature! varsym)
     100    varsym ) )
     101
     102
     103(: register-shell-variable-feature! (string -> (or boolean symbol)))
     104(define (register-shell-variable-feature! nam)
     105  (and-let* (
     106    (varval (get-shell-variable nam))
     107    (varsym (string->symbol varval)) )
     108    (register-feature! varsym)
     109    varsym ) )
    31110
    32111) ;module posix-utils
Note: See TracChangeset for help on using the changeset viewer.