From 19ab1bb980c5e26c390c0cc38f2b642e0dccd8c7 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Tue, 5 Oct 2010 15:59:47 -0600
Subject: [PATCH] Setting props Scaffold for git monitor Persistent queue
 implementation

---
 collects/meta/drdr2/git-monitor/monitor.rkt | 15 +++++
 collects/meta/drdr2/lib/pqueue.rkt          | 64 +++++++++++++++++++++
 collects/meta/drdr2/slave/slave.rkt         |  2 +-
 collects/meta/drdr2/tests/pqueue.rkt        | 18 ++++++
 collects/meta/props                         |  1 +
 5 files changed, 99 insertions(+), 1 deletion(-)
 create mode 100644 collects/meta/drdr2/git-monitor/monitor.rkt
 create mode 100644 collects/meta/drdr2/lib/pqueue.rkt
 create mode 100644 collects/meta/drdr2/tests/pqueue.rkt

diff --git a/collects/meta/drdr2/git-monitor/monitor.rkt b/collects/meta/drdr2/git-monitor/monitor.rkt
new file mode 100644
index 0000000000..1e9400ed32
--- /dev/null
+++ b/collects/meta/drdr2/git-monitor/monitor.rkt
@@ -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
+  
+  ...)
\ No newline at end of file
diff --git a/collects/meta/drdr2/lib/pqueue.rkt b/collects/meta/drdr2/lib/pqueue.rkt
new file mode 100644
index 0000000000..8d1554c9a9
--- /dev/null
+++ b/collects/meta/drdr2/lib/pqueue.rkt
@@ -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)])
+ 
\ No newline at end of file
diff --git a/collects/meta/drdr2/slave/slave.rkt b/collects/meta/drdr2/slave/slave.rkt
index f76885cb0a..c66a253e1f 100644
--- a/collects/meta/drdr2/slave/slave.rkt
+++ b/collects/meta/drdr2/slave/slave.rkt
@@ -98,7 +98,7 @@
        (close-output-port op)))))
 
 (define (main)
-  ; commandline
+  ; XXX commandline
   (define port 4532)
   (define *password* "foo")
   ; XXX
diff --git a/collects/meta/drdr2/tests/pqueue.rkt b/collects/meta/drdr2/tests/pqueue.rkt
new file mode 100644
index 0000000000..fc9c2c745f
--- /dev/null
+++ b/collects/meta/drdr2/tests/pqueue.rkt
@@ -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))))
\ No newline at end of file
diff --git a/collects/meta/props b/collects/meta/props
index 97c3777414..c3274f4314 100755
--- a/collects/meta/props
+++ b/collects/meta/props
@@ -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 *)