PC World 2000 December/PCWorld_2000-12_cd.bin/Komunikace/Comanche/namespace/namespace.tcl

Text File | 2000-11-02 | 15.5 KB | 539 lines

package require unique

# namespaceServer --
#    This class implements the namespace component of the Comanche
# architecture.

class namespaceServer {

    # Stores nodes xuiObjects, keys are nodeIds

    variable xuiNodesArray

    # Array keys are node ids, values are the parent node of the node id.

    variable parentNodesArray

    # Array keys are node ids, values are a list of all children node ids

    variable childrenNodeArray

    # Contains nodes with no children and whose children have never been
    # requested. It is used to on the fly tree population.

    variable virginNodesArray

    # Stores the name of the plugin object that added the node

    variable nodeOwnerArray

    # All the view objects that are browsing the namespace

    variable registeredViewsList {}

    # Array that stores in the keys pairs [list $node $view] to indicate
    # a certain view has browsed the node

    variable browsedNodesArray

    # plugin Database object that holds information related to
    # plugins (i.e which plugins are interested in node of type
    # virtualhost?)

    variable pgDb

    # xuiObjects used in communication with plugIns
    #
    # To request requestXuiDocument

    variable xuiDocumentQuery

    # To deliver answer xuiDocument

    variable xuiDocumentAnswer

    # xuiObjects used in communication with View
    # to inform view nodes have been added.

    variable xuiAddNotify
    variable xuiAddNotifyNode
    variable xuiAddNotifyParentNode

    # xuiObjects used in communication with View
    # to inform view nodes have been deleted

    variable xuiRemoveNotify
    variable xuiRemoveNotifyNode

    # xuiObjects used to inform of delete queries
    variable xuiDeleteRequest
    variable xuiDeleteRequestNode
    variable xuiDeleteRequestCaller

    # xuiList containing list of children tof a certain node used in
    # returning getChildren calls

    variable childrenList

