From 268dfaeec923b1da82cee06e648bf60da8d8d40d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 23 Feb 2008 23:15:50 -0600
Subject: [PATCH] Get furnace to load again

---
 extra/furnace/furnace.factor                  | 12 +----
 extra/furnace/sessions/sessions.factor        | 51 +++++++++++--------
 .../assoc-heaps/assoc-heaps-tests.factor      |  0
 .../assoc-heaps/assoc-heaps.factor            |  0
 .../assoc-heaps/authors.txt                   |  0
 .../assoc-heaps/summary.txt                   |  0
 6 files changed, 33 insertions(+), 30 deletions(-)
 mode change 100644 => 100755 extra/furnace/sessions/sessions.factor
 rename {extra => unmaintained}/assoc-heaps/assoc-heaps-tests.factor (100%)
 rename {extra => unmaintained}/assoc-heaps/assoc-heaps.factor (100%)
 rename {extra => unmaintained}/assoc-heaps/authors.txt (100%)
 rename {extra => unmaintained}/assoc-heaps/summary.txt (100%)

diff --git a/extra/furnace/furnace.factor b/extra/furnace/furnace.factor
index 9b7a8a8aa5..11ff697049 100755
--- a/extra/furnace/furnace.factor
+++ b/extra/furnace/furnace.factor
@@ -57,17 +57,9 @@ SYMBOL: validation-errors
         ] if*
     ] with map ;
 
-: expire-sessions ( -- )
-    sessions get-global
-    [ nip session-last-seen 20 minutes ago <=> 0 > ]
-    [ 2drop ] heap-pop-while ;
-
 : lookup-session ( hash -- session )
-    "furnace-session-id" over at sessions get-global at [
-        nip
-    ] [
-        new-session rot "furnace-session-id" swap set-at
-    ] if* ;
+    "furnace-session-id" over at get-session
+    [ ] [ new-session "furnace-session-id" roll set-at ] ?if ;
 
 : quot>query ( seq action -- hash )
     >r >array r> "action-params" word-prop
diff --git a/extra/furnace/sessions/sessions.factor b/extra/furnace/sessions/sessions.factor
old mode 100644
new mode 100755
index 523598efe7..579e5a607e
--- a/extra/furnace/sessions/sessions.factor
+++ b/extra/furnace/sessions/sessions.factor
@@ -1,37 +1,48 @@
-USING: assoc-heaps assocs calendar crypto.sha2 heaps
-init kernel math.parser namespaces random ;
+USING: assocs calendar init kernel math.parser
+namespaces random boxes alarms ;
 IN: furnace.sessions
 
 SYMBOL: sessions
 
+: timeout ( -- dt ) 20 minutes ;
+
 [
-    H{ } clone <min-heap> <assoc-heap>
-    sessions set-global
+    H{ } clone sessions set-global
 ] "furnace.sessions" add-init-hook
 
 : new-session-id ( -- str )
-    4 big-random number>string string>sha-256-string
-    dup sessions get-global at [ drop new-session-id ] when ;
+    4 big-random >hex
+    dup sessions get-global key?
+    [ drop new-session-id ] when ;
 
-TUPLE: session created last-seen user-agent namespace ;
+TUPLE: session id namespace alarm user-agent ;
 
-M: session <=> ( session1 session2 -- n )
-    [ session-last-seen ] 2apply <=> ;
+: cancel-timeout ( session -- )
+    session-alarm ?box [ cancel-alarm ] [ drop ] if ;
 
-: <session> ( -- obj )
-    now dup H{ } clone
-    [ set-session-created set-session-last-seen set-session-namespace ]
-    \ session construct ;
+: delete-session ( session -- )
+    sessions get-global delete-at*
+    [ cancel-timeout ] [ drop ] if ;
 
-: new-session ( -- obj id )
-    <session> new-session-id [ sessions get-global set-at ] 2keep ;
+: touch-session ( session -- )
+    dup cancel-timeout
+    dup [ session-id delete-session ] curry timeout later
+    swap session-alarm >box ;
 
-: get-session ( id -- obj/f )
-    sessions get-global at* [ "no session found 1" throw ] unless ;
+: <session> ( id -- session )
+    H{ } clone <box> f session construct-boa ;
 
-! Delete from the assoc only, the heap will timeout
-: destroy-session ( id -- )
-    sessions get-global assoc-heap-assoc delete-at ;
+: new-session ( -- session id )
+    new-session-id [
+        dup <session> [
+            [ sessions get-global set-at ] keep
+            touch-session
+        ] keep
+    ] keep ;
+
+: get-session ( id -- session/f )
+    sessions get-global at*
+    [ dup touch-session ] when ;
 
 : session> ( str -- obj )
     session get session-namespace at ;
diff --git a/extra/assoc-heaps/assoc-heaps-tests.factor b/unmaintained/assoc-heaps/assoc-heaps-tests.factor
similarity index 100%
rename from extra/assoc-heaps/assoc-heaps-tests.factor
rename to unmaintained/assoc-heaps/assoc-heaps-tests.factor
diff --git a/extra/assoc-heaps/assoc-heaps.factor b/unmaintained/assoc-heaps/assoc-heaps.factor
similarity index 100%
rename from extra/assoc-heaps/assoc-heaps.factor
rename to unmaintained/assoc-heaps/assoc-heaps.factor
diff --git a/extra/assoc-heaps/authors.txt b/unmaintained/assoc-heaps/authors.txt
similarity index 100%
rename from extra/assoc-heaps/authors.txt
rename to unmaintained/assoc-heaps/authors.txt
diff --git a/extra/assoc-heaps/summary.txt b/unmaintained/assoc-heaps/summary.txt
similarity index 100%
rename from extra/assoc-heaps/summary.txt
rename to unmaintained/assoc-heaps/summary.txt