2008-06-13 21:54:52 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2008 Slava Pestov.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: kernel sequences db.tuples alarms calendar db fry
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-10 00:41:45 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								furnace.db
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-13 21:54:52 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								furnace.cache
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-21 20:42:05 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								furnace.asides
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-10 00:41:45 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								furnace.sessions
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								furnace.conversations
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-16 06:16:51 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								furnace.auth.providers
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								furnace.auth.login.permits ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-13 21:54:52 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: furnace.alloy
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-22 01:36:07 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: state-classes { session aside conversation permit } ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-13 21:54:52 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: init-furnace-tables ( -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-22 01:36:07 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    state-classes ensure-tables
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    user ensure-table ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-13 21:54:52 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-02 13:51:21 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: <alloy> ( responder db -- responder' )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ [ init-furnace-tables ] with-db ] keep
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-23 04:34:48 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-02 13:51:21 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        <asides>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        <conversations>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        <sessions>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] dip
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-16 17:19:18 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    <db-persistence> ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-23 04:34:48 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-02 13:51:21 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: start-expiring ( db -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-13 21:54:52 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    '[
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-02 13:51:21 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        _ [ state-classes [ expire-state ] each ] with-db
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-13 21:54:52 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] 5 minutes every drop ;
							 |