Megatest

Diff
Login

Differences From Artifact [7cd57dd118]:

To Artifact [ddeeddaa42]:


42
43
44
45
46
47
48
49
50
51
52
53

54
55
56
57
58
59
60
db:get-dbdat
db:get-inmem
db:get-ddb
db:open-dbdat
db:open-run-db
db:open-inmem-db
db:setup
db:get-main-lock
db:with-lock-db
db:get-iam-server-lock
db:get-locker
db:take-lock

db:release-lock
db:general-sqlite-error-dump
db:first-result-default
db:generic-error-printout
db:with-db
db:set-sync
db:get-last-update-time







|




>







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
db:get-dbdat
db:get-inmem
db:get-ddb
db:open-dbdat
db:open-run-db
db:open-inmem-db
db:setup
;; db:get-main-lock
db:with-lock-db
db:get-iam-server-lock
db:get-locker
db:take-lock
db:steal-lock-db
db:release-lock
db:general-sqlite-error-dump
db:first-result-default
db:generic-error-printout
db:with-db
db:set-sync
db:get-last-update-time
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535

536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552





553
554
555
556
557
558
559
;;  NOTE:
;;       These operate directly on the disk file, NOT on the inmemory db
;;       The lockname is the filename (can have many to one, run-id to fname 
;;======================================================================

;; only use for main.db - need to re-write some of this :(
;;
(define (db:get-main-lock dbfile)
  (db:with-lock-db dbfile
		(lambda (dbh dbfile)
		  (db:get-iam-server-lock dbh dbfile))))

(define (db:with-lock-db dbfile proc)
  (let* ((dbh (db:open-run-db dbfile db:initialize-db))
	 (res (proc dbh dbfile)))
    ;; (sqlite3:finalize! dbh)
    res))

;; called before db is open?
;;
(define (db:get-iam-server-lock dbh dbfname)
  (sqlite3:with-transaction
   dbh
   (lambda ()
     (let* ((locker (db:get-locker dbh dbfname)))
       (if locker
	   #f

	   (db:take-lock dbh dbfname))))))
	     
;; (exn sqlite3) 
(define (db:get-locker dbh dbfname)
  (condition-case
   (sqlite3:first-row dbh "SELECT owner_pid,owner_host,event_time FROM locks WHERE lockname=?;" dbfname)
   (exn (sqlite3) #f)))

;; should never fail because it is run in a transaction with a test for the lock
;;
(define (db:take-lock dbh dbfname)
  ;; (condition-case
  ;;  (begin
     (sqlite3:execute dbh "INSERT INTO locks (lockname,owner_pid,owner_host) VALUES (?,?,?);" dbfname (current-process-id) (get-host-name))
   ;;   #t)
     ;; (exn (sqlite3) #f)))
     #t)






(define (db:release-lock dbh dbfname)
  (sqlite3:execute dbh "DELETE FROM locks WHERE lockname=?;" dbfname))

;;======================================================================
;; SQLITE3 HELPERS
;;======================================================================







|












|





<
>
|




|




|


|



>
>
>
>
>







510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535

536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
;;  NOTE:
;;       These operate directly on the disk file, NOT on the inmemory db
;;       The lockname is the filename (can have many to one, run-id to fname 
;;======================================================================

;; only use for main.db - need to re-write some of this :(
;;
#;(define (db:get-main-lock dbfile)
  (db:with-lock-db dbfile
		(lambda (dbh dbfile)
		  (db:get-iam-server-lock dbh dbfile))))

(define (db:with-lock-db dbfile proc)
  (let* ((dbh (db:open-run-db dbfile db:initialize-db))
	 (res (proc dbh dbfile)))
    ;; (sqlite3:finalize! dbh)
    res))

;; called before db is open?
;;
(define (db:get-iam-server-lock dbh dbfname port)
  (sqlite3:with-transaction
   dbh
   (lambda ()
     (let* ((locker (db:get-locker dbh dbfname)))
       (if locker

	   locker
	   (db:take-lock dbh dbfname port))))))
	     
;; (exn sqlite3) 
(define (db:get-locker dbh dbfname)
  (condition-case
   (sqlite3:first-row dbh "SELECT owner_pid,owner_host,owner_port,event_time FROM locks WHERE lockname=?;" dbfname)
   (exn (sqlite3) #f)))

;; should never fail because it is run in a transaction with a test for the lock
;;
(define (db:take-lock dbh dbfname port)
  ;; (condition-case
  ;;  (begin
     (sqlite3:execute dbh "INSERT INTO locks (lockname,owner_pid,owner_host,owner_port) VALUES (?,?,?,?);" dbfname (current-process-id) (get-host-name) port)
   ;;   #t)
     ;; (exn (sqlite3) #f)))
     #t)

(define (db:steal-lock-db dbh dbfname port)
  (sqlite3:execute dbh "DELETE FROM locks WHERE lockname=?;" dbfname)
  (sqlite3:execute dbh "INSERT INTO locks (lockname,owner_pid,owner_host,owner_port) VALUES (?,?,?,?);" dbfname (current-process-id) (get-host-name) port)
  #t)

(define (db:release-lock dbh dbfname)
  (sqlite3:execute dbh "DELETE FROM locks WHERE lockname=?;" dbfname))

;;======================================================================
;; SQLITE3 HELPERS
;;======================================================================
1513
1514
1515
1516
1517
1518
1519

1520
1521
1522
1523
1524
1525
1526
     db
     (lambda ()
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS locks
                                   (id INTEGER PRIMARY KEY,
                                    lockname TEXT,
                                    owner_pid INTEGER,
                                    owner_host TEXT,

                                    event_time TIMESTAMP DEFAULT (strftime('%s','now')),
                               CONSTRAINT lock_constraint UNIQUE (lockname));")

       ;; maps to *srvpktspec* from http-transportmod
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS servers
                                   (id INTEGER PRIMARY KEY,
                                    host TEXT,







>







1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
     db
     (lambda ()
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS locks
                                   (id INTEGER PRIMARY KEY,
                                    lockname TEXT,
                                    owner_pid INTEGER,
                                    owner_host TEXT,
                                    owner_port TEXT,
                                    event_time TIMESTAMP DEFAULT (strftime('%s','now')),
                               CONSTRAINT lock_constraint UNIQUE (lockname));")

       ;; maps to *srvpktspec* from http-transportmod
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS servers
                                   (id INTEGER PRIMARY KEY,
                                    host TEXT,