Megatest

Diff
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Annotate Patch Side-by-side 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

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)
(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

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))
              (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)
(define (save-environment-as-files fname #!key (flst '())(overrides '()))
  (let ((envvars (get-environment-variables))
        (whitesp (regexp "[^a-zA-Z0-9_\\-:;,.\\/%$]")))
     (with-output-to-file (conc fname ".csh")
        (whitesp (regexp "[^a-zA-Z0-9_\\-:;,.\\/%$]"))
	(cshport (open-output-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)))
	(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)))
                     envvars)))
     (with-output-to-file (conc fname ".sh")
       (lambda ()
			(with-output-to-port bshport
			  (lambda ()
          (for-each (lambda (key)
                      (let* ((val (cdr key))
                             (sval (if (string-search whitesp val)(conc "\"" val "\"") val)))
                         (print "export " (car key) "=" sval)))
                    envvars)))))
			    (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.136s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00