PC World 1998 October/PCWorld_1998-10_cd.bin/software/prehled/komix/DATA.Z/events.tcl

Text File | 1997-09-10 | 7KB | 301 lines

#---------------------------------------------------------------------------
#
#    (c) Cadre Technologies Inc. 1995
#
#    File:        @(#)events.tcl    /main/titanic/8
#    Author:        Harm Leijendeckers
#    Description:    Report on events
#    Usage in:    SystemVersion, CCD, COD, ETD, STD and UCD editor
#
#---------------------------------------------------------------------------
# SccsId = @(#)events.tcl    /main/titanic/8    10 Sep 1997    Copyright 1995 Cadre Technologies Inc.


eval [$cc getCustomFileContents semanticbase tcl reports]

proc ReportEvents::sort { key1 key2 } {
  # The only way the events are realy sorted. It's a bit dirty.
  set name1 [lindex [ReportEvents::getNameAndType %this $key1] 0]
  set name2 [lindex [ReportEvents::getNameAndType %this $key2] 0]
  # Sort COD Messages on seq nummer without being bothered about
  # a concurrent char
  regsub {(.*)([0-9])([a-z]) (.*)} $name1 {\1\2.0\3 \4} name1
  regsub {(.*)([0-9])([a-z]) (.*)} $name2 {\1\2.0\3 \4} name2

  if { "$name1" > "$name2"  } { return 1 }
  if { "$name1" == "$name2" } { return 0 }
  return -1
}

Class ReportEvents : {SemanticBase} {
    constructor
    method doReport
    method getNameAndType
}


constructor ReportEvents {class this} {
    set this [SemanticBase::constructor $class $this]
    $this reportName "Events and Messages"
    return $this
}


method ReportEvents::doReport {this model} {
    # get all events
    set events [concat \
    [$model getSMObjects $OMT_Event] \
    [$model getSMObjects $OMT_COD_Message] \
    [$model getSMObjects $OMT_STD_ComplexEvent] \
    [$model getSMObjects $OMT_STD_StateEvent] \
    ]
    if [lempty $events] { return 0 }

    set report [$this report]
    $report header {
    [$this report] print "From Component" 32
    [$this report] print "Event or Message" 32
    [$this report] print "To Component" 32
    [$this report] print Diagram line
    [$this report] line
    }

    set sortedEvents [concat [lsort -command ReportEvents::sort $events]]

    foreach event $sortedEvents {
    # From Component
    #
    set swap 0
    switch [[$event getComponents] type] {
        cod_message {
        set conn [$event getSuperiorObjects $OMT_COD_Conn]
        set from [$conn getFrom $OMT_EventSender]
                set comp [$event getComponents]
                set dir  [$comp getPropertyValue msg_direction]
                if { $dir == "backward" } {
                    set swap 1
                }
        }

        ver_compl_trans -
        hor_compl_trans {
        set connsIn  [$event getConnectorsIn $OMT_STD_Transition $ANY]
        set from ""
        foreach conn $connsIn {
            lappend from [$conn getFrom $OMT_EventSender]
        }
        }

        event_msg {
        set from [$event getFrom $OMT_STD_Event]
        }

        state_action {
        set from [$event getSuperiorObjects $OMT_STD_State]
        }

        default {
        set from [$event getFrom $OMT_EventSender]
        }
    }
    set fromText ""
    foreach smObj $from {
        append fromText " [$this getNameAndType $smObj]"
    }

    # Event
    #
    set eventText [$this getNameAndType $event]
    if { $eventText == "?" } {
        # skip events with no name
        continue
    }

    # To Component
    #
    switch [[$event getComponents] type] {
        cod_message {
        set conn [$event getSuperiorObjects $OMT_COD_Conn]
        set to [$conn getTo $OMT_EventReceiver]
        }

        ver_compl_trans -
        hor_compl_trans {
        set connsOut [$event getConnectorsOut $OMT_STD_Transition $ANY]
        set to ""
        foreach conn $connsOut {
            lappend to [$conn getTo $OMT_EventReceiver]
        }
        }

        state_action {
        set to [$event getSuperiorObjects $OMT_STD_State]
        }

        default {
        set to [$event getTo $OMT_EventReceiver]
        }
    }
    set toText ""
    foreach smObj $to {
        append toText " [$this getNameAndType $smObj]"
    }

    # Diagram
    #
    if { $from != "" } {
        set diagText [$this fullFileName [$from getDefiningDiagram]]
    } elseif { $to != "" } {
        set diagText [$this fullFileName [$to getDefiningDiagram]]
    } else {
        set diagText ?
    }

        if {$swap == 1} {
            set dummy    $fromText
            set fromText $toText
            set toText   $dummy
        }

    foreach fromLab $fromText {
        foreach eventLab $eventText {
        foreach toLab $toText {
            $report print $fromLab 31
            $report space
            $report print $eventLab 31
            $report space
            $report print $toLab 31
            $report space
            $report print $diagText 35
            $report line
        }
        }
    }
    }

    $report page
    $report remove header

    return 0
}


