home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / psysvdbobj.tcl < prev    next >
Text File  |  1996-11-28  |  14KB  |  511 lines

  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1996
  4. #
  5. #      File:           @(#)psysvdbobj.tcl    /main/hindenburg/13
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)psysvdbobj.tcl    /main/hindenburg/13   28 Nov 1996 Copyright 1996 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. require "wmt_util.tcl"
  13. # End user added include file section
  14.  
  15. require "ssysvdbobj.tcl"
  16.  
  17. Class PSysVDbObj : {SSysVDbObj} {
  18.     constructor
  19.     method destructor
  20.     method promoter
  21.     method addFileVersion
  22.     method allowsDrop
  23.     method createDatabase
  24.     method deselectDatabase
  25.     method destroyDatabase
  26.     method doCreateDatabase
  27.     method doDestroyDatabase
  28.     method filterType
  29.     method importFromPrevPhase
  30.     method importObject
  31.     method needPassword
  32.     method roundtripEngineer
  33.     method selectDatabase
  34.     method setPassword
  35.     method updateUserEnv
  36.     attribute hostIfName
  37.     attribute databaseIfName
  38. }
  39.  
  40. constructor PSysVDbObj {class this name} {
  41.     set this [SSysVDbObj::constructor $class $this $name]
  42.     $this hostIfName "Server"
  43.     $this databaseIfName "Database"
  44.     # Start constructor user section
  45.     # End constructor user section
  46.     return $this
  47. }
  48.  
  49. method PSysVDbObj::destructor {this} {
  50.     # Start destructor user section
  51.     # End destructor user section
  52.     $this SSysVDbObj::destructor
  53. }
  54.  
  55. method PSysVDbObj::promoter {this} {
  56.     $this SSysVDbObj::promoter
  57.     unpack_package
  58.     $this hostIfName "Server"
  59.     $this databaseIfName "Database"
  60.     global target
  61.     if {$target == "ORACLE"} {
  62.     $this hostIfName "Oracle SID"
  63.     $this databaseIfName "Schema"
  64.     }
  65. }
  66.  
  67. method PSysVDbObj::addFileVersion {this} {
  68.     require "newextfvdi.tcl"
  69.  
  70.     # show a box to choose name en type
  71.     set box .main.newExternalFV
  72.     if {! [isCommand $box]} {
  73.     NewExtFVDialog new $box
  74.     }
  75.     $box popUp
  76. }
  77.  
  78. method PSysVDbObj::allowsDrop {this uiClass} {
  79.     case "$uiClass" in {
  80.     {CorporateGroupVersion ExternalFileVersion GroupVersion} {
  81.         return 1
  82.     }
  83.     {default} {
  84.         return 0
  85.     }
  86.     }
  87. }
  88.  
  89. proc PSysVDbObj::associations {} {
  90.     return {\
  91.     localFileVersions externalLinks groupVersions customFileVersionSet \
  92.     savedGroupVersionSet workItemSet controlledListSet accessRuleSet\
  93.     }
  94. }
  95.  
  96. proc PSysVDbObj::childTypes {assoc} {
  97.     if {[lsearch -exact "[PSysVDbObj::associations]" "$assoc"] == -1} {
  98.     return ""
  99.     }
  100.     set childTypes [BrowserProcs::childTypes $assoc]
  101.     case "$childTypes" in {
  102.     {LocalFileVersion} {
  103.         return "${BrowserProcs::programmerFileTypes}"
  104.     }
  105.     {default} {
  106.         return [SysVDbObj::childTypes "$assoc"]
  107.     }
  108.     }
  109. }
  110.  
  111. proc PSysVDbObj::controlledLists {} {
  112.     return [SSysVDbObj::controlledLists]
  113. }
  114.  
  115. method PSysVDbObj::createDatabase {this} {
  116.     set box .main.createDatabase
  117.     if {! [isCommand $box]} {
  118.     ClassMaker::extend TemplateDialog CreateDatabaseDialog pSys
  119.     interface CreateDatabaseDialog $box {
  120.         modal yes
  121.         DlgColumn DC {
  122.         Label hostL {
  123.             text "Host:"
  124.         }
  125.         SingleLineText hostSLT {}
  126.         Label databaseL {
  127.             text "Database Name:"
  128.         }
  129.         SingleLineText dbNameSLT {}
  130.         }
  131.     }
  132.  
  133.     $box title "Create [$this databaseIfName]"
  134.     $box.DC.hostL text [$this hostIfName]
  135.     $box.DC.databaseL text [$this databaseIfName]
  136.  
  137.     $box config \
  138.         -pSys $this \
  139.         -helpPressed {.main helpOnName createDatabase} \
  140.         -okPressed {
  141.         set host [%this.DC.hostSLT text]
  142.         set name "[%this.DC.dbNameSLT text]"
  143.         set pSys [%this pSys]
  144.         if {$host == ""} {
  145.             wmtkerror "Invalid [$pSys hostIfName] specified"
  146.         } elseif {$name == ""} {
  147.             wmtkerror "Invalid [$pSys databaseIfName] specified"
  148.         } else {
  149.             set curConfig [[ClientContext::global] currentConfig]
  150.             $curConfig setProperty tdbname $name
  151.             $curConfig setProperty tdbhost $host
  152.             # update the menu enabling
  153.             [.main menuHdlr] selectionChanged
  154.             if [$pSys needPassword] {
  155.             $pSys setPassword "$pSys doCreateDatabase $host $name"
  156.             } else {
  157.             $pSys doCreateDatabase $host $name
  158.             }
  159.         }
  160.         }
  161.     }
  162.     $box popUp
  163. }
  164.  
  165. method PSysVDbObj::deselectDatabase {this} {
  166.     set curConfig [[ClientContext::global] currentConfig]
  167.     set name [$curConfig getPropertyValue tdbname]
  168.     set host [$curConfig getPropertyValue tdbhost]
  169.  
  170.     $curConfig setProperty tdbname ""
  171.     $curConfig setProperty tdbhost ""
  172.     # update the menu enabling
  173.     [.main menuHdlr] selectionChanged
  174.  
  175.     wmtkmessage "[$this databaseIfName] '$name' on '$host' deselected"
  176.  
  177. }
  178.  
  179. method PSysVDbObj::destroyDatabase {this} {
  180.     set curConfig [[ClientContext::global] currentConfig]
  181.     set name [$curConfig getPropertyValue tdbname]
  182.     set host [$curConfig getPropertyValue tdbhost]
  183.  
  184.     if [$this needPassword] {
  185.     $this setPassword "$this doDestroyDatabase \"$host\" \"$name\""
  186.     } else {
  187.     $this doDestroyDatabase $host $name
  188.     }
  189.  
  190.     $curConfig setProperty tdbname ""
  191.     $curConfig setProperty tdbhost ""
  192.     # update the menu enabling
  193.     [.main menuHdlr] selectionChanged
  194. }
  195.  
  196. method PSysVDbObj::doCreateDatabase {this host database} {
  197.     set otsh [quoteIf [m4_path_name bin otsh$EXE_EXT]]
  198.     set script "$otsh -f tdbop.tcl -- createDatabase $name $host"
  199.     set message \
  200.     "Creating [$this databaseIfName] '$name'\
  201.      on [$this hostIfName] '$host'..."
  202.     .main startCommand mtool "$script" "" "$message" {0 0} 1
  203. }
  204.  
  205. method PSysVDbObj::doDestroyDatabase {this host database} {
  206.     set otsh [quoteIf [m4_path_name bin otsh$EXE_EXT]]
  207.     set script "$otsh -f tdbop.tcl -- dropDatabase $database $host"
  208.     set message "Destroying [$this databaseIfName] '$database' on '$host'..."
  209.     .main startCommand mtool "$script" "" "$message" {0 0} 1
  210. }
  211.  
  212. method PSysVDbObj::filterType {this} {
  213.     return Programmer
  214. }
  215.  
  216. method PSysVDbObj::importFromPrevPhase {this mode} {
  217.     if  {"$mode" == "selected"} {
  218.     set tmpFile [args_file {}]
  219.     set fid [open $tmpFile w]
  220.  
  221.     foreach obj [.main selectedObjSet] {
  222.         if [$obj isA SystemFileReference] {
  223.         set confV [$obj getParent ConfigVersion]
  224.         set fileV [$obj referredFileVersion]
  225.         if [$fileV isA ExternalFileVersion] {
  226.             puts $fid "[$fileV identity]"
  227.         }
  228.         } elseif [$obj isA ExternalFileVersion] {
  229.         puts $fid "[$obj identity]"
  230.         }
  231.     }
  232.  
  233.     close $fid
  234.     set options "-S oopl -t $tmpFile -f import.tcl"
  235.     set script "[quoteIf [m4_path_name bin otsh$EXE_EXT]] $options"
  236.     .main startCommand mtool \
  237.         "$script" "" \
  238.         "Starting 'Import From Previous Phase'..." \
  239.         {1 0} 0
  240.     } else {
  241.     set box .main.importNew
  242.     if {! [isCommand $box]} {
  243.         interface TemplateDialog $box {
  244.         title "Import New"
  245.         modal yes
  246.         DlgColumn DC {
  247.             Label L {
  248.             text "Import new"
  249.             alignment CENTER
  250.             }
  251.             CheckButton SQLCB {
  252.             label SQL
  253.             }
  254.             CheckButton OOPLCB {
  255.             label OOPL
  256.             }
  257.         }
  258.         }
  259.         $box config \
  260.         -helpPressed {.main helpOnName importNew} \
  261.         -okPressed {
  262.             if [%this.DC.SQLCB state] {
  263.             set options "-S sql "
  264.             } else {
  265.             set options ""
  266.             }
  267.             if [%this.DC.OOPLCB state] {
  268.             append options "-S oopl "
  269.             }
  270.             append options "-f import.tcl"
  271.             set script "[quoteIf [m4_path_name bin otsh$EXE_EXT]] $options"
  272.             .main startCommand mtool \
  273.             "$script" "" \
  274.             "Starting 'Import From Previous Phase'..." \
  275.             {1 0} 0
  276.         }
  277.     }
  278.     $box popUp
  279.     }
  280. }
  281.  
  282. method PSysVDbObj::importObject {this context node} {
  283.  
  284.     # The ClientContext must be set to the source
  285.     # system in order to determine the file's path
  286.     set clientContext [ClientContext::global]
  287.     set currentSysV [$clientContext currentSystem]
  288.     if {([llength $context] >= 6) && ([$currentSysV isNil] ||
  289.     [$currentSysV getInfo Identity] != [lindex $context 3])} {
  290.     set levelIds [$clientContext currentLevelIdString]
  291.     while {! [[$clientContext currentProject] isNil]} {
  292.         $clientContext upLevel
  293.     }
  294.     $clientContext downLevelId \
  295.         [BrowserProcs::id2obj [lindex $context 0] Project $node]
  296.     $clientContext downLevelId \
  297.         [BrowserProcs::id2obj [lindex $context 1] ConfigVersion $node]
  298.     $clientContext downLevelId \
  299.         [BrowserProcs::id2obj [lindex $context 2] PhaseVersion $node]
  300.     $clientContext downLevelId \
  301.         [BrowserProcs::id2obj [lindex $context 3] SystemVersion $node]
  302.     } else {
  303.     set levelIds ""
  304.     }
  305.  
  306.     $this SysVDbObj::importObject $context $node
  307.  
  308.     if {"$levelIds" != ""} {
  309.     $clientContext setLevelIds $levelIds
  310.     }
  311. }
  312.  
  313. proc PSysVDbObj::infoProperties {} {
  314.     return [SysVDbObj::infoProperties]
  315. }
  316.  
  317. method PSysVDbObj::needPassword {this {context ""}} {
  318.     global target
  319.  
  320.     if {$target != "ORACLE" && $target != "SYBASE" && $target != "SQLSERVER"} {
  321.     return 0
  322.     }
  323.  
  324.     set curConfig [[ClientContext::global] currentConfig]
  325.     if {$target == "ORACLE"} {
  326.     if {$context == ""} {
  327.         set database [$curConfig getPropertyValue tdbname]
  328.     } else {
  329.         set database $context
  330.     }
  331.     set passWord [m4_var get M4_password -context $database]
  332.     } else {
  333.     if {$context == ""} {
  334.         set host [$curConfig getPropertyValue tdbhost]
  335.     } else {
  336.         set host $context
  337.     }
  338.     set passWord [m4_var get M4_password -context $host]
  339.     }
  340.     if {$passWord == ""} {
  341.     return 1
  342.     }
  343.  
  344.     return 0
  345. }
  346.  
  347. method PSysVDbObj::roundtripEngineer {this lang} {
  348.     uplevel #0 {require "config.tcl"}
  349.  
  350.     set clientContext [ClientContext::global]
  351.     set config [args_file {}]
  352.     $clientContext downLoadCustomFile roundtrip roundtrip etc $config
  353.     set configList [readConfigurationFile $config]
  354.     unlink $config
  355.  
  356.     set overwriteDiagram "no"
  357.     foreach configLine $configList {
  358.     if {[lindex $configLine 0] == "diagram"} {
  359.         if {[lindex $configLine 1] == "overwrite"} {
  360.         set overwriteDiagram [lindex $configLine 3]
  361.         break
  362.         }
  363.     }
  364.     }
  365.  
  366.     set systemName [[[$clientContext currentSystem] system] name]
  367.  
  368.     set pathList ""
  369.     foreach obj [.main selectedObjSet] {
  370.     lappend pathList [$obj path]
  371.     }
  372.     set argsFile [args_file $pathList]
  373.  
  374.     if {$overwriteDiagram == "yes"} {
  375.     set overw "-o"
  376.     } else {
  377.     set overw ""
  378.     }
  379.  
  380.     set prevPhase [[[[$clientContext currentPhase] previous \
  381.                 [$clientContext currentConfig]] phase] name]
  382.     set options \
  383.     "$overw -x -F $argsFile -S $systemName -A $prevPhase -T ObjectDesign"
  384.  
  385.     set script "[quoteIf [m4_path_name bin reveng_${lang}$EXE_EXT]] $options"
  386.     .main startCommand xtool \
  387.     "$script" "" \
  388.     "Starting 'Round trip selected files'..." \
  389.     {1 0} 0
  390. }
  391.  
  392. method PSysVDbObj::selectDatabase {this} {
  393.     set box .main.selectDatabase
  394.     if {! [isCommand $box]} {
  395.     require "listdbs.tcl"
  396.     ClassMaker::extend TemplateDialog SelectDatabaseDialog pSys
  397.     interface SelectDatabaseDialog $box {
  398.         title "Select Database"
  399.         modal yes
  400.         DlgColumn DC {
  401.         DlgRow DR {
  402.             DlgColumn DC {
  403.             Label hostL {
  404.                 text "Host:"
  405.             }
  406.             SingleLineText hostSLT {}
  407.             }
  408.             PushButton applyPB {
  409.             label "Apply"
  410.             }
  411.         }
  412.         Label databaseL {
  413.             text "Database:"
  414.         }
  415.         ComboBox databasesCB {
  416.             rowCount 5
  417.         }
  418.         }
  419.     }
  420.  
  421.     $box.DC.DR.DC.hostL text [$this hostIfName]
  422.     $box.DC.databaseL text [$this databaseIfName]
  423.  
  424.     $box.DC.DR.applyPB activated {
  425.         set host [.main.selectDatabase.DC.DR.DC.hostSLT text]
  426.         set name [.main.selectDatabase.DC.databasesCB text]
  427.  
  428.         .main busy 1
  429.         if {$target == "SYBASE" || $target == "SQLSERVER"} {
  430.         if [[.main.selectDatabase pSys] needPassword $host] {
  431.             set pSys [.main.selectDatabase pSys]
  432.             if {$name == ""} {
  433.             wmtkerror "Invalid [$pSys databaseIfName] specified"
  434.             } elseif { $host == ""} {
  435.             wmtkerror "Invalid [$pSys hostIfName] specified"
  436.             }
  437.             [.main.selectDatabase pSys] setPassword \
  438.             ".main.selectDatabase.DC.databasesCB entrySet \
  439.             \[listDatabases $host\]" "$host" "$database"
  440.         } else {
  441.             .main.selectDatabase.DC.databasesCB entrySet \
  442.             [listDatabases $host]
  443.         }
  444.         } else {
  445.             .main.selectDatabase.DC.databasesCB entrySet \
  446.             [listDatabases $host]
  447.         }
  448.         .main busy 0
  449.     }
  450.     $box config \
  451.         -pSys $this \
  452.         -helpPressed {.main helpOnName selectDatabase} \
  453.         -okPressed {
  454.         set host [string trim [%this.DC.DR.DC.hostSLT text]]
  455.         set name [string trim [%this.DC.databasesCB text]]
  456.         set pSys [%this pSys]
  457.         if {$name == ""} {
  458.             wmtkerror "Invalid [$pSys databaseIfName] specified"
  459.         } elseif { $host == ""} {
  460.             wmtkerror "Invalid [$pSys hostIfName] specified"
  461.         } else {
  462.             set curConfig [[ClientContext::global] currentConfig]
  463.             $curConfig setProperty tdbname $name
  464.             $curConfig setProperty tdbhost $host
  465.                 # update the menu enabling
  466.                 [.main menuHdlr] selectionChanged
  467.             wmtkmessage \
  468.             "[$pSys databaseIfName] '$name' on '$host' selected"
  469.             global target
  470.             if [$pSys needPassword] {
  471.                 $pSys setPassword
  472.             }
  473.         }
  474.         }
  475.     }
  476.     set curConfig [[ClientContext::global] currentConfig]
  477.     $box.DC.databasesCB text [$curConfig getPropertyValue tdbname]
  478.     if {[$box.DC.DR.DC.hostSLT text] != [$curConfig getPropertyValue tdbhost]} {
  479.         .main.selectDatabase.DC.databasesCB entrySet {}
  480.     }
  481.     $box.DC.DR.DC.hostSLT text [$curConfig getPropertyValue tdbhost]
  482.     $box popUp
  483. }
  484.  
  485. method PSysVDbObj::setPassword {this {script ""} {tdbHost ""} {tdbName ""}} {
  486.     require "dbasepwddi.tcl"
  487.  
  488.     DbasePwdDialog new .main.dbasePwdDialog
  489.     .main.dbasePwdDialog popUp "$script" "$tdbHost" "$tdbName"
  490. }
  491.  
  492. method PSysVDbObj::updateUserEnv {this} {
  493.     busy {
  494.     foreach obj [[[.main infoView] area] objectSet] {
  495.         set browsUiObj [$obj browsUiObj]
  496.         if {! [$browsUiObj isA ExternalFileVersion]} continue
  497.  
  498.         set path [$browsUiObj path]
  499.         if {"[$browsUiObj getInfo Status]" != "working"} {
  500.         catch {BasicFS::removeFile $path}
  501.         }
  502.         if {! [file exists $path]} {
  503.         $browsUiObj synchWithFileSystem
  504.         }
  505.     }
  506.     }
  507. }
  508.  
  509. # Do not delete this line -- regeneration end marker
  510.  
  511.