eas-dev-commit

[Andrey C. <sku...@us...>]

Update of /cvsroot/eas-dev/eas/libeas
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv11504/libeas

Added Files:
	Makefile componentmanager.prg config.prg connection.prg 
	dbmanager.prg execmanager.prg functions.prg messagemanager.prg 
	protocol_raw.prg session.prg transportmanager.prg 
	uimanager.prg 
Log Message:
Add files

--- NEW FILE: Makefile ---
# This is a part of E/AS library
#
# Copyright (C) 2005 by E/AS Software Foundation
# Author: Andrey Cherepanov <sk...@ea...>
include $(CLIPROOT)/include/Makefile.inc

CLIPINCLUDE = -I$(CLIPROOT)/include
CLIP = $(CLIPROOT)/bin/clip

.SUFFIXES: .prg .o .po

# Here you can define appropriate compile settings
#C_FLAGS=-Wall -g -I. $(CLIPINCLUDE)
#CC=gcc
TARGET  = libeas$(DLLSUFF)
RTARGET = libeas$(DLLREALSUFF)

OBJS    = componentmanager.o config.o connection.o dbmanager.o execmanager.o \
	  messagemanager.o protocol_raw.o session.o transportmanager.o \
	  uimanager.o functions.o

.PHONY: all clean uninstall distclean

all: $(TARGET)

$(TARGET): $(OBJS)
	$(CLIPROOT)/bin/clip_makeslib $(TARGET) $(OBJS)

clean:
	rm -f $(OBJS) $(TARGET) *.bak *.nm *.ex *.ppo *.dll.a *.log *.dll *.so


install: all
	mkdir -p $(DESTDIR)$(CLIPROOT)/lib
	$(CLIPROOT)/bin/clip_cp $(TARGET) $(DESTDIR)$(CLIPROOT)/lib
	$(CLIPROOT)/bin/clip_cp $(RTARGET) $(DESTDIR)$(CLIPROOT)/lib
	/sbin/ldconfig -n $(DESTDIR)$(CLIPROOT)/lib

uninstall:
	rm -rf $(CLIPROOT)/lib/$(TARGET) $(CLIPROOT)/lib/$(RTARGET)

distclean: clean

dist: distclean

.prg.o: clip-ui.ch
	$(CLIP) $(CLIPINCLUDE) $<

commit:
	_cvs commit

update:
	_cvs update -dP

ucommit:
	_cvs update -dP && _cvs commit

shell:
	sh

--- NEW FILE: componentmanager.prg ---
/*-------------------------------------------------------------------------*/
/*   This is a part of library eas										   */
/*													                 	   */
/*   Copyright (C) 2005 by E/AS Software Foundation 					   */
/*   Author: Andrey Cherepanov <sk...@ea...>						   */
/*  								 									   */
/*   This program is free software; you can redistribute it and/or modify  */
/*   it under the terms of the GNU General Public License as               */
/*   published by the Free Software Foundation; either version 2 of the    */
/*   License, or (at your option) any later version.                       */
/*-------------------------------------------------------------------------*/

/** EASComponentManager - component manager */

#define OCMNG_REPOSITORY 		'ETC0101'
#define OCMNG_COMMANDS_CLASS 	'mng_command'
#define COMPONENT_SECTION		'COMPONENT_MANAGER'

function EASComponentManager( params )

	local obj := map()

	obj:className 	:= "EASComponentManager"
	obj:lastError	:= NIL
	obj:repository	:= ''
	obj:dbPath		:= ''
	
	_recover_EASCOMPONENTMANAGER(obj)

	setCommand(, 'sys.components', 'list', 		{|p| obj:list(p) } )
	setCommand(, 'sys.components', 'commands', 	{|p| obj:commands(p) } )
	setCommand(, 'sys.components', 'get', 		{|p| obj:get(p) } )

return obj

function _recover_EASCOMPONENTMANAGER(obj)
	obj:open		:= @c_open()
	obj:lookup		:= @c_lookup()
	obj:execute		:= @c_execute()
	obj:list		:= @c_list()
	obj:commands  	:= @c_commands()
	obj:get 	  	:= @c_get()
return obj

/** Open tables */
static function c_open( self, params ) // TODO
	local cfg
	
	eDebug(15, "Component manager (CM): open")
	// Check config file
	cfg := EASGetConfig()
	
	// Set default properties from config
	if COMPONENT_SECTION $ cfg:sections()
		self:repository := cfg:getValue(COMPONENT_SECTION, 'REPOSITORY')
		self:dbPath     := cfg:getValue(COMPONENT_SECTION, 'DBPATH')
	endif

return NIL

/** Lookup specified component name */
static function c_lookup( self, params )
	local q:=map(), component, method, a, i, cmds

	component := params:receiver
	method    := params:command

//	eDebug(5, "COMPONENT LOOKUP","DB" $ params:args, params:args)
	if .not. "ARGS" $ params .or. valtype(params:args)!="O"
		return NIL
	endif
		
	eDebug(15, "CM lookup:", component, method)
	
	// Query database
	q:db := OCMNG_REPOSITORY
	q:query := 'select id from '+OCMNG_COMMANDS_CLASS+' where component=="'+component+'" .and. name=="'+method+'";'
	cmds := sendMessage(,'sys.db', 'execute', q )
	eDebug(17, "DB returns:", cmds)

	// TODO: ACL check
	if len(cmds) > 0
		eDebug(10, "CM found", cmds[1][1])
		return cmds[1][1]
	else 
		self:lastError := "Method '"+method+"' of component '"+component+"' was not found"
		return NIL
	endif

return NIL

/** Execute component command found by ::lookup() */
static function c_execute( self, params )
	local oErr, component, method, id, q:=map(), obj
	local fName, f, fBlock, p, ret:=NIL, i, codeFile:=NIL
	
	component := params:receiver
	method    := params:command
	if .not. "ARGS" $ params .or. .not. "__ID" $ params
		return .F.
	endif
	id	  := params:__id 

		
	eDebug(15, "CM execute", "'"+component+'.'+method+"'",', DB ID:', id)
	
	oErr := ErrorBlock({|e| break(e) })
	
	begin sequence
		q:id := id
		q:db := OCMNG_REPOSITORY
		obj := sendMessage(,'sys.db', 'get', q )
		eDebug(25, "CM object:", obj)
		
		// Run method
		q:id := obj:form
		codeFile := sendMessage(,'sys.db', 'get', q )

		if empty(codeFile)
			eDebug(2, "CM: code file doesn't loaded to database")
			return .F.
		else
			// Put code to temporary file or use existing file
			fName := "."+PATH_DELIM+"cache"+PATH_DELIM+codeFile:id+".po"
			eDebug(15, "CM opens", fName)
		endif
		
		if .T. //.not. file(fName) // DEBUG: all occurences
			f := fcreate(fName, 0)
			fwrite(f, codeFile:content)
			fclose(f)
		endif
		
		// Use code
		fBlock := loadBlock(fName)
		if valType(fBlock) != "B"
			eDebug(2, "CM: Error load codeblock from:",fName)
			return NIL
		endif
		
		eDebug(15, "CM eval:", method)
		ret := eval(fBlock, method, params:args)
		eDebug(19, "CM returns:", ret)
		
	recover using oErr
		eDebug(1, "CM error:", errorMessage(oErr))
		return "Error execute: "+errorMessage(oErr)
	end sequence

		
return ret

/** Get component list */
static function c_list( self, params )
	local q:=map(), a
	eDebug(15, "CM list")
	
	// Query database
	q:db := OCMNG_REPOSITORY
	q:query := "select name from "+OCMNG_COMPONENT_CLASS+";"
	a := sendMessage(,'sys.db', 'execute', q )
	eDebug(17, "DB returns:", a)

return a

/** Get component commands list */
static function c_commands( self, params )
	local q:=map(), a, i, j, name, res:=array(0), cname
	eDebug(15, "CM commands")
	
	// Query database
	q:db := OCMNG_REPOSITORY
	q:query := "select name,component from "+OCMNG_COMMANDS_CLASS+";"
	a := sendMessage(,'sys.db', 'execute', q )
	eDebug(17, "DB returns:", a)

	for i in a
		name := i[1]
		q:id := i[2]
		q:db := OCMNG_REPOSITORY
		obj := sendMessage(,'sys.db', 'get', q )
		eDebug(25, "CM object:", obj)
		cname := iif( valtype(obj)=='O', cname:name, NIL )
		aadd( res, { name, cname } )
	next
	
