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
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-04 19:15:13 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								system calendar alarms 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
							 | 
						
					
						
							
								
									
										
										
										
											2009-04-13 20:48:08 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        -1/0. millis [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 -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-04 19:15:13 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    timeout>> hence timestamp>millis >>expires drop ;
							 |