Megatest

Diff
Login

Differences From Artifact [5a1029146c]:

To Artifact [f5e4dc88a2]:


2337
2338
2339
2340
2341
2342
2343


2344

2345
2346
2347
2348
2349
2350
2351
2337
2338
2339
2340
2341
2342
2343
2344
2345

2346
2347
2348
2349
2350
2351
2352
2353







+
+
-
+







		(target    . t)
		(status    . u)
		(parent    . P)))))

(define (common:get-pkts-dirs mtconf use-lt)
  (let* ((pktsdirs-str (or (configf:lookup mtconf "setup"  "pktsdirs")
			   (and use-lt
				(conc (or *toppath*
					  (current-directory))
				(conc *toppath* "/lt/.pkts"))))
				      "/lt/.pkts"))))
	 (pktsdirs  (if pktsdirs-str
			(string-split pktsdirs-str " ")
			#f)))
    pktsdirs))

(define (common:save-pkt pktalist-in mtconf use-lt)
  (let* ((parent   (hash-table-ref/default *pkts-info* 'last-parent #f))
2379
2380
2381
2382
2383
2384
2385
2386

2387
2388
2389
2390
2391
2392
2393
2381
2382
2383
2384
2385
2386
2387

2388
2389
2390
2391
2392
2393
2394
2395







-
+







	  (print "ERROR: settings are missing in your megatest.config for area management.")
	  (print "  you need to have pktsdir in the [setup] section."))
	(let* ((pdb  (open-queue-db pdbpath "pkts.db"
				    schema: '("CREATE TABLE groups (id INTEGER PRIMARY KEY,groupname TEXT, CONSTRAINT group_constraint UNIQUE (groupname));"))))
	  (proc pktsdirs pktsdir pdb)
	  (dbi:close pdb)))))

(define (common:load-pkts-to-db mtconf)
(define (common:load-pkts-to-db mtconf #!key (use-lt #f))
  (common:with-queue-db
   mtconf
   (lambda (pktsdirs pktsdir pdb)
     (for-each
      (lambda (pktsdir) ;; look at all
	(if (and (file-exists? pktsdir)
		 (directory? pktsdir)
2404
2405
2406
2407
2408
2409
2410
2411


2412
2413
2414
2415
2416
2417
2418
2406
2407
2408
2409
2410
2411
2412

2413
2414
2415
2416
2417
2418
2419
2420
2421







-
+
+







			      (apkt   (pkt->alist pktdat))
			      (ptype  (alist-ref 'T apkt)))
			 (add-to-queue pdb pktdat uuid (or ptype 'cmd) #f 0)
			 (debug:print 4 *default-log-port* "Added " uuid " of type " ptype " to queue"))
		       (debug:print 4 *default-log-port* "pkt: " uuid " exists, skipping...")
		       )))
	       pkts))))
      pktsdirs))))
      pktsdirs))
   use-lt: use-lt))

(define (common:get-pkt-alists pkts)
  (map (lambda (x)
	 (alist-ref 'apkt x)) ;; 'pkta pulls out the alist from the read pkt
       pkts))

;; given list of pkts (alist mode) return list of D cards as Unix epoch, sorted descending