return res

/** Get component object */
static function c_get( self, params )
	local q:=map(), component, a, obj:=NIL
	
	eDebug(15, "CM get")
	if 'ARGS' $ params .and. 'NAME' $ params:args
		component := params:args:name
	else
		return NIL
	endif
	
	// Query database
	q:db := OCMNG_REPOSITORY
	q:query := 'select id from '+OCMNG_COMPONENT_CLASS+' where name=="'+component+'";'
	a := sendMessage(,'sys.db', 'execute', q )
	eDebug(17, "DB returns:", a)

	if len(a) == 0
		self:lastError := "Component '"+component+"' was not found"
		return NIL
	endif

	q:id := a[1]
	q:db := OCMNG_REPOSITORY
	obj := sendMessage(,'sys.db', 'get', q )
	eDebug(25, "CM object:", obj)

return obj

--- NEW FILE: config.prg ---
/*-------------------------------------------------------------------------*/
/*   This is a part of library eas										   */
/*													                 	   */
/*   Copyright (C) 2005 by E/AS Software Foundation 					   */
/*   Author: Andrey Cherepanov <sk...@ea...>						   */
/*  								 									   */
/*   This program is free software; you can redistribute it and/or modify  */
/*   it under the terms of the GNU General Public License as               */
/*   published by the Free Software Foundation; either version 2 of the    */
/*   License, or (at your option) any later version.                       */
/*-------------------------------------------------------------------------*/

/** EASConfig - config manager */

#define DEFAULT_DEBUG_LEVEL	1
#define MAX_DEBUG_LEVEL		255
#define SPACER			'    '

static config
static debugLevel:=MAX_DEBUG_LEVEL

function EASGetConfig()
return config

function EASConfig( params, check_load, description )
	local obj, file:=NIL, i 
	local driver:=NIL, connection:=NIL, exec:=0, repo:=''
	local debug:=NIL
	
	// Scan parameters for help
	if ascan(params, "-h") > 0 .or. ascan(params, "--help") > 0
		config_help(description)
	endif

	// Extract from command line parameters config file (-c config)
	for i=1 to len(params)-1
		if params[i] == '-c'
			file := params[i+1]
		endif
		if params[i] == '-d'
			driver := params[i+1]
		endif
		if params[i] == '-o'
			connection := params[i+1]
		endif
		if params[i] == '-debug'
			debug := val(params[i+1])
			eSetDebugLevel( debug )
		endif
		if params[i] == '-repo'
			repo := params[i+1]
		endif
		if params[i] == '-e'
			exec := i+1
		endif
	next

	// Inherit from INIFILE class
	obj := iniFileNew( file )
	obj:file 	:= file

	// Attributes and methods
	obj:className 	:= "EASConfig"
	obj:driver		:= driver
	obj:connection	:= connection	
	obj:params		:= params
	obj:execute    	:= exec
	obj:repo		:= repo
	obj:debug		:= debug
	
	_recover_EASCONFIG(obj)

	// Open config file
	if .not. obj:load() .and. check_load == .T.
		eDebug( 1, 'Cannot open config file:', obj:error )
		return NIL
	endif

	// Set config as global
	config := obj
	
return obj

/* Virtual methods */
function _recover_EASCONFIG(obj)
return obj

/* Put params help on stdout */
static function config_help(description)
	if valtype(description) == 'C'
		?? description+chr(10)+chr(10)
	endif
	?? "Usage:&\n"
	?? "&\t-h, --help    This help&\n"
	?? "&\t-c <config>   Uses configuration from file <config>&\n"
	?? "&\t-d <driver>   Uses specified <driver> for user interface&\n"
	?? "&\t-debug <n>    Set debug output level (0-255: none-max)&\n"
	?? "&\t-o <connection> Establish specified connection&\n"
	?? "&\n"
	?? "Connection example: raw://user:password@localhost:3000/EAS01&\n"	
	?? "&\n"

	CANCEL
return

/* Put value to debug output */
function eDebug() // level, values...
	local pC, level, i, s:=''
	pC := pcount()
	
	// No parameters: do nothing
	if pC < 2
		return NIL
	endif
	
	level := param(1)
	if valtype(level) != 'N'
		level := DEFAULT_DEBUG_LEVEL
	endif
	
	if level <= debugLevel
		// Put on stdout
		for i:=2 to pC
			s := s + var2log( param(i) ) + ' '
		next
		s := left(s, len(s)-1)
		?? s + chr(10)
	endif
return NIL

/* Show variable in human readable format */
function var2log(var, level, decorate, base_level)
	local s:='', i, k, kn, sp, sp2, cr
	
	if valtype(level) == 'U'
		level := 1
	endif
	
	if valtype(base_level) == 'U'
		base_level := level
	endif
	
	if valtype(decorate) == 'U'
		decorate := .F.
	endif

	sp := iif(decorate,replicate(SPACER, base_level-level),'')
	sp2 := iif(decorate,replicate(SPACER, base_level-level+1),'')
	cr := iif(decorate,chr(10),'')

	switch valtype(var)
		case 'A'
			if level <= 0
				s := '<ARRAY>'
			else
				s := '{ ' + cr
				for i:=1 to len(var)
					s := s + sp2 + var2log(var[i], level-1, decorate, base_level) + iif(i==len(var),'',', ') + cr
				next
				s := s + sp + iif(decorate,'}', ' }')
			endif
		case 'B'
			s := '<CODE>'
		case 'C'
			if level != base_level
				s := "'"+var+"'"
			elseif var == ''
				s := "''"
			else
				s := var
			endif
		case 'D'
			s := dtoc(var)
		case 'L'
			s := iif(var, '.T.', '.F.')
		case 'M'
			if level != base_level
				s := "'"+var+"'"
			elseif var == ''
				s := "''"
			else
				s := var
			endif
		case 'N'
			s := alltrim(str(var))
		case 'O'
			if level <= 0
				s := '<OBJECT>'
			else
				s := '{ ' + cr
				k := array(0)
				aeval(mapkeys(var), {|e| aadd(k, { hashname(e), e }) })
				asort(k,,, {|x,y| x[1] < y[1] })
				for i:=1 to len(k)
					s := s + sp2 + k[i][1] + ':' + var2log(var[k[i][2]], level-1, decorate, base_level) + iif(i==len(k),'',', ') + cr
				next
				s := s + sp + iif(decorate,'}', ' }')
			endif
		case 'U'
			s := '<NIL>' 
		otherwise
			s := '<UNKNOWN:'+valtype(var)+'>'
	endswitch
return s

/* Set level for debug output */
function eSetDebugLevel( level )
	local old := debugLevel
	if valtype(level) == 'N'
		debugLevel := level
	endif
return old

--- NEW FILE: connection.prg ---
/*-------------------------------------------------------------------------*/
/*   This is a part of library eas										   */
/*													                 	   */
/*   Copyright (C) 2005 by E/AS Software Foundation 					   */
/*   Author: Andrey Cherepanov <sk...@ea...>						   */
/*  								 									   */
/*   This program is free software; you can redistribute it and/or modify  */
/*   it under the terms of the GNU General Public License as               */
/*   published by the Free Software Foundation; either version 2 of the    */
/*   License, or (at your option) any later version.                       */
/*-------------------------------------------------------------------------*/

/** EASConnection - connection manager */

/* TODO: thread support */

function EASConnection( params )
	local obj

	if valtype(params) != "O" .or. .not. "PROTOCOL" $ params
		return NIL
	endif

	// Get protocol class from named value 'protocol'
	switch lower(params:protocol)
		case "raw"	// Base raw protocol
	 		obj := EASRAWProtocol( params )
		otherwise
			eDebug(5, "WARNING: unknown protocol '"+params:protocol+"'")
			obj := NIL
	endswitch

	if "NAME" $ params .and. obj != NIL // Connection created
		setCommand(, 'sys.transport.'+params:name, 'open',  {|p| obj:open(p) } )
		setCommand(, 'sys.transport.'+params:name, 'close', {|p| obj:close(p) } )
	endif

return obj

--- NEW FILE: dbmanager.prg ---
/*-------------------------------------------------------------------------*/
/*   This is a part of library eas										   */
/*													                 	   */
/*   Copyright (C) 2005 by E/AS Software Foundation 					   */
/*   Author: Andrey Cherepanov <sk...@ea...>						   */
/*  								 									   */
/*   This program is free software; you can redistribute it and/or modify  */
/*   it under the terms of the GNU General Public License as               */
/*   published by the Free Software Foundation; either version 2 of the    */
/*   License, or (at your option) any later version.                       */
/*-------------------------------------------------------------------------*/

