Megatest

Check-in [53b72738b7]
Login
Overview
Comment:More on portlogger
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 53b72738b7831410857aff27f7edcff50fc6cdd8
User & Date: matt on 2014-08-27 04:20:13
Other Links: branch diff | manifest | tags
Context
2014-08-27
21:53
Marking ports as taken/released/failed now working. One race condtion taken care of but one remains. check-in: 5051742e65 user: matt tags: v1.60
04:20
More on portlogger check-in: 53b72738b7 user: matt tags: v1.60
2014-08-26
23:17
Added debug to portlogger check-in: c02687e1a4 user: matt tags: v1.60
Changes

Modified portlogger.scm from [39b1bee932] to [ec84e46c0a].

1
2
3
4
5
6
7
8
9
1

2
3
4
5
6
7
8

-









;; Copyright 2006-2014, 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
42
43
44
45
46
47
48
49

50
51
52
53

54
55
56
57
58
59
60

61
62
63
64
65
66
67
68
69
70






71
72
73
74
75



76

77
78
79
80
81
82
83
84
85
86












87

41
42
43
44
45
46
47

48
49
50
51

52
53
54
55
56
57
58

59
60
61
62
63
64
65
66
67
68

69
70
71
72
73
74
75
76
77
78
79
80
81
82

83










84
85
86
87
88
89
90
91
92
93
94
95
96
97







-
+



-
+






-
+









-
+
+
+
+
+
+





+
+
+
-
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

+
		db
		(lambda ()
		  ;; (fold-row (lambda (var curr) (or var curr)) #f db "SELECT var FROM foo WHERE id=100;")
		  (let* ((curr #f)
			 (res  #f))
		    (set! curr (sqlite3:fold-row
				(lambda (var curr)
				  (or var curr))
				  (or curr var curr))
				"not-tried"
				qry3
				portnum))
		    (print "curr=" curr)
		    ;; (print "curr=" curr)
		    (set! res (case (string->symbol curr)
				((released)  (sqlite3:execute qry2 "taken" portnum) 'taken)
				((not-tried) (sqlite3:execute qry1 portnum "taken") 'taken)
				((taken)                                            'already-taken)
				((failed)                                           'failed)
				(else                                               'error)))
		    (print "res=" res)
		    ;; (print "res=" res)
		    res)))))
    (sqlite3:finalize! qry1)
    (sqlite3:finalize! qry2)
    (sqlite3:finalize! qry3)
    res))

;; set port to "released", "failed" etc.
;; 
(define (portlogger:set-port db portnum value)
  (sqlite3:execute db "UPDATE ports SET state=? WHERE portnum=?;" value portnum))
  (sqlite3:execute db "UPDATE ports SET state=? WHERE port=?;" value portnum))

;; set port to failed (attempted to take but got error)
;;
(define (portlogger:set-failed db portnum)
  (sqlite3:execute db "UPDATE ports SET state='failed',fail_count=fail_count+1 WHERE port=?;" portnum))

;;======================================================================
;; MAIN
;;======================================================================



(define (portlogger:main . args)
(let* ((db      (portlogger:open-db (conc "/tmp/." (current-user-name))))
  (let* ((db      (portlogger:open-db (conc "/tmp/." (current-user-name))))
       (args    (cdr (argv)))
       (numargs (length args)))
  (cond
   ((> numargs 1) ;; most commands
    (case (string->symbol (car args)) ;; commands with two or more params
      ((take)(portlogger:take-port db (string->number (cadr args))))
      ((set) (portlogger:set-port db 
				  (string->number (cadr args))
				  (caddr args))))))
  (sqlite3:finalize! db))
	 (numargs (length args))
	 (result  (cond
		   ((> numargs 1) ;; most commands
		    (case (string->symbol (car args)) ;; commands with two or more params
		      ((take)(portlogger:take-port db (string->number (cadr args))))
		      ((set) (portlogger:set-port db 
						  (string->number (cadr args))
						  (caddr args))
		       (caddr args))
		      ((failed)(portlogger:set-failed db (string->number (cadr args))) 'failed))))))
    (sqlite3:finalize! db)
    result))
     
(print (apply portlogger:main (cdr (argv))))