source: code/trunk_ogre_old/data/tcl/irk/lib/irkdispatch.tcl

# irkdispatch.tcl:
#
# Based on the input received from the server, dispatch control to various
# command procedures.

namespace eval ::irk {

    # This procedure sets up the default actions for a connection:

    proc setupDefaultActions {s nick} {
        variable state

        # Catch any unexpected PRIVMSG actions:

        set state($s,PRIVMSG,$nick)     $state(PRIVMSG,unsolicited)

        # Set up CTCP global actions:

        set state($s,cmd,ctcp,PING)     ::irk::RECV,CTCP,PING
        set state($s,cmd,ctcp,TIME)     ::irk::RECV,CTCP,TIME
        set state($s,cmd,ctcp,VERSION)  ::irk::RECV,CTCP,VERSION
        set state($s,cmd,ctcp,USERINFO) \
                                        ::irk::RECV,CTCP,USERINFO

        # Set up CTCP channel specific actions:

        set state($s,channel,ctcp,ACTION) \
                                        ::irk::RECV,CTCP,ACTION

        # Set up the CTCP TCL protocol:

        set state($s,channel,ctcp,TCL)  ::irk::RECV,CTCP,TCL
        set state($s,channel,ctcp,TCL,LOCAL) \
                                        ::irk::RECV,CTCP,TCL,LOCAL

        # Deal with CTCP commands we do not understand:

        set state($s,cmd,ctcp,error)    ::irk::RECV,CTCP,ERROR
        set state($s,channel,ctcp,error) \
                                        ::irk::RECV,CTCP,ERROR
    }

    # The consumer procedure consumes input received from
    # a connection. It calls the dispatcher for the given connection
    # with each input line.

    proc consumer {s} {
        variable state

        if {[eof $s]} {
            disconnect $s
        } else {
            set l [gets $s]
            if {[info exists state($s,trace)]} {
                $state($s,trace) $l
            }
            if {[string compare $l ""]} {
                dissect $state($s,contok) $l
            }
        }
    }

    # This procedure dissects the input into its parts:

    proc dissect {token line} {
        variable state

        # Make a list out of the line:

        set line [split $line " "]

        # Split first token into nickname and user mask:

        set nandu [split [lindex $line 0] \!]

        # Call dispatcher for this connection:

        $state($token,disp) \
                $token \
                [lindex $nandu 0] \
                [lindex $nandu 1] \
                [lindex $line 1] \
                [lindex $line 2] \
                [lrange $line 3 end]
    }

    # This procedure is the default command dispatcher:
    
    proc defaultDispatcher {token nick user comm dest rest} {
        variable state

        # Check if the nick starts with ':'. If not then this is
        # a special action, handled by the built in actions.

        if {![string match ":*" $nick]} {
            return [specialAction $token $nick $user $comm $dest $rest]
        }

        # Trim off the leading ':' on the $nick, if present.

        if {[string match ":*" $nick]} {
            set nick [string range $nick 1 end]
        }

        # If a ':' is present in the $dest, trim that off too.

        if {[string match ":*" $dest]} {
            set dest [string range $dest 1 end]
        }

        # If a ':' is present in the $rest, trim that off too.

        set firstrest [lindex $rest 0]
        if {[string match ":*" $firstrest]} {
            set firstrest [string range $firstrest 1 end]
            set rest [lreplace $rest 0 0 $firstrest]
        }

        # Clean up the payload:

        set rest [split [string trim [eval concat $rest]] " "]

        # Now try to dispatch to specific handlers.
        #
        # First see if there is a handler for the specific combination
        # of $token, $nick, $comm and $dest. This is used for PRIVMSG.

        if {[info exists state($token,$nick,$comm,$dest)]} {
            foreach cmd $state($token,$nick,$comm,$dest) {
                if {[catch {set res [$cmd $token $nick $user \
                                          $comm $dest $rest]} err]} {
                    if {[info exists state(errorhandler)]} {
                        $state(errorhandler) $err $token $comm $dest
                    }
                    return
                }

                # If this handler said to go on to a more general handler,
                # then don't return. Otherwise return.

                if {[string compare $res pass]} {
                    return
                }
            }
        }

        # If there's a handler for $token, $comm and $dest, use that.

        if {[info exists state($token,$comm,$dest)]} {
            foreach cmd $state($token,$comm,$dest) {
                if {[catch {set res [$cmd $token $nick $user \
                                          $comm $dest $rest]} err]} {
                    if {[info exists state(errorhandler)]} {
                        $state(errorhandler) $err $token $comm $dest
                    }
                    return
                }

                # If this handler said to go on to a more general handler,
                # then don't return. Otherwise return.

                if {[string compare $res pass]} {
                    return
                }
            }
        }

        # See if there's a handler for $token and $comm. If so use that.

        if {[info exists state($token,$comm)]} {
            foreach cmd $state($token,$comm) {
                if {[catch {set res [$cmd $token $nick $user \
                                          $comm $dest $rest]} err]} {
                    if {[info exists state(errorhandler)]} {
                        $state(errorhandler) $err $token $comm $dest
                    }
                    return
                }

                # If this handler said to go on to a more general handler,
                # then don't return. Otherwise return.

                if {[string compare $res pass]} {
                    return
                }
            }
        }

        # See if there's a global handler for the command. All the
        # default handlers are defined here.

        if {[info exists state(cmd,$comm)]} {
            foreach cmd $state(cmd,$comm) {
                if {[catch {set res [$cmd $token $nick $user \
                                          $comm $dest $rest]} err]} {
                    if {[info exists state(errorhandler)]} {
                        $state(errorhandler) $err $token $comm $dest
                    }
                    return
                }

                # If this handler said to go on to a more general handler,
                # then don't return. Otherwise return.

                if {[string compare $res pass]} {
                    return
                }
            }
        }

        # If all of the above fail, send this input to the default
        # action handler:

        if {[catch {set res [$state(action) \
                                $token $nick $user \
                                $comm $dest $rest]} err]} {
            if {[info exists state(errorhandler)]} {
                $state(errorhandler) $err $token $comm $dest
            }
            return
        }
    }

    # This procedure deals with special actions (built in, cannot
    # easily be modified by users). I use this to e.g deal with
    # PING, NOTICE, ERROR etc., automatically.

    proc specialAction {token nick user comm dest rest} {
        variable state

        # The nick is the special action selector:

        $state(special,$nick) $token $nick $user $comm $dest $rest
    }

    # This is the default error handler:

    proc echoerror {args} {
        puts stderr $args
    }

    # This procedure provides a default tracing facility (it just prints
    # the lines received to stderr):

    proc trace {args} {
        puts stderr "Received: $args"
    }
}