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