PC World 1997 November/PCWorld_1997-11_cd.bin/software/programy/komix/DATA.Z/rev_assoc.tcl

Text File | 1997-05-30 | 4.7 KB | 172 lines

#---------------------------------------------------------------------------
#
# Copyright (c) 1997 by Cayenne Software, Inc.
#
# This software is furnished under a license and may be used only in
# accordance with the terms of such license and with the inclusion of
# the above copyright notice. This software or any other copies thereof
# may not be provided or otherwise made available to any other person.
# No title to and ownership of the software is hereby transferred.
#
# The information in this software is subject to change without notice
# and should not be construed as a commitment by Cadre Technologies Inc.
#
#---------------------------------------------------------------------------
# This file contains generic heuristic methods to recognize
# associations and accessor methods
#
# Heuristics used:
#
# - Association recognition:
#   - is the section "association-attribute-storage"
#     if so: this must be an association, find out with which class
#   - is the section "user-defined-attribute"
#     if so: this is a normal attribute
#   - is the type used a "classType" and it is some sort of pointer
#     if so: assume that this is an association
#   - if all the above fail
#     assume that this is a normal attribute
#
# - Accessor methods:
#   - is the section "attribute-accessor-method" or
#     "association-accessor-method"
#        if so: this is an accessor method
#   - is the section "user-defined-method"
#     if so: this is a normal method
#   - if the name of the method starts with "set", "get", "remove" or "add"
#     and the rest of the name matches one of the attributes in this class
#     if so: this is an accessor method
#   - if all of the above fail, assume that this is a normal method
#

puts "Reverse engineering associations activated."

Class GenRecAttrib : {REAttrib} {
    constructor
    method drawAssoc
    method isAssocAttr
}

constructor GenRecAttrib {class this} {
    set this [REAttrib::constructor $class $this]
    return $this
}

method GenRecAttrib::drawAssoc {this} {
    set assocKind "association"
    set multKind "one"
    set className [$this type]

    # Try do do some template recognition
    if [regexp {(([^_]*)_)?(.*)} [$this type] fullStr under templ name] {
        if [info exist debug] {
            puts "Template breakdown: type=[$this type] templ=$templ name=$name"
        }
        switch -glob [string tolower $templ] {
            "*set*" -
            "*list*" -
            "*array*" -
            "*collection*" -
            "*bag*" -
            "*vector*" {
                    set multKind "many"
                    set className $name
                }
        }
        switch [string tolower $name] {
            "*dict*" {set assocKind "qualif_assoc"}
            "*hash*" {set assocKind "qualif_assoc"}
            "*table*" {set assocKind "qualif_assoc"}
        }
    } else {
        set prop [$this findProp "modifier"]
        if {$prop != ""} {
            if {[$prop value] == "Value"} {
                return 0
            }
        }
        if {[$this section] != "association-attribute-storage"} {
            return 0
        }
    }

    set roleName [$this name]
    if [regexp -nocase {(.*)(ref|ptr|set|(dict.*))} [$this name] totalname role rest] {
        set roleName $role
    }

    if {$roleName == ""} {
        set roleName "x"
    }

    set cl [[$this reDiagram] findClass $className]
    if {$cl == ""} {
        set cl [[$this reDiagram] addClass $className]
        $cl setProp is_folded 1 comp
    }
    if [info exist debug] {
        puts "Add $assocKind [[$this reClass] getName] -> $multKind [$cl getName] ($roleName)"
    }
    set conn [[$this reDiagram] addConn $assocKind [$this reClass] $cl]
    $conn setLabel "role_end" $roleName
    $conn setProp mult_kind_start "one"
    $conn setProp mult_kind_end $multKind

    return 1
}

method GenRecAttrib::isAssocAttr {this} {
    if {[$this section] == "user-defined-attribute"} {
        return 0
    }
    if {[$this typeKind] == "classType"} {
        return [$this drawAssoc]
    }
    return 0
}

selfPromoter REAttrib {this} {
     GenRecAttrib promote $this
}

Class GenRecMethod : {REMethod} {
    constructor
    method isAccessor
}

constructor GenRecMethod {class this} {
    set this [REMethod::constructor $class $this]
    return $this
}

method GenRecMethod::isAccessor {this} {
    if {[$this section] == "attribute-accessor-method"} {
        return 1
    }
    if {[$this section] == "association-accessor-method"} {
        return 1
    }
    if {[$this section] == "user-defined-method"} {
        return 0
    }
    if {[$this section] == "default-constructor-destructor"} {
        if [info exists debug] {
            puts "Adding default ctor"
        }
        [$this reClass] addMethod "\$create" "user-defined-method"
        return 1
    }
    if [regexp -nocase {(let|set|add|remove|get)(.*)} [$this name] total acc attrN] {
        foreach attr [[$this reClass] reAttribSet] {
            if [regexp -nocase "${attrN}.*" [$attr name]] {
                return 1
            }
        }
    }
    return 0
}

selfPromoter REMethod {this} {
     GenRecMethod promote $this
}