    constructor { } {
    array set browsedNodesArray {}
    set pgDb [ plugInDatabase ::#auto]

    set text  {
     <structure name="documentQuery">
         <syntax>
             <structure name="data">
             <syntax>
             </syntax>
         </structure>
         <label name="caller" />
         </syntax>
         </structure>
    }
    set xuiDocumentQuery [libgui::createXuiFromText $text]
    $xuiDocumentQuery.caller setValue $this


    set text  {
        <structure name="documentAnswer">
            <syntax>
                <structure name="data">
                    <syntax>
                    </syntax>
                </structure>
                <label name="caller" />
            </syntax>
        </structure>
    }
    set xuiDocumentAnswer [libgui::createXuiFromText $text]
    $xuiDocumentAnswer.caller setValue $this


    set xuiAddNotifyParentNode [xuiNode ::#auto]
    $xuiAddNotifyParentNode setName parentNode

    set xuiAddNotifyNode [xuiNode ::#auto]
    $xuiAddNotifyNode setName addedNode

    set xuiAddNotify [xuiStructure ::#auto]
    $xuiAddNotify setName notifyNodeAddedResponse
    $xuiAddNotify addComponent $xuiAddNotifyParentNode
    $xuiAddNotify addComponent $xuiAddNotifyNode

    set xuiRemoveNotifyNode [xuiNode ::#auto]
    $xuiRemoveNotifyNode setName node

    set xuiRemoveNotify [xuiStructure ::#auto]
    $xuiRemoveNotify setName notifyNodeRemovedResponse
    $xuiRemoveNotify addComponent $xuiRemoveNotifyNode

        set xuiDeleteRequest [xuiStructure ::#auto]
        set xuiDeleteRequestData [xuiStructure ::#auto]
        $xuiDeleteRequestData setName data

    set xuiDeleteRequestCaller [xuiLabel ::#auto]
        $xuiDeleteRequestCaller setName caller

    set xuiDeleteRequestNode [xuiNode ::#auto]
    $xuiDeleteRequestNode setName node

    $xuiDeleteRequest addComponent $xuiDeleteRequestCaller
    $xuiDeleteRequest addComponent $xuiDeleteRequestData
    $xuiDeleteRequestData addComponent $xuiDeleteRequestNode

    set childrenList [xuiList ::#auto]
    $childrenList setXuiClass list
    $childrenList setPrototype [xuiNode ::#auto]

    set root [xuiNode ::#auto]
    $root setXuiClass node
    $root addClass container
    $root setName rootNode
    $root setOpenIcon computer
    $root setClosedIcon computer
    $root setId root
    $root setLabel  [info hostname]

    array set parentNodesArray {root {}}
    array set childrenNodeArray {root {}}
    array set xuiNodesArray "root $root"
    array set nodeOwnerArray {root {}}
    array set virginNodesArray {root 0}
    }

    method getRootNode {} { return $xuiNodesArray(root) }
    method addNode { xuiData }
    method configureNode { xuiData caller}
    method removeNode { xuiData }
    method deleteNodeRequest { xuiData caller}
    method getChildren { xuiData caller}

    method requestXuiDocument {xuiData caller}
    method answerXuiDocument {xuiData caller}

    method _notifyAddedNode { nodeId }
    method _notifyRemovedNode { nodeId }
    method _notifyModifiedNode { nodeId }
    method _nodeExists { nodeId }

    method registerView { xuiData caller }

    method registerPlugInInterests { xuiData caller }
}

# namespaceServer::addNode --
#     Adds a node to the namespace server
#
# Arguments
#    xuiData
#
#    xuiData is the standard XML structure for exchanging data
#
#    It has the following structure:
#
#    xuiData (xuiStructure)
#       |
#       |- caller (xuiLabel)
#       |
#       \_ data (xuiStructure)
#            |
#            |- node (xuiNode)  Parent node
#            \_ newNode (xuiNode) New node to be added
# Returns
#
#    node    xuiNode containing the information about the node added


body namespaceServer::addNode { xuiData } {
    set data [ ::plugInUtils::getDataField $xuiData ]
    set caller [ ::plugInUtils::getCallerName $xuiData ]
    set parentNodeId [[$data getComponentByName node] getId]
    if ![_nodeExists $parentNodeId] {
    error "Tried to add a node whose parent $parentNodeId does not exists!"
    }
    set newId [unique::newId]
    set newNode [[$data getComponentByName newNode] clone]
    $newNode setId $newId
    set parentNodesArray($newId) $parentNodeId
    lappend childrenNodeArray($parentNodeId) $newId
    set childrenNodeArray($newId) {}
    set xuiNodesArray($newId) $newNode
    set nodeOwnerArray($newId) $caller
    set virginNodesArray($newId) 1
    set virginNodesArray($parentNodeId) 0
    _notifyAddedNode $newId
    return $newNode
}

# namespaceServer::deleteNodeRequest --
#    Request deletion of a node from the namespace server.

body namespaceServer::deleteNodeRequest { xuiData caller} {
    set nodeId [$xuiData getId]
    $xuiDeleteRequestNode setId $nodeId
    $nodeOwnerArray($nodeId) deleteNodeRequest $xuiDeleteRequest
    return
}

# namespaceServer::configureNode --
#    Changes properties of an existing node (image, label...).
# TO-DO: Use new API (get rid caller)

body namespaceServer::configureNode { xuiData caller} {
    set nodeId [$xuiData getId]
    if ![_nodeExists $nodeId] {
    error "Tried to configure $nodeId which does not exists!"
    }
    set xuiNode $xuiNodesArray($nodeId)
    $xuiData copyClone $xuiNode
    _notifyModifiedNode $nodeId
    return $nodeId
}

# namespaceServer::removeNode --
#    Remove node from the namespace server.
# TO-DO: Use new API (get rid caller)

body namespaceServer::removeNode { xuiData } {
    set data [::plugInUtils::getDataField $xuiData]
    set nodeId [[$data getComponentByName node] getId]
    if ![_nodeExists $nodeId] {
    error "Tried to delete $nodeId which does not exists!"
    }
    if [llength $childrenNodeArray($nodeId)] {
    error "You can not remove a non-empty node"

    } else {
        unset virginNodesArray($nodeId)
    unset childrenNodeArray($nodeId)
    delete object $xuiNodesArray($nodeId)
    unset xuiNodesArray($nodeId)
    unset nodeOwnerArray($nodeId)
    set parentNodeId $parentNodesArray($nodeId)
    set idx [lsearch -exact $childrenNodeArray($parentNodeId) $nodeId]
    set childrenNodeArray($parentNodeId) \
            [lreplace $childrenNodeArray($parentNodeId) $idx $idx]
    unset parentNodesArray($nodeId)
    _notifyRemovedNode $nodeId
    }
}

# namespaceServer::getChildren --
#    Get all children of a given node.
# TO-DO: Use new API (get rid caller)


body namespaceServer::getChildren { xuiData caller} {
    set parentNodeId [$xuiData getId]
    if $virginNodesArray($parentNodeId) {

    # If the node was virgin (it was never requested) we give the parent
    # an opportunity to add new nodes (this is useful for navigating
    # a directory tree on demand)

    set virginNodesArray($parentNodeId) 0
    $nodeOwnerArray($parentNodeId) populateNodeRequest $xuiData $this
    }

    # Take node the caller object has browsed this node, so we will inform
    # it when nodes are added or deleted to it.

    set browsedNodesArray([list $parentNodeId $caller]) 1
    $childrenList clear
    foreach item $childrenNodeArray($parentNodeId) {
    set ch [$childrenList newChild]
    $xuiNodesArray($item) copyClone $ch
    set browsedNodesArray([list [$xuiNodesArray($item) getId] $caller]) 1
    $childrenList insertChild $ch
    }
    return $childrenList
}

# namespaceServer::registerView --
#   Register a view with the namespace so we can inform of updates

body namespaceServer::registerView { xuiData caller} {
    lappend registeredViewsList $caller
}

# namespaceServer::_nodeExists --
#    Check if a node exists (it has a valid parent)

body namespaceServer::_nodeExists { nodeId } {
    return [info exists parentNodesArray($nodeId)]
}

# namespaceServer::_notifyAddedNode --
#    Notify all objects that have previously browsed a node that the node
# has new descendants

body namespaceServer::_notifyAddedNode { nodeId } {
    set parentNode $parentNodesArray($nodeId)
    foreach view $registeredViewsList {
    if [info exists browsedNodesArray([list $parentNode $view])] {
        [$xuiAddNotify getComponentByName parentNode] setId $parentNode
        $xuiNodesArray($nodeId) copyClone [$xuiAddNotify getComponentByName addedNode]
        $view nodeAddedNotify $xuiAddNotify $this
    }
    }
}

# namespaceServer::_notifyRemovedNode --
#    Notify all objects that have previously browsed a node that the node
# has being Removed

body namespaceServer::_notifyRemovedNode { nodeId } {
    foreach view $registeredViewsList {
    if [info exists browsedNodesArray([list $nodeId $view])] {
        [$xuiRemoveNotify getComponentByName node] setId $nodeId
        $view nodeRemovedNotify $xuiRemoveNotify $this
    }
    }
}

# namespaceServer::_notifyModifiedNode --
#    Notify all objects that have previously browsed a node that the node
# has changed its attributes.

body namespaceServer::_notifyModifiedNode { nodeId } {
    set parentNode $parentNodesArray($nodeId)
    foreach view $registeredViewsList {
    if [info exists browsedNodesArray([list $parentNode $view])] {
          $view nodeModifiedNotify $xuiNodesArray($nodeId) $this
    }
    }
}

# namespaceServer::registerPlugInInterests --

body namespaceServer::registerPlugInInterests { xuiData caller } {
}

# namespaceServer::requestXuiDocument --
#    This method is invoked by views to request a certain XML User Interface
# document (property pages, wizard, etc). The namespace will analyze the
# request, see which nodes are interested in contributing to the answer and
# return the specified document

body namespaceServer::requestXuiDocument {xuiData caller} {
    set nodeId [[$xuiData getComponentByName node] getId]

    # Find out which plugins may be interested (care of not duplicating
    # the owner)

    set classes [ $xuiNodesArray($nodeId)  getClasses]
    set plugInsList [$pgDb getPlugInsFromClasses $classes]
    if [expr [lsearch $plugInsList $nodeOwnerArray($nodeId)] == -1 ] {
    lappend plugInsList $nodeOwnerArray($nodeId)
    }
    #$xuiDocumentQuery.data forgetComponents
    $xuiData copyClone $xuiDocumentQuery.data


    # Create a container for the specific kind of document
    # being requested.

    set docType [$xuiData getComponentByName docType]
    switch -glob [$docType getValue] {
    propertyPages {
        set creator [propertyPagesDocumentCreator ::#auto]
    } description {
       set creator [htmlCreator ::#auto]
    } wizard* {
       set creator [wizardDocumentCreator ::#auto]
    } command {
       set creator [genericDocumentCreator ::#auto]

       # Right now only the parent interested
       # (so not to confuse other plugIns, but it is likely that
       # in the future somebody will want to intercept calls)

       set plugInsList $nodeOwnerArray($nodeId)
    } default {
        error "Unknown propertyPage [$docType getValue]"
    }
    }
    foreach plugIn $plugInsList {
    $creator add [$plugIn requestXuiDocument $xuiDocumentQuery ] $plugIn
    }
    set res [$creator getResult]
    delete object $creator
    #puts "****************** xuiData $xuiData"
    return $res
}

# namespaceServer::answerXuiDocument --
#    Namespace receives the submission of an XUI document addressed for a
# certain node. Figures out which nodes want to know about it and sends to
# them.
# TO_DO: May be concurrency problems is firs foreach plugin... loop is stuck
# on transmission and a new filevent arrives? Would xuiDocumentAnswer
# be overwritten?

body namespaceServer::answerXuiDocument {xuiData caller} {

    set docType [$xuiData getComponentByName docType]
    switch -glob [$docType getValue] {
    propertyPages {

    } wizard* {
    } default {
        error "Unknown propertyPage $docType"
    }
    }


    set nodeId [[$xuiData getComponentByName node] getId]
    set classes [ $xuiNodesArray($nodeId)  getClasses]
    set plugInsList [$pgDb getPlugInsFromClasses $classes]
    if [expr [lsearch $plugInsList $nodeOwnerArray($nodeId)] == -1 ] {
    lappend plugInsList $nodeOwnerArray($nodeId)
    }

    #$xuiDocumentAnswer.data forgetComponents
    $xuiData copyClone $xuiDocumentAnswer.data
    #$xuiData clear
    foreach plugIn $plugInsList {
    $plugIn answerXuiDocument $xuiDocumentAnswer
    }
    return
}




class propertyPagesDocumentCreator {
    variable pPages
    constructor {} {
    set pPages [ xuiStructure ::#auto]
    $pPages setXuiClass propertyPages
    $pPages setName propertyPages
    }
    method add {xuiData caller}
    method getResult {} { return $pPages }
}



body propertyPagesDocumentCreator::add { xuiData caller } {
    foreach pPage [$xuiData getComponents] {
    $pPages addComponent $pPage
    }
}



class wizardDocumentCreator {
    variable wizard
    constructor {} {
    set wizard [ xuiStructure ::#auto]
    $wizard setXuiClass propertyPages
    $wizard setName propertyPages
    }
    method add {xuiData caller}
    method getResult {} { return $wizard }
}



body wizardDocumentCreator::add { xuiData caller } {
    foreach wizardPage [$xuiData getComponents] {
    $wizard addComponent $wizardPage
    }
}



class genericDocumentCreator {
    variable generic
    constructor {} {
    set generic [ xuiStructure ::#auto]
    $generic setXuiClass propertyPages
    $generic setName propertyPages
    }
    method add {xuiData caller}
    method getResult {} { return $generic }
}



body genericDocumentCreator::add { xuiData caller } {
    foreach genericPage [$xuiData getComponents] {
    $generic addComponent $genericPage
    }
}


class htmlCreator {
    variable data {}
    constructor {} {
    }
    method add { text args} {append data $text}
    method getResult {} { return $data}
}