home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / upgrade_labels.tcl < prev    next >
Text File  |  1996-06-03  |  6KB  |  246 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #    (c) Cadre Technologies Inc. 1996
  4. #
  5. #    File:        %W%
  6. #    Author:        Harm Leijendeckers
  7. #    Description:    Upgrade labels.
  8. #
  9. #---------------------------------------------------------------------------
  10. # SccsId = %W%    %G%    Copyright 1996 Cadre Technologies Inc.
  11.  
  12.  
  13. proc update_component { tableId c_component c_diagram contents new_label_name } {
  14.     set labels_to_be_removed {}
  15.     set new_label_value ""
  16.     foreach field $contents {
  17.     db select -s c_id
  18.     db select -l c_value
  19.     db select -s c_type
  20.     db from label$tableId
  21.     db where -s "c_component =" $c_component
  22.     db where -s "and  c_type =" $field
  23.     set result [db run]
  24.  
  25.     if [lempty $result] {
  26.         continue
  27.     }
  28.  
  29.     set c_id [lvarpop result]
  30.     set c_value [lvarpop result]
  31.     set c_type [lvarpop result]
  32.  
  33.     lappend labels_to_be_removed [list $c_id $c_type \
  34.                     [string length $new_label_value] $c_value]
  35.     set new_label_value "$new_label_value$c_value"
  36.     }
  37.  
  38.     # create new label in the database
  39.     set newobid [gen_obid CompLabel $tableId]
  40.     db insert -s c_id        $newobid
  41.     db insert -s c_diagram   $c_diagram
  42.     db insert -s c_component $c_component
  43.     db insert -s c_type      $new_label_name
  44.     db insert -l c_value     $new_label_value
  45.     db into   label$tableId
  46.     db run
  47.  
  48.     # update compitr table and remove old labels
  49.     foreach label_info $labels_to_be_removed {
  50.     set c_id [lvarpop label_info]
  51.     set c_labeltype [lvarpop label_info]
  52.     set c_namebegin [lvarpop label_info]
  53.     set value [lvarpop label_info]
  54.  
  55.     set blank_length [expr [string length $value] - \
  56.                    [string length [string trimleft $value]]]
  57.  
  58.     set c_value [string trim $value]
  59.     set c_namebegin [expr $c_namebegin + $blank_length]
  60.     set c_namelen [string length $c_value]
  61.  
  62.     # update compitr
  63.     if { $c_labeltype == "name" || $c_labeltype == "type" } {
  64.         db update compitr$tableId
  65.         db set    -s c_label     $newobid
  66.         db set    -i c_namebegin $c_namebegin
  67.         db set    -i c_namelen   $c_namelen
  68.         db set    -s c_labeltype $new_label_name
  69.         db where  -s "c_label =" $c_id
  70.         db run
  71.     }
  72.  
  73.     # remove old label
  74.     remove_label $tableId $c_id
  75.     }
  76. }
  77.  
  78.  
  79. proc update_attributes { tableId } {
  80.     db select -s c_id
  81.     db select -s c_diagram
  82.     db from row$tableId
  83.     db where -s "c_type =" attribute
  84.     foreach r [db runLoop] {
  85.     set c_id      [lvarpop r]
  86.     set c_diagram [lvarpop r]
  87.     update_component $tableId $c_id $c_diagram \
  88.                "modifiers name colon type init_value" name_type
  89.     }
  90. }
  91.  
  92.  
  93. proc update_methods { tableId } {
  94.     db select -s c_id
  95.     db select -s c_diagram
  96.     db from row$tableId
  97.     db where -s "c_type =" method
  98.     foreach r [db runLoop] {
  99.     set c_id      [lvarpop r]
  100.     set c_diagram [lvarpop r]
  101.     update_component $tableId $c_id $c_diagram \
  102.         "modifiers name left_parenth right_parenth colon type constraint" \
  103.         name_type
  104.     }
  105. }
  106.  
  107.  
  108. proc update_parameters { tableId } {
  109.     db select -s c_id
  110.     db select -s c_diagram
  111.     db from cell$tableId
  112.     db where -s "c_type =" parameter
  113.     foreach c [db runLoop] {
  114.     set c_id      [lvarpop c]
  115.     set c_diagram [lvarpop c]
  116.     update_component $tableId $c_id $c_diagram "name colon type comma" \
  117.              name_type
  118.     }
  119. }
  120.  
  121.  
  122. proc update_etds { tableId } {
  123.     db select -s c_id
  124.     db select -s c_diagram
  125.     db from node$tableId
  126.     db where  -s    "c_type =" etd_initiator
  127.     db where  -s "or c_type =" etd_object
  128.     foreach n [db runLoop] {
  129.     set c_id      [lvarpop n]
  130.     set c_diagram [lvarpop n]
  131.     update_component $tableId $c_id $c_diagram "name colon type" name_type
  132.     }
  133. }
  134.  
  135.  
  136. proc update_stds { tableId } {
  137.     db select -s c_id
  138.     db select -s c_diagram
  139.     db from cono$tableId
  140.     db where  -s "c_type =" activity
  141.     foreach c [db runLoop] {
  142.         set c_id      [lvarpop c]
  143.         set c_diagram [lvarpop c]
  144.         update_component $tableId $c_id $c_diagram "do name" name
  145.     }
  146. }
  147.  
  148.  
  149. # Remove CompLabels with no value except the ones at segments of a
  150. # transition in a std.
  151. #
  152. proc remove_labels { tableId } {
  153.     # Labels die value "" worden niet meer opgeslagen met uitzondering van
  154.     # labels bij de segmenten van transitions in een std die altijd een
  155.     # spatie als waarde krijgen.
  156.  
  157.     # First retrieve all c_id's of segments of transitions in a std
  158.     db select -s c_id
  159.     db   from segment$tableId
  160.     db  where "c_connector in ( select c_id \
  161.                   from conn$tableId \
  162.                  where c_type = 'transition' )"
  163.     set allStdTransitionSegments [db runLoop]
  164.  
  165.     # Iterate over all labels to find the ones with no value.
  166.     # If the label is empty and belongs to a std transition segment, update
  167.     # it's value with a space.
  168.     db select -s c_id
  169.     db select -l c_value
  170.     db select -s c_type
  171.     db select -s c_component
  172.     db   from label$tableId
  173.     foreach label [db runLoop] {
  174.     set c_id        [lvarpop label]
  175.     set c_value     [lvarpop label]
  176.     set c_type      [lvarpop label]
  177.     set c_component [lvarpop label]
  178.  
  179.     # if necessary, update std transition segment label
  180.     if { [lsearch $allStdTransitionSegments $c_component] != -1 &&
  181.          $c_value == "" } {
  182.         db update label$tableId
  183.         db    set -l c_value " "
  184.         db  where -s "c_id =" $c_id
  185.         db run
  186.  
  187.         continue
  188.     }
  189.  
  190.     # check if c_value is not empty
  191.     if { $c_value != "" } {
  192.         continue
  193.     }
  194.  
  195.     # check if c_id not in allStdTransitionSegments
  196.     if { [lsearch $allStdTransitionSegments $c_id] != -1 } {
  197.         continue
  198.     }
  199.  
  200.     # remove label and all compitr to it
  201.     remove_label $tableId $c_id
  202.     remove_compitrs_to $tableId $c_id
  203.     }
  204. }
  205.  
  206.  
  207. # Remove a label
  208. #
  209. proc remove_label { tableId c_id } {
  210.     db remove label$tableId
  211.     db where  -s "c_id =" $c_id
  212.     db run
  213. }
  214.  
  215.  
  216. # Remove all CompItemRefs of a CompLabel.
  217. #
  218. proc remove_compitrs_to { tableId c_label } {
  219.     db remove compitr$tableId
  220.     db where  -s "c_label =" $c_label
  221.     db run
  222. }
  223.  
  224.  
  225. # Remove all non-item referring CompItemRefs.
  226. #
  227. proc remove_compitrs { tableId } {
  228.     db remove compitr$tableId
  229.     db where  -s "c_item =" ""
  230.     db runLoop
  231. }
  232.  
  233.  
  234. # Main procedure to update labels
  235. #
  236. proc update_labels { tableId } {
  237.     remove_labels  $tableId
  238.     remove_compitrs $tableId
  239.  
  240.     update_attributes $tableId
  241.     update_methods $tableId
  242.     update_parameters $tableId
  243.     update_etds $tableId
  244.     update_stds $tableId
  245. }
  246.