/** EASDatabaseManager - database manager */

function EASDatabaseManager( params )

	local obj := map()

	obj:databases	:= array(0)
	obj:className 	:= "EASDatabaseManager"
	obj:db			:= NIL	
	
	_recover_EASDATABASEMANAGER(obj)

return obj

function _recover_EASDATABASEMANAGER(obj)
	obj:open	:= @c_open()
	obj:close	:= @c_close()
	obj:execute	:= @c_execute()
	obj:executeExt	:= @c_executeExt()
	obj:get		:= @c_get()
	obj:put		:= @c_put()
	obj:getAttr := @c_getAttr()
return obj

/** Open databases */
static function c_open( self, params )
	local openDBs:=array(0), i

	// Connect to local database
	self:db := codb_connect()

	// Set database commands
	setCommand(, 'sys.db', 'execute',  {|p| self:execute(p) } )
	setCommand(, 'sys.db', 'executeExt',  {|p| self:executeExt(p) } )
	setCommand(, 'sys.db', 'get',      {|p| self:get(p) } )
	setCommand(, 'sys.db', 'put',  	   {|p| self:put(p) } )
	setCommand(, 'sys.db', 'getAttr',  {|p| self:getAttr(p) } )

	for i in self:db:dict_list
		aadd(openDBs, i[1])
	next
	
	eDebug(15, "Open databases:", openDBs)
	
return NIL

/** Close databases */
static function c_close( self, params )
	codb_close(self:db)
return NIL

/** Execute query */
static function c_execute( self, params )
return codb_get_result( self:executeExt(params) )

/** Execute query (return object instead array as in execute()) */
static function c_executeExt( self, params )
	local res
	if assertParameters( params, { 'query:C', 'db:C' } )
		return res
	endif

	//eDebug(15, "sys.db.executeExt.db", params:db )

	res := codb_execute( self:db, params:query, params:db )
	if codb_get_error( res ) != NIL
		eDebug(2, "sys.db.failed:", codb_get_error( res ))
		sendMessage(,,'sys.db.failed', res )
		return array(0)
	endif
return res

/** Get object from database */
static function c_get( self, params )
	local res
	if assertParameters( params, { 'id:C', 'db:C' } )
		return NIL
	endif
	res := codb_get_object( self:db, params:id, params:db )
	if codb_get_error( res ) != NIL
		eDebug(2, "sys.db.failed:", codb_get_error( res ))
		sendMessage(,,'sys.db.failed', res )
		return array(0)
	endif
return codb_get_result( res )

/** Put object to database */
static function c_put( self, params )
	local res
	if assertParameters( params, { 'obj:O', 'db:C', 'class:C' } )
		return NIL
	endif
	res := codb_put_object( self:db, params:obj, params:db, params:class )
	if codb_get_error( res ) != NIL
		eDebug(2, "sys.db.failed:", codb_get_error( res ))
		sendMessage(,,'sys.db.failed', res )
		return array(0)
	endif
return codb_get_result( res )

/** Get object attribute from database */
static function c_getAttr( self, params )
	local res, obj
	if assertParameters( params, { 'id:C', 'attr:C', 'db:C' } )
		return res
	endif
	res := codb_get_object( self:db, params:id, params:db)
	if codb_get_error( res ) != NIL
		eDebug(2, "sys.db.failed:", codb_get_error( res ))
		sendMessage(,,'sys.db.failed', res )
		return NIL
	endif
	obj := codb_get_result( res )
	if valtype(obj) != 'O' .or. .not. upper(params:attr) $ obj
		eDebug(2, "sys.db.failed:", codb_get_error( res ))
		sendMessage(,,'sys.db.failed', res )
		return NIL
	endif
return obj[upper(params:attr)]

--- NEW FILE: execmanager.prg ---
/*-------------------------------------------------------------------------*/
/*   This is a part of library eas										   */
/*													                 	   */
/*   Copyright (C) 2005 by E/AS Software Foundation 					   */
/*   Author: Andrey Cherepanov <sk...@ea...>						   */
/*  								 									   */
/*   This program is free software; you can redistribute it and/or modify  */
/*   it under the terms of the GNU General Public License as               */
/*   published by the Free Software Foundation; either version 2 of the    */
/*   License, or (at your option) any later version.                       */
/*-------------------------------------------------------------------------*/

/** EASExecuteManager - execute manager */

function EASExecuteManager( params )

	local obj := map()

	obj:commands	:= array(0)
	obj:events	:= array(0)
	obj:className 	:= "EASExecuteManager"
	obj:lastError	:= NIL
	obj:cManager	:= EASComponentManager( params )

	_recover_EASEXECUTEMANAGER(obj)

return obj

function _recover_EASEXECUTEMANAGER(obj)
	obj:open	:= @c_open()
	obj:close	:= @c_close()
	obj:execute	:= @c_execute()
	obj:getCommands := @c_getCommands()
	obj:connect	:= @c_connect()
	obj:disconnect 	:= @c_disconnect()
return obj

/** Open manager */
static function c_open( self, params )
	eDebug(15, "Execute layer: open")
	self:cManager:open( params )
	eDebug(15, "Execute layer: opened")
return NIL

/** Close manager */
static function c_close( self, params )	// TODO
	// params: ignored
return NIL

/** Execute command */
static function c_execute( self, params )
	// params: receiver:C, command:C, args:AO, sender:C
	local i, j, bCode, vRet, id
	
	self:lastError := NIL
	
	// Check params
	if assertParameters( params, { 'receiver:UC', 'command:C', 'args:UAO', 'sender:UC' } )
		return NIL
	endif

	// Lookup receiver name
	if valtype(params:receiver) == 'C'
		i := ascan( self:commands, {|e| e[1]==params:receiver } )
		if i > 0
			i := ascan( self:commands, {|e| e[1]==params:receiver .and. e[2]==params:command } )
			if i > 0
				// Execute command
				eDebug(15, "EXEC COMMAND '"+params:receiver+"."+params:command+"'...")
				bCode := self:commands[i][3]
				vRet := eval( bCode, params:args )
				eDebug(20, "EXEC '"+params:receiver+"."+params:command+"' returns:", vRet)
				return vRet
			else
				self:lastError := "ERROR: command '"+params:command+"' for '"+params:receiver+"' not found"
				eDebug(2, self:lastError)
				return NIL
			endif
		elseif .not. empty (id:=self:cManager:lookup( params ))
			eDebug(15, "EXEC COMPONENT COMMAND: ",params:receiver,params:command,"...")
			params:__id := id
			vRet := self:cManager:execute( params )
			eDebug(20, "EXEC COMPONENT '"+params:command+"' returns:", vRet)
			return vRet
		else
			self:lastError := iif(empty(self:cManager:lastError),"ERROR: component '"+params:receiver+"' not found",self:cManager:lastError)
			eDebug(2, "EXEC:", self:lastError)
			//eDebug(5, var2log(self:getCommands(),2,.T.))
			return NIL
		endif

	endif
	
	// Execute signal handler
	eDebug(15, "EXEC EVENT:", params:command)
	i := ascan( self:events, {|e| e[1]==params:command } )
	if i > 0
		slot_list := self:events[i][2]
		for j:=1 to len(slot_list)
			eDebug(15, "EVENT: ",params:command)
			bCode := slot_list[j]
			eval( bCode, params:args )
		next
	else
		eDebug(5, "WARNING: there are no handlers for event '"+params:command+"'")
	endif

return NIL

/** Get commands list */
static function c_getCommands( self, params )	// TODO
	local a:=array(0), i, cmp, ev
	
	// Clone component commands list
	for i:=1 to len(self:commands)
		cmp := self:commands[i][1]
		ev := ascan(a, {|e| e[1] == cmp })
		if ev > 0
			aadd( a[ev][2], self:commands[i][2] )
		else
			aadd(a, array(2))
			ev := len(a)
			a[ev][1] := cmp
			a[ev][2] := array(0)
			aadd( a[ev][2], self:commands[i][2] )
		endif
	next	
	
	// Append events
	aadd(a, array(2))
	ev := len(a)
	a[ev][1] := NIL
	a[ev][2] := array(0)
	
	for i:=1 to len(self:events)
		aadd( a[ev][2], self:events[i][1] )
	next
	
	// Sort array
	asort(a,,, {|x,y| valtype(x[1]) > valtype(y[1]) .and. x[1] < y[1] })
	for i:=1 to len(a)
		asort(a[i][2])
	next
	
