Megatest

Diff
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Annotate Patch Unified Diff

Differences From Artifact [7138a29341]:

To Artifact [955623f7b1]:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.
;;======================================================================

(use sqlite3 srfi-1 posix regex-case base64 format dot-locking csv-xml)
(require-extension sqlite3 regex posix)

(require-extension (srfi 18) extras tcp rpc)

(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))













|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.
;;======================================================================

(use sqlite3 srfi-1 posix regex-case base64 format dot-locking csv-xml posix-extras)
(require-extension sqlite3 regex posix)

(require-extension (srfi 18) extras tcp rpc)

(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
︙︙
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124


125
126
127
128
129

130
131



132




133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148

	 (cpu-load #f))
    (for-each (lambda (l)
		(let ((match (string-search load-rx l)))
		  (if match
		      (let ((newval (string->number (cadr match))))
			(if (number? newval)
			    (set! cpu-load newval))))))
	      (car load-res))
    cpu-load))

(define (get-uname . params)
  (let* ((uname-res (cmd-run->list (conc "uname " (if (null? params) "-a" (car params)))))
	 (uname #f))
    (if (null? (car uname-res))
	"unknown"
	(caar uname-res))))
	      


(define (save-environment-as-files fname)
  (let ((envvars (get-environment-variables))
        (whitesp (regexp "[^a-zA-Z0-9_\\-:;,.\\/%$]")))
     (with-output-to-file (conc fname ".csh")
       (lambda ()

          (for-each (lambda (key)
                      (let* ((val (cdr key))



                             (sval (if (string-search whitesp val)(conc "\"" val "\"") val)))




                        (print "setenv " (car key) " " sval)))
                     envvars)))
     (with-output-to-file (conc fname ".sh")
       (lambda ()
          (for-each (lambda (key)
                      (let* ((val (cdr key))
                             (sval (if (string-search whitesp val)(conc "\"" val "\"") val)))
                         (print "export " (car key) "=" sval)))
                    envvars)))))

;; set some env vars from an alist, return an alist with original values
;; (("VAR" "value") ...)
(define (alist->env-vars lst)
  (if (list? lst)
      (let ((res '()))
	(for-each (lambda (p)








|









>
>
|

|
|
<
>
|
|
>
>
>
|
>
>
>
>
|
<
|
|
<
<
<
|
|








108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130

131
132
133
134
135
136
137
138
139
140
141
142

143
144



145
146
147
148
149
150
151
152
153

	 (cpu-load #f))
    (for-each (lambda (l)
		(let ((match (string-search load-rx l)))
		  (if match
		      (let ((newval (string->number (cadr match))))
			(if (number? newval)
			    (set! cpu-load newval))))))
              (car load-res))
    cpu-load))

(define (get-uname . params)
  (let* ((uname-res (cmd-run->list (conc "uname " (if (null? params) "-a" (car params)))))
	 (uname #f))
    (if (null? (car uname-res))
	"unknown"
	(caar uname-res))))
	      
;; filter is a list of vars to not save
;; override is an alist of vars value pairs to override
(define (save-environment-as-files fname #!key (flst '())(overrides '()))
  (let ((envvars (get-environment-variables))
        (whitesp (regexp "[^a-zA-Z0-9_\\-:;,.\\/%$]"))
	(cshport (open-output-file (conc fname ".csh")))

	(bshport (open-output-file (conc fname ".sh"))))
    (for-each (lambda (key)
		(let* ((val (cdr key))
		       (var (car key))
		       (sval (if (assoc var overrides)
				 (cadr (assoc var overrides))
				 (if (string-search whitesp val)(conc "\"" val "\"") val))))
		  (if (not (member var flst))
		      (begin
			(with-output-to-port cshport
			  (lambda ()
			    (print "setenv " (car key) " " sval)))

			(with-output-to-port bshport
			  (lambda ()



			    (print "export " (car key) "=" sval)))))))
	      envvars)))

;; set some env vars from an alist, return an alist with original values
;; (("VAR" "value") ...)
(define (alist->env-vars lst)
  (if (list? lst)
      (let ((res '()))
	(for-each (lambda (p)
︙︙
This page was generated in about 0.126s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00