home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / rev_assoc.tcl < prev    next >
Text File  |  1997-05-30  |  5KB  |  172 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1997 by Cayenne Software, Inc.
  4. #
  5. # This software is furnished under a license and may be used only in
  6. # accordance with the terms of such license and with the inclusion of
  7. # the above copyright notice. This software or any other copies thereof
  8. # may not be provided or otherwise made available to any other person.
  9. # No title to and ownership of the software is hereby transferred.
  10. #
  11. # The information in this software is subject to change without notice
  12. # and should not be construed as a commitment by Cadre Technologies Inc.
  13. #
  14. #---------------------------------------------------------------------------
  15. # This file contains generic heuristic methods to recognize
  16. # associations and accessor methods
  17. #
  18. # Heuristics used:
  19. #
  20. # - Association recognition:
  21. #   - is the section "association-attribute-storage"
  22. #     if so: this must be an association, find out with which class
  23. #   - is the section "user-defined-attribute"
  24. #     if so: this is a normal attribute
  25. #   - is the type used a "classType" and it is some sort of pointer
  26. #     if so: assume that this is an association
  27. #   - if all the above fail
  28. #     assume that this is a normal attribute
  29. #
  30. # - Accessor methods:
  31. #   - is the section "attribute-accessor-method" or
  32. #     "association-accessor-method"
  33. #        if so: this is an accessor method
  34. #   - is the section "user-defined-method"
  35. #     if so: this is a normal method
  36. #   - if the name of the method starts with "set", "get", "remove" or "add" 
  37. #     and the rest of the name matches one of the attributes in this class
  38. #     if so: this is an accessor method
  39. #   - if all of the above fail, assume that this is a normal method
  40. #
  41.  
  42. puts "Reverse engineering associations activated."
  43.  
  44. Class GenRecAttrib : {REAttrib} {
  45.     constructor
  46.     method drawAssoc
  47.     method isAssocAttr
  48. }
  49.  
  50. constructor GenRecAttrib {class this} {
  51.     set this [REAttrib::constructor $class $this]
  52.     return $this
  53. }
  54.  
  55. method GenRecAttrib::drawAssoc {this} {
  56.     set assocKind "association"
  57.     set multKind "one"
  58.     set className [$this type]
  59.  
  60.     # Try do do some template recognition
  61.     if [regexp {(([^_]*)_)?(.*)} [$this type] fullStr under templ name] {
  62.         if [info exist debug] {
  63.             puts "Template breakdown: type=[$this type] templ=$templ name=$name"
  64.         }
  65.         switch -glob [string tolower $templ] {
  66.             "*set*" -
  67.             "*list*" -
  68.             "*array*" -
  69.             "*collection*" -
  70.             "*bag*" -
  71.             "*vector*" {
  72.                     set multKind "many" 
  73.                     set className $name
  74.                 }
  75.         }
  76.         switch [string tolower $name] {
  77.             "*dict*" {set assocKind "qualif_assoc"}
  78.             "*hash*" {set assocKind "qualif_assoc"}
  79.             "*table*" {set assocKind "qualif_assoc"}
  80.         }
  81.     } else {
  82.         set prop [$this findProp "modifier"]
  83.         if {$prop != ""} {
  84.             if {[$prop value] == "Value"} {
  85.                 return 0
  86.             }
  87.         }
  88.         if {[$this section] != "association-attribute-storage"} {
  89.             return 0
  90.         }
  91.     }
  92.  
  93.     set roleName [$this name]
  94.     if [regexp -nocase {(.*)(ref|ptr|set|(dict.*))} [$this name] totalname role rest] {
  95.         set roleName $role
  96.     }
  97.  
  98.     if {$roleName == ""} {
  99.         set roleName "x"
  100.     }
  101.  
  102.     set cl [[$this reDiagram] findClass $className]
  103.     if {$cl == ""} {
  104.         set cl [[$this reDiagram] addClass $className]
  105.         $cl setProp is_folded 1 comp
  106.     }
  107.     if [info exist debug] {
  108.         puts "Add $assocKind [[$this reClass] getName] -> $multKind [$cl getName] ($roleName)"
  109.     }
  110.     set conn [[$this reDiagram] addConn $assocKind [$this reClass] $cl]
  111.     $conn setLabel "role_end" $roleName
  112.     $conn setProp mult_kind_start "one"
  113.     $conn setProp mult_kind_end $multKind
  114.  
  115.     return 1
  116. }
  117.  
  118. method GenRecAttrib::isAssocAttr {this} {
  119.     if {[$this section] == "user-defined-attribute"} {
  120.         return 0
  121.     }
  122.     if {[$this typeKind] == "classType"} {
  123.         return [$this drawAssoc]
  124.     }
  125.     return 0
  126. }
  127.  
  128. selfPromoter REAttrib {this} {
  129.      GenRecAttrib promote $this
  130. }
  131.  
  132. Class GenRecMethod : {REMethod} {
  133.     constructor
  134.     method isAccessor
  135. }
  136.  
  137. constructor GenRecMethod {class this} {
  138.     set this [REMethod::constructor $class $this]
  139.     return $this
  140. }
  141.  
  142. method GenRecMethod::isAccessor {this} {
  143.     if {[$this section] == "attribute-accessor-method"} {
  144.         return 1
  145.     }
  146.     if {[$this section] == "association-accessor-method"} {
  147.         return 1
  148.     }
  149.     if {[$this section] == "user-defined-method"} {
  150.         return 0
  151.     }
  152.     if {[$this section] == "default-constructor-destructor"} {
  153.         if [info exists debug] {
  154.             puts "Adding default ctor"
  155.         }
  156.         [$this reClass] addMethod "\$create" "user-defined-method"
  157.         return 1
  158.     }
  159.     if [regexp -nocase {(let|set|add|remove|get)(.*)} [$this name] total acc attrN] {
  160.         foreach attr [[$this reClass] reAttribSet] {
  161.             if [regexp -nocase "${attrN}.*" [$attr name]] {
  162.                 return 1
  163.             }
  164.         }
  165.     }
  166.     return 0
  167. }
  168.  
  169. selfPromoter REMethod {this} {
  170.      GenRecMethod promote $this
  171. }
  172.