return a

/** Connect code to signal */
static function c_connect( self, params )
	// params: event:C, action:B or component:C, command:C, action:B 
	local i
	
	if 'COMMAND' $ params
		if assertParameters( params, { 'component:C', 'command:C', 'action:B' } )
			return NIL
		endif
		
		// Single command
		i := ascan( self:events, {|e| e[1]==params:component .and. e[2]==params:command} )
		if i > 0
			self:commands[i][3] := params:action
		else
			aadd(self:commands, { params:component, params:command, params:action } )
		endif
	else
		if assertParameters( params, { 'event:C', 'action:B' } )
			return NIL
		endif
		
		// Slot for event
		i := ascan( self:events, {|e| e[1]==params:event } )
		if i > 0
			aadd(self:events[i][2], params:action)
		else
			aadd(self:events, { params:event, { params:action } })
		endif
	endif		
return NIL

/** Disconnect code from signal */
static function c_disconnect( self, params )
	// params: event:C
	local i	
		
	// Check params
	if assertParameters( params, { 'event:C' } )
		return NIL
	endif
	
	i := ascan( self:events, {|e| e[1]==params:event } )
	if i > 0
		adel(self:events, i)
		asize(self:events, len(self:events)-1 )	
	endif
		
return NIL

--- NEW FILE: functions.prg ---
/*-------------------------------------------------------------------------*/
/*   This is a part of library eas										   */
/*													                 	   */
/*   Copyright (C) 2005 by E/AS Software Foundation 					   */
/*   Author: Andrey Cherepanov <sk...@ea...>						   */
/*  								 									   */
/*   This program is free software; you can redistribute it and/or modify  */
/*   it under the terms of the GNU General Public License as               */
/*   published by the Free Software Foundation; either version 2 of the    */
/*   License, or (at your option) any later version.                       */
/*-------------------------------------------------------------------------*/

#define EASVERSION	'0.2.1a'
static l10nModule := NIL

/* Send message to remote component */
function component()
	local tm:=seconds(), msg, ret, args, pc:=pcount(), i, params:=NIL, p1, p2
	
	if pc == 1 .and. valtype(param(1)) == 'A'
		params := param[1]
		pc := len(params)
	endif

	if pc < 2
		eDebug(3, "Error in component(): must be 2 or more parameters")	
		return NIL
	elseif pc == 3
		args := iif(empty(params), param(3), params[3])
	elseif pc > 3
		args := map()
		for i:=3 to pc step 2
			args[upper(iif(empty(params), param(i), params[i] ))] := iif(i+1>pc,NIL,iif(empty(params), param(i+1), params[i+1]))
		next
	endif
		
	// Prepare message contents
	p1 := iif(empty(params), param(1), params[1] )
	p2 := iif(empty(params), param(2), params[2] )
	msg := messageNew( p1, p2, args, NIL )
	
	// Send message		
	sendMessage(,'sys.transport.default', 'write', msg )

	// Read answer from server
	ret := sendMessage(,'sys.transport.default', 'read')

	eDebug(15, "component '"+p1+"."+p2+"':", seconds()-tm)
return ret

/* Send message to local component */
function lcomponent()
	local ret, args, pc:=pcount(), i
	
	//eDebug(7, "lcomponent() call")	
	if pc < 2
		eDebug(3, "Error in component(): must be 2 or more parameters")	
		return NIL
	elseif pc == 3 .and. valtype() == 'O'
		//eDebug(7, "lcomponent() - pass map as argument")	
		args := param(3)
	elseif pc > 3
		args := map()
		//eDebug(7, "lcomponent() - pass",pc,"parameters")	
		for i:=3 to pc step 2
			args[upper(param(i))] := iif(i+1>pc,NIL,param(i+1))
		next
	endif
	//eDebug(5, "lcomponent():", args, iif("PARAMS" $ args, args:params, "") )	
	// Prepare message contents
	ret := sendMessage( , param(1), param(2), args, NIL )
return ret

/* Check required named parameters and their types */
function assertParameters( value, template )
	// template format: { { name, allowed_type }, ... }
	local i, l, e, name_r, name, types, sep
	
	// value must have map type, template - array
	if valtype(value) != 'O' .or. valtype(template) != 'A'
		return .T.
	endif
	
	l := len( template )
	for i:=1 to l
		e := template[i]
		if valtype(e) != 'C' // Checked value must be string
			return .T.
		endif
		sep := at(':', e)
		if sep == 0
			return .T.
		else
			name_r := left( e, sep-1 )
			name := upper(name_r)
			types := upper(substr(e, sep+1 ))
		endif
		if .not. name $ value // Check named parameter in value
			eDebug(5, "ASSERT: not parameter '"+name_r+"':",value)
			return .T.
		endif
		if .not. valtype(value[name]) $ types // Check allowed types of parameters
			eDebug(5, "ASSERT: bad type of '"+name_r+"': "+valtype(value[name])+", expected '"+types+"':",value[name])
			return .T.
		endif
	next
	
return .F.

/*===========================================================================*/
/* PREDEFINED COMPONENT CALL						     */
/*===========================================================================*/

/* Execute local database query */
function lquery(params, query)
return lcomponent('sys.db', 'execute', 'db', iif(valtype(params)=='O' .and. 'DB' $ params, params:db,''), 'query', query)

/* Opens form from server */
function openForm(name, type, id)
return lcomponent('sys.ui', 'openForm', 'name', name, 'type', type, "id", id)

/* Save data from form */
function saveForm(window, class)
return lcomponent('sys.ui', 'saveForm', 'window', window, 'class', class)

/* Save data from form and close if object is saved */
function saveFormAndClose(window, class)
return lcomponent('sys.ui', 'saveFormAndClose', 'window', window, 'class', class)

/* Delete object by id */
function deleteObject(id)
return component('sys.db', 'execute', 'query', 'delete '+id)

/* Set object attributes to form fields */
function setFormObject(window, obj)
return lcomponent('sys.ui', 'setFormObject', 'window', window, 'obj', obj)

/* Dialog box with confirmation of changed document close */
function dialogBoxConfirmClose(window, class)
return lcomponent('sys.ui', 'dialogBoxConfirmClose', 'window', window, 'class', class)

/* Opens view from server */
function openView(widget, name, timeout, window)
return lcomponent('sys.ui', 'openView', 'widget', widget, 'name', name, 'timeout', timeout, 'window', window)

/* Network transparent resource retrieving and caching */
function getResource(name)
	local oErr, real, content, f, l, lFile
	
	// Translate path
	real := strtran(name, "/", "_")        
	
	// Get file from server
	eDebug(15, "getResource(): retrieve", name)
	oErr := errorBlock({|e| break(e) })
	begin sequence
		lFile := file(real)
		lFile := .F. // TODO: not use cache
		if .not. lFile
			eDebug(15, "getResource(): load to file", real)
			content := component('form', 'get', 'name', name)
			if valtype(content) <> 'C' .or. len(content) == 0
				return NIL
			endif
			f := fcreate(real)
			if f < 0
				eDebug(2, "getResource(): Error open file for writing:", ferror(), ferrorstr())
				return NIL
			endif
			l := fwrite(f, content)
			eDebug(15, "getResource(): wrote", real, l, "bytes")
			fclose(f)
		else
			eDebug(15, "getResource():", real, "(cached)")
		endif
	recover using oErr
		eDebug(2, "RESOURCE: Internal error:",errorMessage(oErr))
		return o
	end sequence
	
return real

/* Open localization resources and setup module */
function l10nOpen(module, mo)
	l10nModule := module
	loadModuleMsg(module, mo)
return NIL

/* Return localized string */
function i18n(string)
return gettext( string, l10nModule )

/* Safe output function for debug */
function testout(w)
	local oErr
	oErr := errorBlock({|e| break(e) })
	begin sequence
		eDebug(5, "TESTOUT():", w:getSelectionId())
	recover using oErr
		eDebug(2, "TESTOUT(): Internal error:",errorMessage(oErr))
	end sequence
return NIL

/* Get E/AS version */
function EASGetVersion()
return EASVERSION

/* Get array { dep, class_name } from "dep:class_name" */
function form_splitClass( s )
	local i, dep, class
	i := at( ':', s )
	if i==0
		return { '', s }
	endif
	dep := left( s, i-1 )
	class := substr( s, i+1 )
