| 
									
										
										
										
											2008-06-13 21:54:52 -04:00
										 |  |  | ! Copyright (C) 2008 Slava Pestov. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							|  |  |  | USING: kernel accessors math.intervals | 
					
						
							| 
									
										
										
										
											2010-05-21 21:48:33 -04:00
										 |  |  | system calendar fry | 
					
						
							| 
									
										
										
										
											2008-06-13 21:54:52 -04:00
										 |  |  | random db db.tuples db.types | 
					
						
							|  |  |  | http.server.filters ;
 | 
					
						
							|  |  |  | IN: furnace.cache | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | TUPLE: server-state id expires ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : new-server-state ( id class -- server-state )
 | 
					
						
							|  |  |  |     new swap >>id ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | server-state f
 | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  |     { "id" "ID" +random-id+ system-random-generator } | 
					
						
							| 
									
										
										
										
											2008-09-04 19:15:13 -04:00
										 |  |  |     { "expires" "EXPIRES" BIG-INTEGER +not-null+ } | 
					
						
							| 
									
										
										
										
											2008-06-13 21:54:52 -04:00
										 |  |  | } define-persistent | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : get-state ( id class -- state )
 | 
					
						
							|  |  |  |     new-server-state select-tuple ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : expire-state ( class -- )
 | 
					
						
							|  |  |  |     new
 | 
					
						
							| 
									
										
										
										
											2010-06-22 03:00:19 -04:00
										 |  |  |         -1/0. gmt timestamp>micros [a,b] >>expires | 
					
						
							| 
									
										
										
										
											2008-06-13 21:54:52 -04:00
										 |  |  |     delete-tuples ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | TUPLE: server-state-manager < filter-responder timeout ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : new-server-state-manager ( responder class -- responder' )
 | 
					
						
							|  |  |  |     new
 | 
					
						
							|  |  |  |         swap >>responder | 
					
						
							|  |  |  |         20 minutes >>timeout ; inline
 | 
					
						
							| 
									
										
										
										
											2008-07-08 16:50:38 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-06-13 21:54:52 -04:00
										 |  |  | : touch-state ( state manager -- )
 | 
					
						
							| 
									
										
										
										
											2009-11-18 21:56:09 -05:00
										 |  |  |     timeout>> hence timestamp>micros >>expires drop ;
 |