Commit e633e9a2 authored by Bas Lijnse's avatar Bas Lijnse

First version of push events (if your browser supports it) using html5 server-sent events

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@2499 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent ef87dc27
......@@ -61,14 +61,16 @@ Ext.define('itwc.component.choice.Grid',{
this.fireEvent('change');
},
setValue: function(value) {
var me = this;
if(Ext.isArray(value) && value.length) {
value = value[0];
}
if(Ext.isNumber(value) && value < this.store.count() && value >= 0) {
this.value = value;
this.getSelectionModel().select(value);
if(Ext.isNumber(value) && value < me.store.count()) {
me.value = value;
me.getSelectionModel().select(value);
} else {
this.getSelectionModel().deselectAll();
me.getSelectionModel().deselectAll();
}
},
setOptions: function(options) {
......
......@@ -9,5 +9,15 @@ Ext.define('itwc.component.edit.Note',{
initComponent: function() {
this.callParent(arguments);
this.initEditable();
},
setValue: function (value, noEvent) {
var me = this;
if(noEvent) {
me.suspendEvent('change');
me.callParent([value]);
me.resumeEvent('change');
} else {
me.callParent([value]);
}
}
});
......@@ -66,6 +66,9 @@ Ext.define('itwc.controller.Controller', {
nextSendEventNo: 0,
flushingTaskEvents: false,
refresher: null,
uiUpdateSource: null,
init: function() {
this.viewport = null;
......@@ -85,8 +88,24 @@ Ext.define('itwc.controller.Controller', {
//Keep reference to server
this.viewport = viewport;
//Sync with server for the first time
this.queueTaskEvent({});
//Try to setup a server-side event source for receiving gui updates
//continuously via push events
if (!!window.EventSource) {
this.uiUpdateSource = new EventSource('?format=json-gui-events');
this.uiUpdateSource.addEventListener('session', Ext.bind(this.onSessionPushEvent,this), false);
this.uiUpdateSource.addEventListener('message', Ext.bind(this.onUpdatePushEvent,this), false);
} else {
//Fallback...
//Sync with server for the first time
this.queueTaskEvent({});
}
},
onSessionPushEvent: function (e) {
this.session = e.data;
},
onUpdatePushEvent: function (e) {
this.partialUpdate(Ext.decode(e.data));
},
//iTasks edit events
onEdit: function(taskId, editorId, value) {
......@@ -101,7 +120,6 @@ Ext.define('itwc.controller.Controller', {
taskId, "edit", editorId, value);
}else{ // Normal case (not a tasklet)
this.sendEditEvent(taskId, editorId, value);
}
},
......@@ -211,7 +229,8 @@ Ext.define('itwc.controller.Controller', {
me.partialUpdate(message.updates);
}
//Schedule automatic refresh when an expiration time is set
if(Ext.isNumber(message.expiresIn)) {
//and we do not have a push event source
if(!me.uiUpdateSource && Ext.isNumber(message.expiresIn)) {
me.refresher.delay(message.expiresIn);
}
......
This diff is collapsed.
require '..\..\..\packages\ext-theme-base\sass\utils.rb'
require '..\..\..\sass\config.rb'
require '../../../packages/ext-theme-base/sass/utils.rb'
require '../../../sass/config.rb'
This diff is collapsed.
......@@ -1974,7 +1974,7 @@
"t": 0
},
"box": {
"h": 27,
"h": 26,
"w": 175,
"x": 11,
"y": 5051
......@@ -2002,7 +2002,7 @@
"h": 31,
"w": 175,
"x": 11,
"y": 5428
"y": 5426
},
"gradient": "top",
"id": "datepicker-1112-footerEl",
......@@ -2027,7 +2027,7 @@
"h": 31,
"w": 164,
"x": 10,
"y": 5470
"y": 5468
},
"id": "roweditorbuttons-1115",
"radius": {
......
This diff was suppressed by a .gitattributes entry.
This diff is collapsed.
......@@ -3,10 +3,8 @@ definition module iTasks
/**
* Main iTask module exporting all end user iTask modules
*/
import iTasks.Framework.Engine // basic iTask system creator
, iTasks.Framework.EngineWrapperStandalone // standalone wrapper
//, iTasks.Framework.EngineWrapperCGI // CGI wrapper
import iTasks.Framework.Engine // iTasks engine
, iTasks.Framework.SerializationGraphCopy // use serialization via graph_copy
//, iTasks.Framework.SerializationDynamicLinker // use serialization via dynamic linker
......
......@@ -8,11 +8,9 @@ definition module iTasks.Framework.Engine
from StdList import ++, iterate, take
from System.FilePath import </>
from System.OS import IF_POSIX_OR_WINDOWS
import iTasks.Framework.Task
from iTasks.Framework.IWorld import :: IWorld
from Internet.HTTP import :: HTTPRequest, :: HTTPResponse
from Internet.HTTP import :: HTTPRequest
//* Configuarion defaults
DEFAULT_PORT :== IF_POSIX_OR_WINDOWS 8080 80
......@@ -39,12 +37,13 @@ URL_PREFIX :== ""
| JSONPlain
/**
* Creates the iTasks system from a set of published tasks
* Starts the task engine with a list of published task definitions.
*
* @param The config record
* @param A task to execute
* @param Tasks to start
* @param The world
* @return The world
*/
engine :: publish -> [(!String -> Bool,!HTTPRequest *IWorld -> (!HTTPResponse, !*IWorld))] | Publishable publish
startEngine :: a !*World -> *World | Publishable a
/**
* Wraps a task together with a url to make it publishable by the engine
......@@ -58,29 +57,3 @@ where
instance Publishable (Task a) | iTask a
instance Publishable (HTTPRequest -> Task a) | iTask a
instance Publishable [PublishedTask]
/**
* Inititialize the iworld
*/
initIWorld :: !FilePath !*World -> *IWorld
/**
* Finalize the iworld
*/
finalizeIWorld :: !*IWorld -> *World
/**
* Determines the server executables path
*/
determineAppPath :: !*World -> (!FilePath, !*World)
/**
* Determine the name of the application based on the executable's name
*/
determineAppName :: !*World -> (!String,!*World)
/**
* Determine the location of the iTasks SDK
*/
determineSDKPath :: ![FilePath] !*World -> (!Maybe FilePath, !*World)
......@@ -9,16 +9,148 @@ import iTasks.Framework.IWorld, iTasks.Framework.WebService
CLEAN_HOME_VAR :== "CLEAN_HOME"
import StdFile, StdInt, StdList, StdChar, StdBool, StdString, StdFunc
import TCPIP, tcp, Internet.HTTP, System.Time, System.CommandLine, Data.Func
import iTasks.Framework.Engine, iTasks.Framework.IWorld, iTasks.Framework.TaskEval, iTasks.Framework.TaskStore
import iTasks.Framework.Util
import iTasks.Framework.TaskServer
startEngine :: a !*World -> *World | Publishable a
startEngine publishable world
# (opts,world) = getCommandLine world
# (app,world) = determineAppName world
# (mbSDKPath,world) = determineSDKPath SEARCH_PATHS world
// Show server name
# world = show (infoline app) world
//Check options
# port = fromMaybe DEFAULT_PORT (intOpt "-port" opts)
# keepalive = fromMaybe DEFAULT_KEEPALIVE_TIME (intOpt "-keepalive" opts)
# help = boolOpt "-help" opts
# sdkOpt = stringOpt "-sdk" opts
//If -help option is given show help and stop
| help = show instructions world
//Check sdkpath
# mbSDKPath = maybe mbSDKPath Just sdkOpt //Commandline SDK option overrides found paths
| isNothing mbSDKPath = show sdkpatherror world
//Normal execution
# world = show (running port) world
# iworld = initIWorld (fromJust mbSDKPath) world
// mark all instance as outdated initially
# (maxNo,iworld) = maxInstanceNo iworld
# iworld = addOutdatedInstances [(instanceNo, Nothing) \\ instanceNo <- [1..maxNo]] iworld
# iworld = startHTTPServer port keepalive (engine publishable) timeout background iworld
= finalizeIWorld iworld
where
infoline :: !String -> [String]
infoline app = ["*** " +++ app +++ " HTTP server ***",""]
instructions :: [String]
instructions =
["Available commandline options:"
," -help : Show this message and exit"
," -sdk <path> : Use <path> as location of the iTasks SDK"
," -port <port> : Set port number (default " +++ toString DEFAULT_PORT +++ ")"
," -keepalive <time> : Set connection keepalive time in seconds (default " +++ toString DEFAULT_KEEPALIVE_TIME +++ ")"
,""
]
sdkpatherror :: [String]
sdkpatherror =
["Oops! Could not find the iTasks SDK."
,"The server needs to know the location of the SDK to serve static content"
,"and run its various utility programs."
,""
,"Please put the \"iTasks-SDK\" folder in one of the search locations"
,"or use the -sdk commandline flag to set the path."
,"Example: -sdk C:\\Users\\johndoe\\Desktop\\Clean2.4\\iTasks-SDK"
,""
,"Tried to find a folder named \"iTasks-SDK\" in the following search locations:"
:SEARCH_PATHS]
running :: !Int -> [String]
running port = ["Running at http://localhost" +++ (if (port == 80) "/" (":" +++ toString port +++ "/"))]
show :: ![String] !*World -> *World
show lines world
# (console,world) = stdio world
# console = seqSt (\s c -> fwrites (s +++ "\n") c) lines console
# (_,world) = fclose console world
= world
boolOpt :: !String ![String] -> Bool
boolOpt key opts = isMember key opts
intOpt :: !String ![String] -> Maybe Int
intOpt key [] = Nothing
intOpt key [_] = Nothing
intOpt key [n,v:r]
| n == key && isInteger v = Just (toInt v)
= intOpt key [v:r]
where
isInteger v = and (map isDigit (fromString v))
stringOpt :: !String [String] -> Maybe String
stringOpt key [] = Nothing
stringOpt key [_] = Nothing
stringOpt key [n,v:r]
| n == key = Just v
= stringOpt key [v:r]
timeout :: !*IWorld -> (!Maybe Timeout,!*IWorld)
timeout iworld = (Just 100, iworld) //Run at least 10 times a second
background :: !*IWorld -> (!Bool,!*IWorld)
background iworld=:{IWorld|shutdown=True}
= (True,iworld)
background iworld
# iworld = updateCurrentDateTime iworld
# (mbWork, iworld) = dequeueWork iworld
# iworld = case mbWork of
Empty
= iworld
Work work
# iworld = case work of
(Evaluate instanceNo) = refreshTaskInstance instanceNo iworld
(EvaluateUrgent instanceNo) = refreshTaskInstance instanceNo iworld
(TriggerSDSChange sdsId) = addOutdatedOnShareChange sdsId (const True) iworld
(CheckSDS sdsId hash checkF)
# (checkRes,iworld) = checkF iworld
= case checkRes of
Changed = addOutdatedOnShareChange sdsId (const True) iworld
(CheckAgain time) = queueWork (CheckSDS sdsId hash checkF, Just time) iworld
= iworld // give http server the chance to handle request
WorkAt time
= iworld
/*
# (curTime, iworld) = currentTimestamp iworld
= (Just (toTimeout curTime time), iworld)
*/
= (False,iworld)
toTimeout (Timestamp curTime) (Timestamp nextRefresh)
# delta = nextRefresh - curTime
| delta < 0 = 0
| delta > MAX_TIMEOUT/1000 = MAX_TIMEOUT
| otherwise = delta*1000
MAX_TIMEOUT :== 86400000 // one day
// The iTasks engine consist of a set of HTTP request handlers
engine :: publish -> [(!String -> Bool,!HTTPRequest *IWorld -> (!HTTPResponse, !*IWorld))] | Publishable publish
engine :: publish -> [(!String -> Bool
,!Bool
,!(HTTPRequest *IWorld -> (!HTTPResponse,!Maybe SessionId, !*IWorld))
,!(HTTPRequest (Maybe {#Char}) !SessionId *IWorld -> (!Maybe {#Char}, !Bool, !SessionId, !*IWorld))
,!(HTTPRequest SessionId *IWorld -> *IWorld)
)] | Publishable publish
engine publishable
= taskHandlers (publishAll publishable) ++ defaultHandlers
where
taskHandlers published
= [((==) (URL_PREFIX +++ url), webService task defaultFormat) \\ {url,task=TaskWrapper task,defaultFormat} <- published]
= [let (reqF,dataF,disconnectF) = webService task defaultFormat in ((==) (URL_PREFIX +++ url),True,reqF,dataF,disconnectF)
\\ {url,task=TaskWrapper task,defaultFormat} <- published]
defaultHandlers
= [(startsWith URL_PREFIX, handleStaticResourceRequest)]
defaultHandlers = [simpleHTTPResponse (startsWith URL_PREFIX, handleStaticResourceRequest)]
initIWorld :: !FilePath !*World -> *IWorld
initIWorld sdkPath world
......@@ -56,8 +188,8 @@ initIWorld sdkPath world
,eventRoute = newMap
,readShares = []
,sessions = newMap
,uis = newMap
,workQueue = []
,uiUpdates = newMap
,shutdown = False
,world = world
}
......
definition module iTasks.Framework.EngineWrapperStandalone
/**
* This module wraps the iTasks engine in a simple
* standalone web server. This allows for easy testing and playing
* with the system
*/
import iTasks.Framework.Engine
/**
* Starts the task engine with a list of published task definitions.
*
* @param Tasks to start
* @param The world
* @return The world
*/
startEngine :: a !*World -> *World | Publishable a
implementation module iTasks.Framework.EngineWrapperStandalone
import StdFile, StdInt, StdList, StdChar, StdBool, StdString, StdFunc
import TCPIP, tcp, Internet.HTTP, System.Time, System.CommandLine, Data.Func
import iTasks.Framework.Engine, iTasks.Framework.IWorld, iTasks.Framework.TaskEval, iTasks.Framework.TaskStore
import iTasks.Framework.Util
import iTasks.Framework.TaskServer
//Wrapper instance for TCP channels with IWorld
instance ChannelEnv IWorld
where
channelEnvKind iworld=:{IWorld|world}
# (kind,world) = channelEnvKind world
= (kind,{IWorld|iworld & world = world})
mb_close_inet_receiver_without_id b (endpoint,cat) iworld=:{IWorld|world}
= {IWorld|iworld & world = mb_close_inet_receiver_without_id b (endpoint,cat) world}
channel_env_get_current_tick iworld=:{IWorld|world}
# (tick,world) = channel_env_get_current_tick world
= (tick,{IWorld|iworld & world = world})
startEngine :: a !*World -> *World | Publishable a
startEngine publishable world
# (opts,world) = getCommandLine world
# (app,world) = determineAppName world
# (mbSDKPath,world) = determineSDKPath SEARCH_PATHS world
// Show server name
# world = show (infoline app) world
//Check options
# port = fromMaybe DEFAULT_PORT (intOpt "-port" opts)
# keepalive = fromMaybe DEFAULT_KEEPALIVE_TIME (intOpt "-keepalive" opts)
# help = boolOpt "-help" opts
# sdkOpt = stringOpt "-sdk" opts
//If -help option is given show help and stop
| help = show instructions world
//Check sdkpath
# mbSDKPath = maybe mbSDKPath Just sdkOpt //Commandline SDK option overrides found paths
| isNothing mbSDKPath = show sdkpatherror world
//Normal execution
# world = show (running port) world
# iworld = initIWorld (fromJust mbSDKPath) world
// mark all instance as outdated initially
# (maxNo,iworld) = maxInstanceNo iworld
# iworld = addOutdatedInstances [(instanceNo, Nothing) \\ instanceNo <- [1..maxNo]] iworld
# iworld = startHTTPServer port keepalive (map simpleHTTPResponse (engine publishable)) timeout background iworld
= finalizeIWorld iworld
where
infoline :: !String -> [String]
infoline app = ["*** " +++ app +++ " HTTP server ***",""]
instructions :: [String]
instructions =
["Available commandline options:"
," -help : Show this message and exit"
," -sdk <path> : Use <path> as location of the iTasks SDK"
," -port <port> : Set port number (default " +++ toString DEFAULT_PORT +++ ")"
," -keepalive <time> : Set connection keepalive time in seconds (default " +++ toString DEFAULT_KEEPALIVE_TIME +++ ")"
,""
]
sdkpatherror :: [String]
sdkpatherror =
["Oops! Could not find the iTasks SDK."
,"The server needs to know the location of the SDK to serve static content"
,"and run its various utility programs."
,""
,"Please put the \"iTasks-SDK\" folder in one of the search locations"
,"or use the -sdk commandline flag to set the path."
,"Example: -sdk C:\\Users\\johndoe\\Desktop\\Clean2.4\\iTasks-SDK"
,""
,"Tried to find a folder named \"iTasks-SDK\" in the following search locations:"
:SEARCH_PATHS]
running :: !Int -> [String]
running port = ["Running at http://localhost" +++ (if (port == 80) "/" (":" +++ toString port +++ "/"))]
show :: ![String] !*World -> *World
show lines world
# (console,world) = stdio world
# console = seqSt (\s c -> fwrites (s +++ "\n") c) lines console
# (_,world) = fclose console world
= world
boolOpt :: !String ![String] -> Bool
boolOpt key opts = isMember key opts
intOpt :: !String ![String] -> Maybe Int
intOpt key [] = Nothing
intOpt key [_] = Nothing
intOpt key [n,v:r]
| n == key && isInteger v = Just (toInt v)
= intOpt key [v:r]
where
isInteger v = and (map isDigit (fromString v))
stringOpt :: !String [String] -> Maybe String
stringOpt key [] = Nothing
stringOpt key [_] = Nothing
stringOpt key [n,v:r]
| n == key = Just v
= stringOpt key [v:r]
timeout :: !*IWorld -> (!Maybe Timeout,!*IWorld)
timeout iworld = (Just 100, iworld) //Run at least 10 times a second
background :: !*IWorld -> (!Bool,!*IWorld)
background iworld=:{IWorld|shutdown=True}
= (True,iworld)
background iworld
# iworld = updateCurrentDateTime iworld
# (mbWork, iworld) = dequeueWork iworld
# iworld = case mbWork of
Empty
= iworld
Work work
# iworld = case work of
(Evaluate instanceNo) = refreshTaskInstance instanceNo iworld
(EvaluateUrgent instanceNo) = refreshTaskInstance instanceNo iworld
(TriggerSDSChange sdsId) = addOutdatedOnShareChange sdsId (const True) iworld
(CheckSDS sdsId hash checkF)
# (checkRes,iworld) = checkF iworld
= case checkRes of
Changed = addOutdatedOnShareChange sdsId (const True) iworld
(CheckAgain time) = queueWork (CheckSDS sdsId hash checkF, Just time) iworld
= iworld // give http server the chance to handle request
WorkAt time
= iworld
/*
# (curTime, iworld) = currentTimestamp iworld
= (Just (toTimeout curTime time), iworld)
*/
= (False,iworld)
toTimeout (Timestamp curTime) (Timestamp nextRefresh)
# delta = nextRefresh - curTime
| delta < 0 = 0
| delta > MAX_TIMEOUT/1000 = MAX_TIMEOUT
| otherwise = delta*1000
MAX_TIMEOUT :== 86400000 // one day
......@@ -7,6 +7,7 @@ from Data.Maybe import :: Maybe
from System.Time import :: Timestamp
from iTasks.API.Core.SystemTypes import :: DateTime, :: User, :: Config, :: InstanceNo, :: TaskNo, :: TaskId, :: TaskListItem, :: ParallelTaskType, :: TaskTime, :: SessionId
from iTasks.Framework.UIDefinition import :: UIDef, :: UIControl
from iTasks.Framework.UIDiff import :: UIUpdate
from iTasks.Framework.TaskState import :: TaskListEntry
from Text.JSON import :: JSONNode
from StdFile import class FileSystem
......@@ -31,8 +32,10 @@ from iTasks.Framework.TaskServer import class HttpServerEnv
, eventRoute :: !Map TaskId Int // Index of parallel branches the event is targeted at
, readShares :: ![String] // The IDs of shares from which was read
, sessions :: !Map SessionId InstanceNo // Index of sessions to instance numbers
, uis :: !Map SessionId (!Int,!UIDef) // Previous ui versions to optimize output sent to clients
, workQueue :: ![(!Work,!Maybe Timestamp)]
, uiUpdates :: !Map SessionId [UIUpdate] // Updates for the user interfaces of sessions
, shutdown :: !Bool // Flag that signals the server function to shut down
, world :: !*World // The outside world
}
......@@ -46,6 +49,9 @@ dequeueWorkFilter :: !(Work -> Bool) !*IWorld -> (![Work], !*IWorld)
getResponseExpiry :: !InstanceNo !*IWorld -> (!Maybe Int, !*IWorld)
addUIUpdates :: !SessionId ![UIUpdate] !*IWorld -> *IWorld
getUIUpdates :: !SessionId !*IWorld -> (![UIUpdate],!*IWorld)
:: DequeueResult = Empty | Work !Work | WorkAt !Timestamp
:: Work = Evaluate !InstanceNo
......
implementation module iTasks.Framework.IWorld
from System.FilePath import :: FilePath
from Data.Map import :: Map
from Data.Maybe import :: Maybe