Changeset 35163 in project


Ignore:
Timestamp:
02/19/18 22:24:20 (4 months ago)
Author:
kon
Message:

add register variable filter , add environment-variables->environment-list , safer get-shell-variable , add shell-variable-bound? , shell-variable-true?

Location:
release/4/posix-utils/trunk
Files:
2 edited

Legend:

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

    r35149 r35163  
    77 (doc-from-wiki)
    88 (synopsis "posix-utils")
    9  (depends (setup-helper "1.2.0"))
     9 (depends
     10  (setup-helper "1.2.0")
     11  (check-errors "2.1.0"))
    1012 (test-depends test)
    1113 (files "posix-utils.setup" "posix-utils.meta" "posix-utils.scm" "tests/run.scm" "tests/posix-utils-test.scm") )
  • release/4/posix-utils/trunk/posix-utils.scm

    r35150 r35163  
    99
    1010(;export
    11   ;
    1211  string-trim-eol
    13   ;
     12  environment-variables->environment-list
    1413  environment-variable-bound?
    1514  environment-variable-true?
    16   ;
     15  register-environment-variable-feature!
    1716  get-shell-variable
    18   ;
    19   register-environment-variable-feature!
     17  shell-variable-bound?
     18  shell-variable-true?
    2019  register-shell-variable-feature!)
    2120
    2221(import scheme chicken)
    2322(use
     23  (only (srfi 1) member)
     24  (only data-structures identity ->string)
    2425  (only posix process process-wait)
    2526  (only utils read-all)
    26   (only (srfi 13) string-trim-both string-index string-take string-null?)
    27   (only (srfi 14) list->char-set) )
     27  (only (srfi 13) string-trim-both string-index string-take string-null? string-downcase)
     28  (only (srfi 14) list->char-set)
     29  (only check-errors check-string) )
     30
     31;;
     32
     33(define-constant *SHELL-TRUE-VALUES* '("y" "yes" "1"))
     34
     35(: shell-value-bound? ((or boolean string) -> (or boolean string)))
     36(define (shell-value-bound? varval)
     37  (and-let* (
     38    (str varval)
     39    ((not (string-null? str))) )
     40    str ) )
     41
     42(: shell-value-true? ((or boolean string) (or boolean (list-of string)) -> boolean))
     43(define (shell-value-true? varval truedat)
     44  (and-let* (
     45    (str varval) )
     46    (let* (
     47      (truedat (or truedat *SHELL-TRUE-VALUES*))
     48      (str (string-trim-both str))
     49      (str (string-downcase str)) )
     50      (member str truedat string=?) ) ) )
     51
     52(: register-shell-value-feature! ((or boolean string) procedure -> (or boolean symbol)))
     53(define (register-shell-value-feature! varval filter)
     54  (and-let* (
     55    (str (shell-value-bound? varval))
     56    (str (filter str)) )
     57    (let (
     58      (varsym (string->symbol str)) )
     59      (register-feature! varsym)
     60      varsym ) ) )
    2861
    2962;;
     
    5790;;
    5891
    59 (: environment-variable-bound? (string -> (or boolean string)))
    60 (define (environment-variable-bound? varnam)
    61   (and-let* (
    62     (varval (get-environment-variable varnam))
    63     ((not (string-null? varval))) )
    64     varval ) )
     92(define (environment-variables->environment-list al)
     93  (map
     94    (lambda (pare)
     95      (let ((nam (check-string 'environment-variables->environment-list (car pare) "item variable name")))
     96        (string-append nam "=" (->string (cdr pare))) ) )
     97    al) )
    6598
    6699;;
    67100
    68 (: environment-variable-true? (string -> boolean))
    69 (define (environment-variable-true? varnam)
    70   (and-let* (
    71     (varval (environment-variable-bound? varnam))
    72     (varval (string-trim-both varval))
    73     ((not (string-null? varval))) )
    74     (let ((1stch (string-ref varval 0)))
    75       (case 1stch
    76         ((#\N #\n #\0)  #f)
    77         (else           #t) ) ) ) )
     101(: environment-variable-bound? (string -> (or boolean string)))
     102(define (environment-variable-bound? nam)
     103  (shell-value-bound? (get-environment-variable nam)) )
     104
     105(: environment-variable-true? (string #!optional (or boolean (list-of string)) -> boolean))
     106(define (environment-variable-true? nam #!optional truedat)
     107  (shell-value-true? (get-environment-variable nam) truedat) )
     108
     109(: register-environment-variable-feature! (string -> (or boolean symbol)))
     110(define (register-environment-variable-feature! nam #!optional (filter identity))
     111  (register-shell-value-feature! (get-environment-variable nam) filter) )
    78112
    79113;;
     
    81115(: get-shell-variable (string -> (or boolean string)))
    82116(define (get-shell-variable nam)
    83   (let-values (((in out pid) (process (string-append "echo $" nam))))
    84     (let ((instr (read-all in)))
    85       ;
    86       (process-wait pid)      ;FIXME timeout
    87       ;
    88       (close-input-port in)
    89       (close-output-port out)
    90       ;
    91       (and-let* (
    92         (varval (string-trim-eol instr))
    93         ((not (string-null? varval))) )
    94         varval ) ) ) )
     117  (let ((in (void)) (out (void)) (pid (void)))
     118    (dynamic-wind
     119      (lambda ()
     120        (set!-values (in out pid)
     121          (process (string-append "echo \"$" nam  "\""))) )
     122      (lambda ()
     123        (and-let* (
     124          ;echo command result (w/ eol)
     125          (instr (read-all in))
     126          ;remove trailing eol from echo command
     127          (str (string-trim-eol instr)) )
     128          ;the shell variable value
     129          str ) )
     130      (lambda ()
     131        (close-input-port in)
     132        (close-output-port out) ) ) ) )
    95133
    96 ;;
     134(: shell-variable-bound? (string -> (or boolean string)))
     135(define (shell-variable-bound? nam)
     136  (shell-value-bound? (get-shell-variable nam)) )
    97137
    98 (: register-environment-variable-feature! (string -> (or boolean symbol)))
    99 (define (register-environment-variable-feature! nam)
    100   (and-let* (
    101     (varval (environment-variable-bound? nam))
    102     (varsym (string->symbol varval)) )
    103     (register-feature! varsym)
    104     varsym ) )
    105 
     138(: shell-variable-true? (string #!optional (or boolean (list-of string)) -> boolean))
     139(define (shell-variable-true? nam #!optional truedat)
     140  (shell-value-true? (get-shell-variable nam) truedat) )
    106141
    107142(: register-shell-variable-feature! (string -> (or boolean symbol)))
    108 (define (register-shell-variable-feature! nam)
    109   (and-let* (
    110     (varval (get-shell-variable nam))
    111     (varsym (string->symbol varval)) )
    112     (register-feature! varsym)
    113     varsym ) )
     143(define (register-shell-variable-feature! nam #!optional (filter identity))
     144  (register-shell-value-feature! (get-shell-variable nam) filter) )
     145
     146;;;
    114147
    115148) ;module posix-utils
Note: See TracChangeset for help on using the changeset viewer.