return { dep, class }

--- NEW FILE: messagemanager.prg ---
/*-------------------------------------------------------------------------*/
/*   This is a part of library eas										   */
/*													                 	   */
/*   Copyright (C) 2005 by E/AS Software Foundation 					   */
/*   Author: Andrey Cherepanov <sk...@ea...>						   */
/*  								 									   */
/*   This program is free software; you can redistribute it and/or modify  */
/*   it under the terms of the GNU General Public License as               */
/*   published by the Free Software Foundation; either version 2 of the    */
/*   License, or (at your option) any later version.                       */
/*-------------------------------------------------------------------------*/

#define EAS_SERVER	0
#define EAS_CLIENT	1

/** EASMessageManager - message manager */
static global_msg

/** TODO: 
	- isolated MM interaction by gate mechanism
*/

function EASMessageManager( params )

	local obj:=map(), tparams:=map()

	obj:className 	:= "EASMessageManager"
	obj:type 	:= iif( valtype(params)=='C' .and. lower(params)=='server', ;
		EAS_SERVER, EAS_CLIENT )
	
	_recover_EASMESSAGEMANAGER(obj)

	global_msg := obj
	
	// Init other objects
	if obj:type == EAS_SERVER // Server
		tparams:role := EAS_SERVER
		obj:db := EASDatabaseManager()
		obj:exec := EASExecuteManager()
		obj:transport := EASTransportManager(tparams)
	else	// Client
		tparams:role := EAS_CLIENT
		obj:db := EASDatabaseManager()
		obj:ui := EASUIManager()
		obj:exec := EASExecuteManager()
		obj:transport := EASTransportManager(tparams)
	endif

	setCommand(, 'sys.manager', 'commands',  {|p| obj:exec:getCommands(p) } )
		
return obj

function _recover_EASMESSAGEMANAGER(obj)
	obj:open	:= @c_open()
	obj:close	:= @c_close()
	obj:process	:= @c_process()
return obj

/** Open manager */
static function c_open( self, params )
	// params: ignored
	eDebug(10, "MM: Activate layers...")
	if self:type == EAS_SERVER // Server
		eDebug(10, "RUN SERVER...")
		eDebug(15, "Database layer...")
		self:db:open(params)
		eDebug(15, "Execute layer...")
		self:exec:open(params)
		eDebug(15, "Transport layer...")
		self:transport:open(params)
	else	// Client
		eDebug(10, "RUN CLIENT...")
//		eDebug(15, "Database layer...")
// 		self:db:open(params)
		eDebug(15, "Execute layer...")
		self:exec:open(params)
		eDebug(15, "UI layer...")
		self:ui:open(params)
		eDebug(15, "Transport layer...")
		self:transport:open(params)
	endif
	eDebug(10, "MM: Layers are activated.")

return NIL

/** Close manager */
static function c_close( self, params )
	// params: ignored
	eDebug(10, "MM: Close layers...")
	if self:type == EAS_SERVER // Server
		self:transport:close(params)
		self:exec:close(params)
		self:db:close(params)
	else	// Client
		self:transport:close(params)
		self:exec:close(params)
		self:ui:close(params)
		self:db:close(params)
	endif
	eDebug(10, "MM: Layers are closed.")
return NIL

/** Process message from sender */
static function c_process( self, params )
	// params: receiver:C, command:C, args:AO, sender:C
	local ret, msg:= map()
	
	if assertParameters( params, { 'receiver:UC', 'command:C', 'args:UAO', 'sender:UC' } )
		return NIL
	endif
	
	if valtype(self:exec) == 'O'
		
		// Run command on execute layer
		ret := self:exec:execute( params ) 
		eDebug(25, "MM:process() on execute returns:", ret)
		
		if ret == NIL .and. self:exec:lastError != NIL
			ret := map()
			ret:error := self:exec:lastError
		endif
		
		// If it isn't event (defined receiver): return result
		if valtype(params:receiver) != 'U'
			// Send answer to sender 
			if valtype(params:sender) != 'U'
				msg:receiver := params:sender
				msg:command  := NIL
				msg:args     := ret
				eDebug(15, "MM:process(): pass result to sender")
				self:process( msg )
			else // Sender undefined: straight return
				return ret
			endif
		else
			return NIL
		endif
	endif
return NIL

/*-------------------------------------------------------------------------*/
/* Global functions 							   */
/*-------------------------------------------------------------------------*/

/** Set slot for event */
function setSlot( msg_m, event, action )
	local params:=map()
	msg_m := iif(valtype(msg_m) != 'O', global_msg, msg_m)
	
	if valtype(msg_m) == 'O' .and. valtype(msg_m:exec) == 'O' 
		params:event  := event
		params:action := action
		return msg_m:exec:connect( params )
	endif
return NIL

/** Set command for specified component */
function setCommand( msg_m, component, command, action )
	local params:=map()
	msg_m := iif(valtype(msg_m) != 'O', global_msg, msg_m)
	
	eDebug(11, "setCommand():", component, command)
	if valtype(msg_m) == 'O' .and. valtype(msg_m:exec) == 'O' 
		params:component := component
		params:command  := command
		params:action := action
		return msg_m:exec:connect( params )
	endif
return NIL

/** Send message */
function sendMessage( msg_m, receiver, command, args, sender )
	local params:=map(), ret
	msg_m := iif(valtype(msg_m) != 'O', global_msg, msg_m)
	params:receiver := receiver
	params:command 	:= command
	params:args 	:= args
	params:sender 	:= sender
	eDebug(10, "MM: sendMessage():", params )
	if "ARGS" $ params
		eDebug(17, "MM: parameters:", params:args )
	endif
	ret :=  msg_m:process( params )
	eDebug(25, "MM: sendMessage() returns:", ret)
return ret

/** Create empty message */
function messageNew( receiver, command, args, sender )
	local msg:=map(), obj:=map()
	
	msg:receiver 	:= receiver
	msg:command 	:= command
	msg:args 	:= args
	msg:sender 	:= sender
	
	obj:data := msg
	
return obj

--- NEW FILE: protocol_raw.prg ---
/*-------------------------------------------------------------------------*/
/*   This is a part of library eas										   */
/*													                 	   */
/*   Copyright (C) 2005 by E/AS Software Foundation 					   */
/*   Author: Andrey Cherepanov <sk...@ea...>						   */
/*  								 									   */
/*   This program is free software; you can redistribute it and/or modify  */
/*   it under the terms of the GNU General Public License as               */
/*   published by the Free Software Foundation; either version 2 of the    */
/*   License, or (at your option) any later version.                       */
/*-------------------------------------------------------------------------*/

#include <tcp.ch>

#define TCP_READ_TIMEOUT	6000
#define TCP_WRITE_TIMEOUT	600


/** EASRAWProtocol - base raw procotol for connection */

function EASRAWProtocol( params )

	local obj := map()

	obj:type	:= "raw"
	obj:socket	:= map()
	obj:socket:handle := NIL
	obj:sessions	:= array(0)
	obj:className 	:= "EASRAWProtocol"
	obj:params	:= params
	obj:errno	:= 0

	_recover_EASRAWPROTOCOL(obj)

return obj

function _recover_EASRAWPROTOCOL(obj)
	obj:open	:= @c_open()
	obj:close	:= @c_close()
	obj:closeSession := @c_closeSession()
	obj:read	:= @c_read()
	obj:write	:= @c_write()
	obj:serialize	:= @c_serialize()
	obj:deserialize	:= @c_deserialize()
return obj

