Megatest

Check-in [53b72738b7]
Login
☰Home Timeline Files Branches Tags Tickets Wiki 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
Hide Diffs Unified Diffs Ignore Whitespace Patch

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

1
2
3
4
5
6
7
8
9



;; 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


<








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


		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))
				"not-tried"
				qry3
				portnum))
		    (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)
		    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))






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




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

     









|



|






|









|
>
>
>
>
>





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

>

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 curr var curr))
				"not-tried"
				qry3
				portnum))
		    ;; (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)
		    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 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))))

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

This page was generated in about 0.124s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00