home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / corpdbobj.tcl < prev    next >
Encoding:
Text File  |  1996-07-09  |  5.6 KB  |  204 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cadre Technologies Inc.    1996
  4. #
  5. #      File:           @(#)corpdbobj.tcl    /main/3
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)corpdbobj.tcl    /main/3   9 Jul 1996 Copyright 1996 Cadre Technologies Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14. require "browsdbobj.tcl"
  15.  
  16. Class CorpDbObj : {BrowsDbObj Corporate} {
  17.     method destructor
  18.     constructor
  19.     method promoter
  20.     method addProject
  21.     method addRole
  22.     method addUser
  23.     method removeObjects
  24.     attribute corporateGroupVersionSet
  25.     attribute roleSet
  26.     attribute userSet
  27.     attribute controlledClassSet
  28.     attribute customFileSet
  29. }
  30.  
  31. method CorpDbObj::destructor {this} {
  32.     # Start destructor user section
  33.  
  34.     [$this customFileSet] delete
  35.     [$this corporateGroupVersionSet] delete
  36.     [$this controlledClassSet] delete
  37.     [$this controlledListSet] delete
  38.     [$this roleSet] delete
  39.     [$this userSet] delete
  40.  
  41.     # End destructor user section
  42.     $this BrowsDbObj::destructor
  43. }
  44.  
  45. constructor CorpDbObj {class this name} {
  46.     set this [Corporate::constructor $class $this $name]
  47.     set this [BrowsDbObj::constructor $class $this $name]
  48.     return $this
  49. }
  50.  
  51. selfPromoter Corporate {this} {
  52.     if {(! [isCommand Browser]) || (! [info exists wmttoolObj])} return
  53.  
  54.     CorpDbObj promote $this
  55. }
  56.  
  57. method CorpDbObj::promoter {this} {
  58.     $this BrowsDbObj::promoter
  59.  
  60.     # this is the corporate object of the browser
  61.     $wmttoolObj corporateObj $this
  62.  
  63.     # create BrowsUiObj children
  64.     set customFileSet $this.${HCustFUiObj::uiClass}:0
  65.     if {! [isCommand $customFileSet]} {
  66.     HCustFUiObj new $customFileSet -parent $this
  67.     }
  68.     $this customFileSet $customFileSet
  69.     set controlledClassSet $this.${CClassUiObj::uiClass}:0
  70.     if {! [isCommand $controlledClassSet]} {
  71.     CClassUiObj new $controlledClassSet -parent $this
  72.     }
  73.     $this controlledClassSet $controlledClassSet
  74.     set controlledListSet $this.${CListUiObj::uiClass}:0
  75.     if {! [isCommand $controlledListSet]} {
  76.     CListUiObj new $controlledListSet -parent $this
  77.     }
  78.     $this controlledListSet $controlledListSet
  79.     set roleSet $this.${RoleUiObj::uiClass}:0
  80.     if {! [isCommand $roleSet]} {
  81.     RoleUiObj new $roleSet -parent $this
  82.     }
  83.     $this roleSet $roleSet
  84.     set userSet $this.${UsrUiObj::uiClass}:0
  85.     if {! [isCommand $userSet]} {
  86.     UsrUiObj new $userSet -parent $this
  87.     }
  88.     $this userSet $userSet
  89.     set corporateGroupVersionSet $this.${CorpGVUiObj::uiClass}:0
  90.     if {! [isCommand $corporateGroupVersionSet]} {
  91.     CorpGVUiObj new $corporateGroupVersionSet -parent $this
  92.     }
  93.     $this corporateGroupVersionSet $corporateGroupVersionSet
  94. }
  95.  
  96. method CorpDbObj::addProject {this} {
  97.     require "newobjentr.tcl"
  98.  
  99.     if {! [isCommand $wmttoolObj.newProject]} {
  100.     NewObjEntryDlg new $wmttoolObj.newProject \
  101.         -title "New Project" \
  102.         -message "Name:" \
  103.         -okPressed {
  104.         set projName [%this entry]
  105.         set script "[%this dbObj] createProject [list $projName]"
  106.         $wmttoolObj startCommand tcl \
  107.             "$script" "" "Creating project '$projName'..." {1 0} 1
  108.         }
  109.     }
  110.     $wmttoolObj.newProject dbObj $this
  111.     $wmttoolObj.newProject popUp
  112. }
  113.  
  114. method CorpDbObj::addRole {this} {
  115.     require "newobjentr.tcl"
  116.  
  117.     if {! [isCommand $wmttoolObj.newRole]} {
  118.     NewObjEntryDlg new $wmttoolObj.newRole \
  119.         -title "New Role" \
  120.         -message "Name:" \
  121.         -okPressed {
  122.         set roleName [%this entry]
  123.         set script "[%this dbObj] createRole [list $roleName]"
  124.         $wmttoolObj startCommand tcl \
  125.             "$script" "" "Creating role '$roleName'..." {1 0} 1
  126.         }
  127.     }
  128.     $wmttoolObj.newRole dbObj $this
  129.     $wmttoolObj.newRole popUp
  130. }
  131.  
  132. method CorpDbObj::addUser {this} {
  133.     require "newobjentr.tcl"
  134.  
  135.     if {! [isCommand $wmttoolObj.newUser]} {
  136.     NewObjEntryDlg new $wmttoolObj.newUser \
  137.         -title "New User" \
  138.         -message "Name:" \
  139.         -okPressed {
  140.         set userName [%this entry]
  141.         set script "[%this dbObj] createUser [list $userName]"
  142.         $wmttoolObj startCommand tcl \
  143.             "$script" "" "Creating user '$userName'..." {1 0} 1
  144.         }
  145.     }
  146.     $wmttoolObj.newUser dbObj $this
  147.     $wmttoolObj.newUser popUp
  148. }
  149.  
  150. proc CorpDbObj::associations {} {
  151.     return {\
  152.     projects customFileSet corporateGroupVersionSet \
  153.     controlledClassSet controlledListSet accessRuleSet roleSet userSet\
  154.     }
  155. }
  156.  
  157. proc CorpDbObj::childTypes {assoc} {
  158.     if {[lsearch -exact "[CorpDbObj::associations]" "$assoc"] == -1} {
  159.     return ""
  160.     }
  161.     return "[BrowserProcs::childTypes $assoc]"
  162. }
  163.  
  164. proc CorpDbObj::controlledLists {} {
  165.     return {
  166.     "[$this projectList]"
  167.     }
  168. }
  169.  
  170. proc CorpDbObj::infoProperties {} {
  171.     return [concat \
  172.     [BrowserProcs::infoProperties] \
  173.     {"DB Name" "DB Host" "DB Server" Release "Controlled Actions"} \
  174.     ]
  175. }
  176.  
  177. method CorpDbObj::removeObjects {this} {
  178.     set box $wmttoolObj.removeWarning
  179.     WarningDialog new $box \
  180.     -title "Delete Warning" \
  181.     -message [BrowserProcs::removeMessage] \
  182.     -helpPressed {.main helpOnName removeWarning} \
  183.     -cancelPressed {%this delete} \
  184.     -okPressed {
  185.         set script ""
  186.         foreach obj [$wmttoolObj selectedObjSet] {
  187.         if {"$script" != ""} {
  188.             append script " ;"
  189.         }
  190.         if [$obj isA User] {
  191.             append script " [$wmttoolObj corporateObj] removeUser $obj"
  192.         } else {
  193.             append script " $obj destroy"
  194.         }
  195.         }
  196.         $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  197.         %this delete
  198.     }
  199.     $box popUp
  200. }
  201.  
  202. # Do not delete this line -- regeneration end marker
  203.  
  204.