/** Open connection */
static function c_open( self, params )
	// params: name:C, transport:C, port:C, role:C
	local args:=map(), session, threadId
	
	if empty(params) // Get parameters given in class constuctor
		params := self:params
	else
		self:params := params
	endif
	
	// Check params
	if assertParameters( params, { 'name:C', 'transport:C', 'port:N', 'role:C' } )
		return NIL
	endif
	
	// Set socket parameters
	self:socket := map()
	self:socket:name := params:name
	self:socket:port := params:port
	self:socket:type := params:transport
	self:socket:role := lower(params:role)

	eDebug(15, "Open RAW connection:", params)
	
	if 'LISTENTIMEOUT' $ params
		self:socket:lTimeout := params:listenTimeout
	else
		self:socket:lTimeout := TCP_LISTEN_TIMEOUT
	endif
	if 'ACCEPTTIMEOUT' $ params
		self:socket:aTimeout := params:acceptTimeout
	else
		self:socket:aTimeout := TCP_ACCEPT_TIMEOUT
	endif
	if 'READBLOCK' $ params .and. params:readBlock > 0
		self:socket:readBlock := params:readBlock
	else
		self:socket:readBlock := TCP_BUFLEN
	endif
	if 'READTIMEOUT' $ params
		self:socket:rTimeout := params:readTimeout
	else
		self:socket:rTimeout := TCP_READ_TIMEOUT
	endif
	if 'WRITETIMEOUT' $ params
		self:socket:wTimeout := params:writeTimeout
	else
		self:socket:wTimeout := TCP_WRITE_TIMEOUT
	endif

	// Open connection
	if self:socket:role == 'server' // Server mode: accept clients connections
		// Bind to port
		eDebug(10, "NETWORK: Bind to port...")
		if (self:socket:handle := tcpListen( self:socket:port, self:socket:lTimeOut )) == -1
			self:error := self:socket:name+": error listen on port "+toString(self:socket:port)+": "+ferrorStr()
			args:error := self:error
			sendMessage(,,"sys.transport.failed",args)
			eDebug(2, self:error)
			return .F.
		endif
		eDebug(10, "NETWORK: Accept connections...")
	/*===================================================================*/
	/* Main server loop						     */
	/*===================================================================*/
		do while( .T. )
			if (session := tcpAccept( self:socket:handle, self:socket:aTimeOut )) != -1
				// Create new session
				eDebug(10, "Start session: ", session)
				oSession := EASSession( self, session )
				//session_open(oSession) 
				threadId := start(@session_open(), oSession) // Begin new thread
				eDebug(15, "Stop session")
			endif
			sleep(0.01)
		enddo
	/*====================================================================*/
	else // Client mode: connect to server
		if .not. 'HOST' $  params
			return .F.
		else
			self:socket:host := params:host
		endif
		if( (self:socket:handle := tcpConnect( self:socket:host, self:socket:port, self:socket:lTimeout )) == -1 )
			eDebug(1, "NETWORK: Failed to open client connection:", ferrorStr())
			self:error := self:socket:name+": error connect: "+ferrorStr()
			args:error := self:error
			sendMessage(,,"sys.transport.failed",args)
			return .F.
		else
			eDebug(10, "NETWORK: Open client connection:", self:socket:handle)
			setCommand(, 'sys.transport.'+params:name, 'read',  {|p| self:deserialize(self:read(p)) } )
			setCommand(, 'sys.transport.'+params:name, 'write', {|p| self:write(self:serialize(p)) } )
			setCommand(, 'sys.transport.default', 'read',  {|p| self:deserialize(self:read(p)) } )
			setCommand(, 'sys.transport.default', 'write', {|p| self:write(self:serialize(p)) } )
		endif
	endif
		
return .T.

/* Thread function for session open */
static function session_open(session)
	set deleted on
	set translate path off
return session:open()

/** Close connection */
static function c_close( self, params )
	if self:socket:handle != NIL
		tcpClose( self:socket:handle )
	endif
return NIL

/** Close session */
static function c_closeSession( self, params )
	
	if assertParameters( params, { 'handle:N' } )
		return NIL
	endif
	
	tcpClose( params:handle )

return NIL

/** Serialize packet */
static function c_serialize( self, params )
	// params: data:O
	local oRet := map()
	
/*	if assertParameters( params, { 'data:AO' } )
		return NIL
	endif
*/	
	oRet:data := var2str( params:data )
	oRet:size := len(oRet:data)
	eDebug(20, "NETWORK: serialize:", oRet)
return oRet

/** Deserialize packet */
static function c_deserialize( self, params )
	// params: data:O
	local oRet := NIL, sec:=seconds()
	
	if assertParameters( params, { 'data:C', 'size:N' }  )
		return NIL
	endif
	
	oRet := str2var(params:data)

	eDebug(20, "NETWORK: deserialize:", oRet)
	eDebug(10, "NETWORK: deserialize:", seconds()-sec, "sec")
return oRet

/** Read data */
static function c_read( self, params )
	// params: session:N
	local oData:=map(), cBuf, nSize, nRead, err:=map()
	local cBuffer:='', nTotal:=0
	local oErr, sec:=seconds()
	self:socket:rTimeout := 6000
	
	self:errno := 0
	
	if self:socket:role != 'server'
		if valtype(params) != 'O'
			params := map()
		endif
		params:session := self:socket:handle
	endif
	
	eDebug(20, "NETWORK: Read from socket...")
	
	// Check params
	if assertParameters( params, { 'session:N' } )
		return NIL
	endif
	nSize := self:socket:readBlock
	nSize := 6000
	//eDebug(20, "NETWORK: buffer length:", nSize)

	cBuf := space(nSize)
	
	oErr := ErrorBlock({|e| break(e) })
	begin sequence
		nRead := tcpRead( params:session, @cBuf, nSize, self:socket:rTimeout )
		self:errno := ferror()
	    if nRead == -1
			// Empty socket
			return NIL
	    else
			eDebug(20, "NETWORK: Read to buffer:", params:session, nRead, left(cBuf, nRead))
			cBuffer := left(cBuf, nRead)
			nTotal  := nRead
			if nRead == nSize
				//do while (nRead := tcpRead( params:session, @cBuf, nSize, self:socket:rTimeout )) != -1
				do while (nRead := tcpRead( params:session, @cBuf, nSize, 10 )) != -1
					cBuffer += left(cBuf, nRead)
					nTotal  += nRead
				enddo
			endif
 	    endif
	recover using oErr
		eDebug(2, "NETWORK: read error")
		cBuffer := ''
		nTotal  := 0 
	end sequence
	
	oData:data := cBuffer
	oData:size := nTotal
	eDebug(10, "NETWORK: Read", oData:size, "bytes,", seconds()-sec, "sec")
	
return oData

/** Write data*/
static function c_write( self, params )
	// params: session:N, data:O
	local nSended, err:=map()
	local oErr
		
	if self:socket:role != 'server' .and. valtype(params) == 'O'
		params:session := self:socket:handle
	endif
	
	// Check params
	if assertParameters( params, { 'session:N', 'data:C', 'size:N' }  )
		return .F.
	endif
	
	eDebug(10, "NETWORK: Write to socket...")
	oErr := ErrorBlock({|e| break(e) })
	begin sequence
	
		nSended := tcpWrite( params:session, params:data, params:size, self:socket:wTimeout )
		if nSended != params:size // Error send data
			err:error := "Cannot write data to socket: length="+toString(params:size)+', wrote='+toString(nSended)
			params:session:SendMessage("error.write",err)
			return .F.
		endif
	recover using oErr
		err:error := "write error"
		params:session:SendMessage("error.write",err)
		return .F.
	end sequence
	
	eDebug(10, "NETWORK: Wrote",nSended,"bytes")
return .T.

--- NEW FILE: session.prg ---
/*-------------------------------------------------------------------------*/
/*   This is a part of library eas										   */
/*													                 	   */
/*   Copyright (C) 2005 by E/AS Software Foundation 					   */
/*   Author: Andrey Cherepanov <sk...@ea...>						   */
/*  								 									   */
/*   This program is free software; you can redistribute it and/or modify  */
/*   it under the terms of the GNU General Public License as               */
/*   published by the Free Software Foundation; either version 2 of the    */
/*   License, or (at your option) any later version.                       */
/*-------------------------------------------------------------------------*/

/** EASSession - session manager */

function EASSession( connection, handle )

	local obj := map()

	obj:name		:= "session_"+ltrim(str(handle))
	obj:connection	:= connection
	obj:handle		:= handle
	obj:messages	:= NIL	// TODO: Message manager per session. Only for server
	obj:attributes	:= array(0)
	obj:access		:= .F.
	obj:className 	:= "EASSession"

	_recover_EASSESSION(obj)

	setCommand(, 'sys.transport.'+obj:name, 'login', {|p| obj:login(p) } )
	setCommand(, 'sys.transport.default',   'login', {|p| obj:login(p) } )
	setCommand(, 'sys.transport.'+obj:name, 'close', {|p| obj:close(p) } )
	setCommand(, 'sys.transport.default',   'close', {|p| obj:close(p) } )
	
return obj

function _recover_EASSESSION(obj)
	obj:open	:= @c_open()
	obj:login	:= @c_login()
	obj:close	:= @c_close()
	obj:read	:= @c_read()
	obj:write	:= @c_write()
	obj:sendMessage	:= @c_sendMessage()