method ReportEvents::getNameAndType {this smObject} {
    if { $smObject == "" } {
    return "?"
    }
    set item [$smObject getItem]
    set comp [$smObject getComponents]
    set compType [$comp type]

    if { $compType == "cod_message" && ![$item isNil] } {
        # Sort on the integer part of the sequence expression; a sub
        # char is allowed: message1.3a is interpreted as 1.3a and is
        # sorted as 1.3.0a, making it appear before 1.3.1
    set label [$smObject getLabel]
    if ![$label isNil] {
            set seqNr ""
            set ccur  ""
            regsub -all {\[[^][]*\]} [$label value] {} value
        regexp {([0-9.]*)([a-z])?[*]?:.*} $value dummy seqNr ccur
            if ![lempty $seqNr] {
        return [list "$seqNr$ccur [$item name] ([$item type])"]
        }
    }
    }

    if ![$item isNil] {
    return [list "[$item name] ([$item type])"]
    }

    set qi [ORB::nil]
    switch $compType {
    ccd_actor -
    ccd_class -
    ccd_class_ref -
    ccd_container -
    cod_actor -
    nary_link -
    state_action -
    std_state -
    std_class -
    subject -
    ucd_actor -
    use_case {
        set items [$smObject getItem 0 name cl]
    }

    cod_message -
    ver_compl_trans -
    hor_compl_trans -
    etd_event -
    event_msg -
    transition {
        set items [$smObject getItem 0 event pe]
    }

    dir_com_assoc -
    final_state -
    und_com_assoc {
        set items [$smObject getItem 0 name pe]
    }

    instance -
    etd_initiator -
    etd_object {
        set items [$smObject getItem 0 name_type de]
        set qi [$smObject getItem 0 name_type cl]
    }

    state -
    name_state -
    start_state -
    super_state {
        set items [$smObject getItem 0 name st]
    }

    com_message {
        set items [query $comp.segments.labels.itemRefs.item]
    }

    default    {
        error "assert 'ReportEvents::getNameAndType' $compType"
    }
    }

    set result ""
    foreach item $items {
    set text ""
    if ![$item isNil] {
        append text "[$item name] ([$item type])"
        if ![$qi isNil] {
        append text ":"
        }
    }
    if ![$qi isNil] {
        append text "[$qi name] ([$qi type])"
    }
    if {"$text" == ""} {
        set label [$smObject getLabel]
        if ![$label isNil] {
        set label [$label value]
        } else {
        set label ""
        }
        if {"$label" == ""} {
        set text "?"
        } else {
        set text "$label"
        }
    }
    lappend result $text
    }

    return $result
}


# ----------------------------------------------------------------------
#
set executeMe [ReportEvents new]