#
#    Copyright (C) 2010 Alexandros Stergiakis <alsterg@gmail.com>
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU Affero General Public License as
#    published by the Free Software Foundation, either version 3 of the
#    License, or (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU Affero General Public License for more details.
#
#    You should have received a copy of the GNU Affero General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
#

#//#
# A library for managing user defined procedures within a session and across sessions.
#
# Note: Registration/unregistration of commands can have security implications.
# These procedures, however, do not enforce any policy with respect to AUTHMODE.
# For the sake of flexibility this security policies are left to be enforced via other means,
# (e.g. MikroConf command visibility).
#//#

namespace eval procedures {
    namespace export register unregister getproc getlist invoke
    namespace import ::session::user_sessions

# Register a previously declared procedure (using the 'proc' Tcl command).
# Newly registered procs will be fully usable within the session that they where defined,
# but on any other concurent session they will not become available.
# Only new sessions will have those new procs present.
# If a procedure is already registered, then it is updated. The Events Session is always
# kept in sync with what is registered/unregistered, so no need to restart that Sesison.
# We cannot do that with user sessions, because parallel user sessions might have
# defined the same name procedure with different body, and we cannot just spontaneously
# overwrite them.
#
# Note: When registering a procedure the state of the procedure at the moment of
# registration is recorded. Therefore when issuing "save" any changes that occured
# since registration will not be saved.
#
# @assume $name follows naming conventions
#
# @param sid Session Id.
# @param name The name of the procedure to register.
# @error
proc register {sid name} {
    variable Procedures
    Session $sid SLAVE

    if {$name ni [thread::send $sid [list $SLAVE invokehidden info procs]]} {
        error "procedure \"$name\" does not exist"
    }
    
    set args [thread::send $sid [list $SLAVE invokehidden info args $name]]
    set body [thread::send $sid [list $SLAVE invokehidden info body $name]]
    
    set Procedures($name) [list $args $body]

    # Sync with Event Session    
    Global EVENT
    thread::send $EVENT [list $EVENT invokehidden proc $name $args $body]
    
    # Synch with all User Sessions
    foreach s [user_sessions] {
        if {$s ne $sid} {
            Session $s SLAVE
            thread::send $s [list $SLAVE invokehidden proc $name $args $body]
        }
    }
}

# Unregister a previously registered procedure. As with "register", changes will
# only take effect in new sessions, and at once on the Events Session. 
#
# @param name the name of the procedure to unregister.
# @error
proc unregister {name} {
    variable Procedures

    if {$name ni [array names Procedures]} {
        error "procedure \"$name\" is not registered"
    }
    
    unset Procedures($name)

    # Sync with Event Session    
    Global EVENT
    thread::send $EVENT [list $EVENT invokehidden rename $name {}]
}

# Get the list of currently registered procedures.
proc getlist {} {
    variable Procedures
    return [array names Procedures]
}

# Retrieve a specific registered procedure.
#
# @param name The name of the procedure to get.
# @return A list with the followng elements of a procedure: Name Args Body
# @error
proc getproc {name} {
    variable Procedures
    
    if {$name ni [array names Procedures]} {
        error "procedure \"$name\" is not registered"
    }
    
    return $Procedures($name)
}

# Call a procedure registered in the Event interpreter.
#
# @param name Name of registered procedure.
# @param args Additional arguments to pass to the procedure.
# @return Whatever returned by the called procedure.
proc invoke {name args} {
    variable Procedures
    
    if {$name ni [array names Procedures]} {
        error "procedure \"$name\" is not registered"
    }
    
    Global EVENT
    Thread::bgsend $EVENT [list $EVENT eval $name {*}$args]
}

namespace ensemble create

} ;# End of Namespace