return obj

/** Open session */
static function c_open( self, params )
	local cRead
	/*===================================================================*/
	/* Main session loop						     */
	/*===================================================================*/
	do while( .T. )
		if self:read() > 1
			exit
		endif
		
		sleep(0.01)
	enddo
	/*===================================================================*/
	self:close()
return NIL

/** Authenticate login */
static function c_login( self, params )
	local oWrite := map()
	
	eDebug( 5, "LOGIN:", params)
	
	self:access := .F.
	// Authenticate user
	if empty( lcomponent('auth', 'authenticate', 'params', params ) )
		self:access := .T.
	endif
	eDebug(10, "Access: ",self:access )
	oWrite:answer := self:access

	eDebug(16, "Answer:", oWrite:answer)
return oWrite

/** Close session */
static function c_close( self, params )
	self:connection:closeSession( self )
	eDebug(15, "Session closing.")
return NIL

/** Read data */
static function c_read( self, params )
	local oRaw, obj, oWrite:=map(), oMsg, oRet, attr
	if valtype( params ) != 'O'
		params := map()
	endif
	params:session := self:handle
	oRaw := self:connection:read( params )
	if self:connection:errno == 32 // Client connection was broken
		eDebug(13, "Connection was broken from client" )
		return 2
	endif
	if empty(oRaw)
		return 0
	endif
	eDebug( 20, "Session read:", oRaw)
	// Deserialize answer
	obj := self:connection:deserialize( oRaw )
	if .not. empty(obj) .and. .not. assertParameters( obj, { 'receiver:UC', 'command:C', 'args:UAO', 'sender:UC' } )

		// Send message to message manager
		
		// TODO: use isolated message managers per session
		oMsg := NIL // Use global message manager
		
		eDebug(10, "ARGS:", obj:args)
				
		// Check for session.close
		if lower(obj:receiver) == 'session' .and. lower(obj:command) == 'close'
			return 2 // Close session
		endif
		
		// Process query
		oRet := sendMessage( oMsg, obj:receiver, obj:command, obj:args, obj:sender )
		
		// Write answer to socket
		oWrite:data := oRet
		self:write( oWrite )

		// If access denied then close connection
		//eDebug(2, "ACCESS:",self:access)
		if .not. self:access
			return 2 // Close session
		endif
			
	else
		eDebug(1, "Session: Invalid object received.")
	endif
return 1

/** Write data */
static function c_write( self, params )
	// params: data:O
	local oData, oError

	eDebug( 20, "Session write")
	if params == NIL
		params := map()
		params:data := NIL
	endif
	
	if .not. valtype( params ) $ 'AO' .or. ( (oData := self:connection:serialize( params )) == NIL )
		eDebug( 1, "ERROR preparing data for write. Sending message with data.")
		oError := map()
		oError:data := params
		oData := self:connection:serialize( oError )
		oData:session := self:handle
		return self:connection:write( oData )
	endif
	oData:session := self:handle
	
return self:connection:write( oData )

/** Write data */
static function c_sendMessage( self, receiver, command, args, sender )
	local ret
	if valtype(self:messages) == 'O'
		ret := sendMessage(self:messages, receiver, command, args, sender )
	else
		eDebug( 1, "Session error:",command,args )
	endif
return 
--- NEW FILE: transportmanager.prg ---
/*-------------------------------------------------------------------------*/
/*   This is a part of library eas										   */
/*													                 	   */
/*   Copyright (C) 2005 by E/AS Software Foundation 					   */
/*   Author: Andrey Cherepanov <sk...@ea...>						   */
/*  								 									   */
/*   This program is free software; you can redistribute it and/or modify  */
/*   it under the terms of the GNU General Public License as               */
/*   published by the Free Software Foundation; either version 2 of the    */
/*   License, or (at your option) any later version.                       */
/*-------------------------------------------------------------------------*/

/** EASTransportManager - Transport manager */
static oCurConn

function EASTransportManager( params )

	local obj := map(), i, cfg, sections, pkeys, pset, j, c, cstr, a

	obj:connections := array(0)
	obj:connectionNames := array(0)
	obj:active	:= .F.
	obj:role	:= iif(valtype(params)=='O' .and. 'ROLE' $ params, params:role, 1)
	obj:className 	:= "EASTransportManager"

	_recover_EASTRANSPORTMANAGER(obj)
	
	setCommand(, 'sys.transport', 'open',  {|p| obj:open(p) } )
	setCommand(, 'sys.transport', 'close', {|p| obj:close(p) } )
	setCommand(, 'sys.transport', 'addConnection', {|p| obj:addConnection(p) } )

	// Read from config file
	cfg := EASGetConfig()
	if valtype(cfg) != 'O' .or. cfg:className != "EASConfig"
		return NIL
	endif
	eDebug(10, "TRANSPORT: Connection from command line:",cfg:connection)
	if cfg:connection != NIL
		// Connection in command line
		eDebug(10, "TRANSPORT: Create connection from string:",cfg:connection)
		// Fill connection parameters
		// Parse string: protocol://user:password@host:port/db
		cstr := alltrim(cfg:connection)
		pset := map()
		pset:name 	:= 'CONNECTION_1'
		pset:transport 	:= 'TCP'
		pset:role 	:= 'client'

		j := at('://', cstr)
		if j > 1
			pset:protocol 	:= upper(left(cstr,j-1))
		else
			pset:protocol 	:= 'RAW' // default protocol
		endif
		cstr := substr(cstr,j+3)

		a := split(cstr,"[@:/]")
		asize(a, 5)
		pset:user 	:= iif(empty(a[1]),'anonymous',a[1])
		pset:password 	:= a[2]
		pset:host 	:= iif(empty(a[3]),'localhost',a[3])
		pset:port 	:= iif(empty(a[4]),3000,val(a[4]))
		
		cfg:connection := pset
		
		// Create connection object
		c := EASConnection( pset )
		if c != NIL
			eDebug(10, "TRANSPORT: Connection from string is created")
			aadd(obj:connectionNames, pset:name)
			aadd(obj:connections, c)
		else
			eDebug(1, "TRANSPORT: Failed to create connection from command line")
		endif
	endif
	
	// Load sections from config file and create EASConnection objects
	sections := cfg:sections()
	for i in sections
		if ascan(cfg:keys(i), "PROTOCOL") > 0
			pset := map()
			pset:name := i
			pkeys := cfg:keys(i)
			for j in pkeys
				pset[j] := cfg:getValue(i, j)
			next
			c := EASConnection( pset )
			if c != NIL
				aadd(obj:connectionNames, i)
				aadd(obj:connections, c)
			endif
		endif
	next
	
return obj

function _recover_EASTRANSPORTMANAGER(obj)
	obj:open	  		:= @c_open()
	obj:addConnection 	:= @c_addConnection()
	obj:close	  		:= @c_close()
return obj

/** Open manager */
static function c_open( self, params )
	// params: ignored
	local oErr, c, threadId
	
	oErr := errorBlock({|e| break(e) })
	begin sequence
	
		// No connections: send event 'sys.transport.failed'
		if len( self:connections ) == 0
			eDebug(1, "TRANSPORT: no connections")
			sendMessage(,,'sys.transport.failed')
			return NIL
		endif
		
		if self:role == 0 // Server
			// Open each connection
			for c in self:connections
				oCurConn := c
				threadId := start( @connection_open() ) // Begin thread for each connection
			next
	
			// Infinity loop for child thread
			do while( .T. )
				sleep(0.01)
			enddo
		else
			// Open each connection
			for c in self:connections
				oCurConn := c
				connection_open() 
			next
		
		endif
		
	recover using oErr
		eDebug(1, "Open connection error:",errorMessage(oErr))
		return o
	end sequence
	
return .F.

// Thread function for connection open
static function connection_open()
	local oErr, ret, connection
	
	set deleted on
	set translate path off
	
	oErr := errorBlock({|e| break(e) })
	begin sequence
		eDebug(10, "Begin thread in connection_open()")
		connection := oCurConn
		ret := connection:open()
	recover using oErr
		eDebug(1, "Open connection:",errorMessage(oErr))
		return o
	end sequence
return ret


/** Add connection */
static function c_addConnection( self, params )
	// params: name:C, transport:C, port:N, role:C
	local c
	
	// Check params
	if assertParameters( params, { 'name:C', 'transport:C', 'port:N', 'role:C' } )
		return NIL
	endif
	
	c := EASConnection( params )
	if c != NIL
		aadd(self:connectionNames, params:name)
		aadd(self:connections, c)
	endif
