Setting props
Scaffold for git monitor Persistent queue implementation
This commit is contained in:
parent
2e5a0e3a37
commit
19ab1bb980
15
collects/meta/drdr2/git-monitor/monitor.rkt
Normal file
15
collects/meta/drdr2/git-monitor/monitor.rkt
Normal file
|
@ -0,0 +1,15 @@
|
|||
#lang racket
|
||||
(require "../lib/pqueue.rkt")
|
||||
|
||||
(define (main)
|
||||
|
||||
; Setup the queue to receive push information
|
||||
; Read the short term database to find out what push we're at
|
||||
; While true
|
||||
; Check the online push counter
|
||||
; Get the information about a push
|
||||
; Add it to the queue
|
||||
; Add it to the long term database
|
||||
; Update the latest push in the short term database
|
||||
|
||||
...)
|
64
collects/meta/drdr2/lib/pqueue.rkt
Normal file
64
collects/meta/drdr2/lib/pqueue.rkt
Normal file
|
@ -0,0 +1,64 @@
|
|||
#lang racket
|
||||
(require mzlib/os)
|
||||
|
||||
(struct pqueue (dir))
|
||||
|
||||
(define (pqueue-tmp dir) (build-path dir "tmp"))
|
||||
(define (pqueue-dest dir) (build-path dir "queue"))
|
||||
|
||||
(define pqueue-init!
|
||||
(match-lambda
|
||||
[(pqueue dir)
|
||||
(make-directory* (pqueue-tmp dir))
|
||||
(make-directory* (pqueue-dest dir))]))
|
||||
|
||||
(define (pqueue-enqueue! pq v)
|
||||
(match-define (pqueue dir) pq)
|
||||
(define uniq
|
||||
(format "~a.~a"
|
||||
(current-inexact-milliseconds)
|
||||
(getpid)))
|
||||
(define tmp (build-path (pqueue-tmp dir) uniq))
|
||||
(define dest (build-path (pqueue-dest dir) uniq))
|
||||
|
||||
(with-output-to-file tmp
|
||||
(λ () (write v)))
|
||||
|
||||
(rename-file-or-directory tmp dest))
|
||||
|
||||
(define current-pqueue-wait-seconds (make-parameter 10))
|
||||
|
||||
(define (pqueue-dequeue! pq)
|
||||
(match-define (pqueue dir) pq)
|
||||
(match (sort (directory-list (pqueue-dest dir))
|
||||
string<=?
|
||||
#:key path->string)
|
||||
[(list-rest choice _)
|
||||
(define dest
|
||||
(build-path (pqueue-dest dir) choice))
|
||||
(define tmp
|
||||
(build-path (pqueue-tmp dir) choice))
|
||||
|
||||
(define succeeded?
|
||||
(with-handlers ([exn? (λ (x) #f)])
|
||||
(rename-file-or-directory dest tmp)
|
||||
#t))
|
||||
(if (not succeeded?)
|
||||
(pqueue-dequeue! pq)
|
||||
(dynamic-wind
|
||||
void
|
||||
(λ ()
|
||||
(with-input-from-file tmp read))
|
||||
(λ ()
|
||||
(delete-file tmp))))]
|
||||
[_
|
||||
(sleep (current-pqueue-wait-seconds))
|
||||
(pqueue-dequeue! pq)]))
|
||||
|
||||
(provide/contract
|
||||
[current-pqueue-wait-seconds (parameter/c exact-nonnegative-integer?)]
|
||||
[struct pqueue ([dir path-string?])]
|
||||
[pqueue-init! (pqueue? . -> . void)]
|
||||
[pqueue-enqueue! (pqueue? any/c . -> . void)]
|
||||
[pqueue-dequeue! (pqueue? . -> . any/c)])
|
||||
|
|
@ -98,7 +98,7 @@
|
|||
(close-output-port op)))))
|
||||
|
||||
(define (main)
|
||||
; commandline
|
||||
; XXX commandline
|
||||
(define port 4532)
|
||||
(define *password* "foo")
|
||||
; XXX
|
||||
|
|
18
collects/meta/drdr2/tests/pqueue.rkt
Normal file
18
collects/meta/drdr2/tests/pqueue.rkt
Normal file
|
@ -0,0 +1,18 @@
|
|||
#lang racket
|
||||
(require tests/eli-tester
|
||||
"../lib/pqueue.rkt")
|
||||
|
||||
(define N 10)
|
||||
|
||||
(test
|
||||
(local [(define pq
|
||||
(pqueue (make-temporary-file "tmp~a" 'directory)))]
|
||||
(test (pqueue-init! pq)
|
||||
|
||||
(for ([i (in-range N)])
|
||||
(pqueue-enqueue! pq i))
|
||||
|
||||
(for/list ([i (in-range N)])
|
||||
(pqueue-dequeue! pq))
|
||||
=>
|
||||
(for/list ([i (in-range N)]) i))))
|
|
@ -987,6 +987,7 @@ path/s is either such a string or a list of them.
|
|||
"collects/meta/check-dists.rkt" drdr:timeout 480
|
||||
"collects/meta/contrib/completion/racket-completion.bash" responsible (samth sstrickl) drdr:command-line #f
|
||||
"collects/meta/drdr" responsible (jay) drdr:command-line #f
|
||||
"collects/meta/drdr2" responsible (jay) drdr:command-line #f
|
||||
"collects/meta/web/build.rkt" drdr:command-line (racket "-t" * "--" "-o" "build" "-f" "-l")
|
||||
"collects/mred" responsible (mflatt)
|
||||
"collects/mred/edit-main.rkt" drdr:command-line (mzc *)
|
||||
|
|
Loading…
Reference in New Issue
Block a user