return c
			
/** Close manager: stop all connections */
static function c_close( self, params )
	// params: ignored
	local c
	
	// Close each connection
	for c in self:connections
		c:close()
	next
	
return NIL


--- NEW FILE: uimanager.prg ---
/*-------------------------------------------------------------------------*/
/*   This is a part of library eas										   */
/*													                 	   */
/*   Copyright (C) 2005 by E/AS Software Foundation 					   */
/*   Author: Andrey Cherepanov <sk...@ea...>						   */
/*  								 									   */
/*   This program is free software; you can redistribute it and/or modify  */
/*   it under the terms of the GNU General Public License as               */
/*   published by the Free Software Foundation; either version 2 of the    */
/*   License, or (at your option) any later version.                       */
/*-------------------------------------------------------------------------*/

#include <clip-ui.ch>

#define SHOW_FORMS	.T.

/** EASUIManager - UI (User Interface) manager */

/** TODO:
	- using and clean cache for form and orginary files
*/

function EASUIManager( params )

	local obj := map()

	obj:forms	:= array(0)
	obj:className 	:= "EASUIManager"
	obj:main	:= NIL
	
	_recover_EASUIMANAGER(obj)
	
	// Init workspace
	c_init(obj, params)
	
	
return obj

function _recover_EASUIMANAGER(obj)
	obj:open	:= @c_open()
	obj:run		:= @c_run()
	obj:close	:= @c_close()
	obj:openForm	:= @c_openForm()
	obj:closeForm   := @c_closeForm()
	obj:saveForm    := @c_saveForm()
	obj:saveFormAndClose := @c_saveFormAndClose()
	obj:openView    := @c_openView()
	
	obj:setFormObject := @c_setFormObject()
	obj:dialogBoxConfirmClose := @c_dialogBoxConfirmClose()
return obj

/** Init UI manager */
static function c_init( self, params )
	
	// Check config file
	cfg := EASGetConfig()
	if valtype(cfg) == 'O' .and. cfg:className == "EASConfig" .and. .not. empty(cfg:driver)
		eDebug(10, "UI: Used driver:", cfg:driver)
		useDriver( cfg:driver )
	endif

	self:ws  := UIWorkSpace() // TODO: params

return NIL

/** Open manager */
static function c_open( self,  params )	// TODO
	setCommand(, 'sys.ui', 'openForm', {|p| self:openForm(p) } )
	setCommand(, 'sys.ui', 'saveForm', {|p| self:saveForm(p) } )
	setCommand(, 'sys.ui', 'saveFormAndClose', {|p| self:saveFormAndClose(p) } )
	setCommand(, 'sys.ui', 'openView', {|p| self:openView(p) } )
	setCommand(, 'sys.ui', 'setFormObject', {|p| self:setFormObject(p) } )
	setCommand(, 'sys.ui', 'dialogBoxConfirmClose', {|p| self:dialogBoxConfirmClose(p) } )
return NIL

/** Run manager */
static function c_run( self,  params )
	self:running = .T.
	self:ws:run()
return NIL

/** Close manager */
static function c_close( self, params )
	if "RUNNING" $ self .and. self:running
		self:ws:quit()
	else
		CANCEL
	endif
return NIL

/** Open form */
static function c_openForm( self, params )
	// params: form:C
	local oErr, name, vRet, form, parent, t
	local formType, objId, action, class
	
	// Check params
	if assertParameters( params, { 'name:C' } )
		return NIL
	endif
	
	name := params:name
	
	formType := iif("TYPE" $ params, params:type, NIL)
	objId    := iif("ID" $ params, params:id, NIL)
	action   := iif("ACTION" $ params, params:action, NIL)
	
	// Get form from server
	vRet := component('form', 'get', params)
	
	eDebug(10, "UI: open form '"+name+"':", len(vRet), 'bytes. ID:', objId)
	//eDebug(19, vRet) 
	
	if empty(vRet)
		eDebug(1, "ERROR: cannot open empty form")
		return .F.
	endif
	
	if valtype(vRet) == 'O' .and. 'ERROR' $ vRet
		eDebug(1, "ERROR on form open:", vRet:error)
		return .F.
	endif
	
	if valtype(vRet) <> 'C'
		eDebug(1, "ERROR on form open: return value must be string")
		return .F.
	endif

	oErr := errorBlock({|e| break(e) })
	
	begin sequence
		//eDebug(10, "UI parent:", self:main)
		if valtype(self:main) == 'O' .and. self:main:className != "UIMainWindow" .and. "PARENT" $ self:main
			parent := self:main:parent
		else
			parent := self:main
		endif
	
		// Process and show form
		form := UIForm( name, parent )
		if SHOW_FORMS
			eDebug(17, "UI: FORM CONTENT:", vRet )
		endif
		win  := form:parseString(vRet)
	

		if win == NIL
			eDebug(3, "UI: Error parse form")
			return .F.
		elseif self:main == NIL
			self:main := win
		endif
		
		win:objId 	 := objId
		win:creator 	 := parent
		win:returnAction := action
		// eDebug(15, "FORM name:", formName, "type:", formType, "id:", objId, "action:", action)
		
		// Get class name
		t := form:oXml:XPath("/head/class")
		if len(t) > 0
			win:objClass := t[1]:attribute("name")
		else
			win:objClass := NIL
		endif
		//?? "SET WINDOW OBJECT ID:", win:objId, "CLASS:", win:objClass, chr(10)
		
		// Set pre actions
		t := form:oXml:XPath("/head")
		form:setPreAction(t[1], NIL)
	
		win:show()
	
	recover using oErr
		eDebug(1, "UI EXCEPTION:",errorMessage(oErr))
		return o
	end sequence

	eDebug(10, "UI: end open form")
return .T.

/** Close form */
static function c_closeForm( self, params )	// TODO
	local win
	// Lookup for form name and close it... 
return .F.

/** Save values from form */
static function c_saveForm( self, params )
	local window, o, class, id:=NIL, ddb

	// Check params
	if assertParameters( params, { 'window:O', 'class:C' } )
		return NIL
	endif

	window := params:window
	
	// Get values from form
	o := window:getObj()

	ddb := form_splitClass( params:class )
	
	// Put object to server
	id := component('sys.db', 'put', 'obj', o, 'class', ddb[2], 'db', ddb[1] )
	
	eDebug(5, "Form is saved:", id, o)
	
	window:objId := id
	window:origObj := o
	if 'ONSAVE' $ window
		eval(window:onSave, window, o)
	endif
return id

/** Save values from form */
static function c_saveFormAndClose( self, params )
	local id
	id := self:saveForm( params )
	if .not. empty(id)
		params:window:close()
	endif
return

/** Open view from server and fill table*/
static function c_openView( self, params )
        local name, fields:='', d, i, l, id, timeout:=NIL, timer, window:=NIL, pos:=NIL

	// Check params
	if assertParameters( params, { 'widget:O', 'name:C' } ) .or. .not. 'COLUMNS' $ params:widget
		return NIL
	endif

	if 'TIMEOUT' $ params
		timeout := params:timeout
	endif
	if 'WINDOW' $ params
		window := params:window
	endif
	
	eDebug(10, "UI: Open view '"+params:name+"'")

	// Define name and columns
	name := params:name
	for i in params:widget:columns
		fields += i+','
	next
	fields += 'id'
	
	// Get content from server
	d := component('form', 'getView', 'name', name, 'fields', fields)
	
	// Apply data to widget
	pos := iif('SAVEPOSITION' $ params:widget, params:widget:savePosition(), NIL)
	eDebug(5, "CURRENT ROW:", pos )
	params:widget:clear()
	//eDebug(10, "OPENVIEW():", d:data)
	for i in d:data
		l := len(i)
		id := i[l]
		//eDebug(14, "ADD ROW:", i, id)
		asize(i,l-1)
		params:widget:addRow(i,id)
		if 'RESTOREPOSITION' $ params:widget
			params:widget:restorePosition(pos)
		endif
	next

	// Autorefresh on timer
	if .not. empty(timeout) .and. valtype(window) == 'O' .and. 'TIMERS' $ window
		timeout := iif(valtype(timeout)!='N', val(timeout), timeout)
		eDebug(5, "Set update timer for view '"+params:name+"' (", timeout, "second(s) )")
		timer := UITimer(timeout, {|| openView(params:widget, params:name) } )
		aadd(window...
 
[truncated message content]