home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / contcomman.tcl < prev    next >
Text File  |  1997-11-20  |  18KB  |  661 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)contcomman.tcl    /main/titanic/15
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)contcomman.tcl    /main/titanic/15   20 Nov 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. require platform.tcl
  13. # End user added include file section
  14.  
  15. require_module_file "vscommand.tcl" vcm
  16.  
  17. # This class represents all knowledge about Continuus Commands.
  18.  
  19. Class ContCommand : {VSCommand} {
  20.     method destructor
  21.     constructor
  22.     method addOption
  23.     method addArgument
  24.     method deleteArguments
  25.     method classifyOutput
  26.     method execute
  27.  
  28.     # List of command options. Convenient to specify the options in a platform independent
  29.     # way. This is because Continuus uses different option specifiers on Unix (-) and Windows (/).
  30.     #
  31.     attribute optionList
  32.     attribute arguments
  33. }
  34.  
  35. global ContCommand::contCommand
  36. set ContCommand::contCommand "ccm"
  37.  
  38. global ContCommand::contPath
  39. set ContCommand::contPath ""
  40.  
  41.  
  42. # The path of the current ccm work area.
  43. #
  44. global ContCommand::ccmWorkArea
  45. set ContCommand::ccmWorkArea ""
  46.  
  47.  
  48. # If the corporate path property contains
  49. # an absolute path, it is stored in this
  50. # variable during init of Continuus vars,
  51. # in forward slash format.
  52. #
  53. global ContCommand::contPathIgnore
  54. set ContCommand::contPathIgnore ""
  55.  
  56.  
  57. method ContCommand::destructor {this} {
  58.     # Start destructor user section
  59.     # End destructor user section
  60.     $this VSCommand::destructor
  61. }
  62.  
  63. constructor ContCommand {class this command argument description} {
  64.     set this [VSCommand::constructor $class $this $command $description]
  65.     $this command "${ContCommand::contCommand} $command"
  66.     $this optionList {}
  67.     if { $argument != "" } {
  68.     $this arguments [list $argument]
  69.     }
  70.     return $this
  71. }
  72.  
  73.  
  74. # Get a command to checkout the specified Continuus object.
  75. #
  76. proc ContCommand::checkOut {path comment} {
  77.     set checkOutCommand [ContCommand new "co" "$path" "Checkout $path"]
  78.     $checkOutCommand addOption "c \"$comment\""
  79.     return $checkOutCommand
  80. }
  81.  
  82.  
  83. # Get a command to create the specified object.
  84. #
  85. proc ContCommand::createObject {path type comment task} {
  86.     # Remove spaces from file name
  87.     set filePath [path_name directory $path]
  88.     set fileName [file tail $path]
  89.     regsub -all " " $fileName "" fileName
  90.     set path [path_name concat $filePath $fileName]
  91.  
  92.     if { $type == "" } {
  93.     set type "ascii"
  94.     }
  95.     set createCommand [ContCommand new "create" "$path" "Create $path"]
  96.     if { $comment != "" } {
  97.     $createCommand addOption "c \"$comment\""
  98.     }
  99.     $createCommand addOption "t $type"
  100.     if { $task != 0 } {
  101.     $createCommand addOption "task $task"
  102.     }
  103.     return $createCommand
  104. }
  105.  
  106. proc ContCommand::deleteObject {path} {
  107.     set deleteCommand [ContCommand new "delete" "$path" "Delete $path"]
  108.     return $deleteCommand
  109. }
  110.  
  111.  
  112. # Get a command to delete and replace the version
  113. # specified by path.
  114. #
  115. proc ContCommand::deleteVersion {path} {
  116.     set deleteCommand [ContCommand new "delete" "$path" "Delete and replace $path"]
  117.     $deleteCommand addOption "replace"
  118.     return $deleteCommand
  119. }
  120.  
  121.  
  122. # Get a command to unuse and replace the version
  123. # specified by path.
  124. #
  125. proc ContCommand::unuseVersion {path} {
  126.     set unuseCommand [ContCommand new "unuse" "$path" "Unuse and replace $path"]
  127.     $unuseCommand addOption "replace"
  128.     return $unuseCommand
  129. }
  130.  
  131.  
  132. # Return a command to set the value of the specified attribute.
  133. #
  134. proc ContCommand::setAttribute {path name value} {
  135.     set setCommand [ContCommand new "attribute" "$path" "Set attribute $name"]
  136.     $setCommand addOption "c $name"
  137.     $setCommand addOption "f"
  138.     $setCommand addOption "t string"
  139.     $setCommand addOption "v \"$value\""
  140.     return $setCommand
  141. }
  142.  
  143.  
  144. # Get a command to reconfigure e.g. update the work
  145. # area in path.
  146. #
  147. proc ContCommand::reconfigure {path} {
  148.     return [ContCommand new "reconfigure" "$path" "Update work area in $path"]
  149. }
  150.  
  151. proc ContCommand::rename {oldPath newPath} {
  152.     set renameCommand [ContCommand new "move" "$oldPath" "Move $oldPath"]
  153.     $renameCommand addArgument $newPath
  154.     return $renameCommand
  155. }
  156.  
  157. proc ContCommand::checkOutDialog {} {
  158.     set checkOutDialog [ContCommand new "co" "" "Checkout Dialog"]
  159.     $checkOutDialog addOption "g"
  160.     return $checkOutDialog
  161. }
  162.  
  163. proc ContCommand::checkInDialog {} {
  164.     set checkInDialog [ContCommand new "ci" "" "Check in dialog"]
  165.     $checkInDialog addOption "g"
  166.     return $checkInDialog
  167. }
  168.  
  169. proc ContCommand::checkInTaskDialog {task} {
  170.     set checkInTaskDialog [ContCommand new "ci" "" "Check In Task Dialog"]
  171.     $checkInTaskDialog addOption "g"
  172.     $checkInTaskDialog addOption "task $task"
  173.     return $checkInTaskDialog
  174. }
  175.  
  176. proc ContCommand::findUseDialog {} {
  177.     set findUseDialog [ContCommand new "finduse" "" "Find Use Dialog"]
  178.     $findUseDialog addOption "g"
  179.     return $findUseDialog
  180. }
  181.  
  182. proc ContCommand::propertyDialog {} {
  183.     set propertyDialog [ContCommand new "prop" "" "Property Dialog"]
  184.     $propertyDialog addOption "g"
  185.     return $propertyDialog
  186. }
  187.  
  188. proc ContCommand::historyDialog {} {
  189.     set historyDialog [ContCommand new "history" "" "History Dialog"]
  190.     $historyDialog addOption "g"
  191.     return $historyDialog
  192. }
  193.  
  194. proc ContCommand::useDialog {} {
  195.     set useDialog [ContCommand new "use" "" "Use Dialog"]
  196.     $useDialog addOption "g"
  197.     return $useDialog
  198. }
  199.  
  200.  
  201. # Get command to bring up task selection dialog.
  202. #
  203. proc ContCommand::selectTaskDialog {} {
  204.     set selectTaskDialog [ContCommand new "task" "" "Select Task Dialog"]
  205.     $selectTaskDialog addOption "g"
  206.     return $selectTaskDialog
  207. }
  208.  
  209.  
  210. # Return a command for diffing the current version of path with the
  211. # version specified.
  212. #
  213. proc ContCommand::diff {path version} {
  214.     set file [file tail $path]
  215.     set command "diff [quoteIf $file-$version] [quoteIf $file]"
  216.     set diffCommand [ContCommand new "$command" "" "Show diff"]
  217.     return $diffCommand
  218. }
  219.  
  220. proc ContCommand::objectMakeDialog {} {
  221.     set objectMakeDialog [ContCommand new "make" "" "Start ObjectMake"]
  222.     $objectMakeDialog addOption "g"
  223.     return $objectMakeDialog
  224. }
  225.  
  226. proc ContCommand::queryDialog {} {
  227.     set queryDialog [ContCommand new "query" "" "Start Query Dialog"]
  228.     $queryDialog addOption "g"
  229.     return $queryDialog
  230. }
  231.  
  232. proc ContCommand::problemTrackingBrowser {} {
  233.     set problemDialog [ContCommand new "pt" "" "Start Problem Tracking"]
  234.     $problemDialog addOption "g"
  235.     return $problemDialog
  236. }
  237.  
  238.  
  239. # Get specified version in file specified by destPath.
  240. #
  241. proc ContCommand::getVersion {path version destPath} {
  242.     if $win95 {
  243.     set command "type [list $path-$version] > [list $destPath]"
  244.     } else {
  245.     set command "cat [list $path-$version] > $destPath"
  246.     }
  247.  
  248.     set catCommand [ContCommand new "$command" "" "Retrieve $path-$version"]
  249.     return [vsCommandHandler executeSilent $catCommand] 
  250. }
  251.  
  252.  
  253. # Return a  list of version identifiers for all versions of this object.
  254. #
  255. proc ContCommand::candidates {path} {
  256.     set candidatesCommand [ContCommand new "candidates" "$path" \
  257.         "Retrieving version of $path"]
  258.     if { ![vsCommandHandler executeSilent $candidatesCommand] } {
  259.     return "" 
  260.     }
  261.  
  262.     set versionList {}
  263.     foreach line [split [$candidatesCommand output] "\n"] {
  264.     set version [lindex $line 1]
  265.     # retrieve version identifier from full version name
  266.     regexp {\-[^-]+$} $version versionPart
  267.     lappend versionList [string range $versionPart 1 end]
  268.     }
  269.  
  270.     return $versionList
  271. }
  272.  
  273.  
  274. # returns whether the specified path refers
  275. # to a Continuus element.
  276. #
  277. proc ContCommand::existsInContinuus {path} {
  278.     # just test existence for performance reasons
  279.     return [file exists $path]
  280. }
  281.  
  282.  
  283. # Return the version identifier of the predecessor of this object.
  284. # If there are more return just one. Currentversion is the current version.
  285. #
  286. proc ContCommand::getPredecessor {path currentVersion} {
  287.     # do a history and parse output to get the information
  288.     set historyCommand [ContCommand new "hist" "$path" "Retrieve history of"]
  289.     $historyCommand addOption "f \"%name %version\""
  290.     if { ![vsCommandHandler executeSilent $historyCommand] } {
  291.     return
  292.     }
  293.  
  294.     set fileName [file tail $path]
  295.     set parseVersion ""
  296.     set inPredListing 0
  297.     foreach line [split [$historyCommand output] "\n"] {
  298.     if { "[lindex $line 0]" == "$fileName" } {
  299.         set parseVersion [lindex $line 1]
  300.     }
  301.  
  302.     if $inPredListing {
  303.         if { "$parseVersion" == "$currentVersion" } {
  304.         # Check if there are any predecessors
  305.         # if not this is a Successors: line
  306.         if [regexp {Successors:.*} $line] {
  307.             return ""
  308.         }
  309.  
  310.         # Bingo! This is the one. Get version id
  311.         regsub "$fileName\-" $line "" versionPart
  312.         regexp {[^:]*} [string trim $versionPart] versionId
  313.         return $versionId
  314.         }
  315.     }
  316.  
  317.     if [regexp {Predecessors:.*} $line] {
  318.         set inPredListing 1
  319.     } else {
  320.         set inPredListing 0
  321.     }
  322.     }
  323.  
  324.     # Not found
  325.     return ""
  326. }
  327.  
  328.  
  329. # Return the value of the specified attribute.
  330. #
  331. proc ContCommand::getAttributeValue {path name} {
  332.     global VSFile::classAttribute
  333.     set getCommand [ContCommand new "ls" "$path" "Get attribute $name"]
  334.     $getCommand addOption "f %${VSFile::classAttribute}"
  335.     if { ![vsCommandHandler executeSilent $getCommand] } {
  336.     return ""
  337.     }
  338.  
  339.     set value [string trim [$getCommand output]]
  340.     if { $value == "<void>" } {
  341.     return ""
  342.     }
  343.  
  344.     return $value
  345. }
  346.  
  347.  
  348. # Initialize the ccm variables:
  349. # CcmWorkArea.
  350. #
  351. proc ContCommand::initializeCcmVars {} {
  352.     global ContCommand::ccmWorkArea
  353.     global ContCommand::contPathIgnore
  354.  
  355.     # check corporate path
  356.     set corporate [[ClientContext::global] currentCorporate]
  357.     if [$corporate isA Corporate] {
  358.     set corpPath [$corporate getPropertyValue fileSystemPath]
  359.     if { [file pathtype $corpPath] != "relative" } {
  360.         set ContCommand::contPathIgnore \
  361.             [eval file join [file split $corpPath]]
  362.     }
  363.     }
  364.  
  365.     # check if CCM_WA_BASE is set, use it if so
  366.     if [catch { set wa $env(CCM_WA_BASE) }] {
  367.     set homeDir [M4Login::getHomeDir]
  368.     set defaultWaDir [path_name concat $homeDir ccm_wa]
  369.     if { ![file isdirectory $defaultWaDir] } {
  370.         vsCommandHandler error "Work Area Directory not found"
  371.         return 0
  372.     }
  373.  
  374.     # take first database directory we find
  375.     set oldDir [pwd]
  376.     cd $defaultWaDir
  377.     if [catch { set files [glob *] }] {
  378.         cd $oldDir
  379.         vsCommandHandler error "No databases found in $defaultWaDir"
  380.         return 0
  381.     }
  382.     set databaseDir ""
  383.     foreach file $files {
  384.         if [file isdirectory $file] {
  385.         set databaseDir $file
  386.         break
  387.         }
  388.     }
  389.     cd $oldDir
  390.     if { $databaseDir == "" } {
  391.         vsCommandHandler error "No directories found in $defaultWaDir"
  392.         return 0
  393.     }
  394.  
  395.     # set in global static variable
  396.     set ContCommand::ccmWorkArea [path_name concat \
  397.         $defaultWaDir $databaseDir]
  398.     return 1
  399.     }
  400.  
  401.     set ContCommand::ccmWorkArea $wa
  402.     return 1
  403. }
  404.  
  405.  
  406. # Do a formatted listing in the specified directories and get:
  407. # Version, Owner, Status, Continuus Type, Created, Modified, Platform, Release, Task, Instance.
  408. #
  409. proc ContCommand::longListing {pathList infoDict} {
  410.     set existingPaths {}
  411.     foreach path $pathList {
  412.     if [file isdirectory $path] {
  413.         lappend existingPaths $path
  414.     }
  415.     }
  416.  
  417.     if [lempty $existingPaths] {
  418.     return ""
  419.     }
  420.  
  421.     # make command: set format options and add all paths
  422.     set lsCommand [ContCommand new "ls" "" "long listing"]
  423.     global VSFile::classAttribute
  424.     set optionString "f \"%name %version %owner %status %type \\\"%create_time\\\" \\\"%modify_time\\\" \\\"%platform\\\" \\\"%release\\\" \\\"%task\\\" \\\"%${VSFile::classAttribute}\\\" %instance\""
  425.  
  426.     $lsCommand addOption $optionString
  427.     foreach path $existingPaths {
  428.     $lsCommand addArgument $path
  429.     }
  430.  
  431.     # Execute Continuus command
  432.     if { ![vsCommandHandler executeSilent $lsCommand] } {
  433.     return ""
  434.     }
  435.  
  436.     # parse the output and put it in dictionary
  437.     # use name as key, all other items as valuelist
  438.     if { [llength $existingPaths] == 1 } {
  439.     set fullPath [lindex $existingPaths 0]
  440.     } else {
  441.     regexp "(\[^ \]*) .*" $existingPaths dummy fullPath
  442.     }
  443.     foreach line [split [$lsCommand output] "\n"] {
  444.     if { [string trim $line] == "" } {
  445.         continue
  446.     }
  447.     # if multiple paths are used there is directory info
  448.     # in the output
  449.     if { [regexp {^[^ :]*:$} $line dirName] } {
  450.         if { [llength $existingPaths] == 1 } {
  451.         set fullPath [lindex $existingPaths 0]
  452.         } else {
  453.         regexp "(\[^ \]*) (.*)" $existingPaths dummy fullPath existingPaths
  454.         }
  455.         continue
  456.     }
  457.     
  458.     set name [lindex $line 0]
  459.     set type ""
  460.     if { [llength $line] > 4 } {
  461.         set type [lindex $line 4]
  462.     }
  463.     if { $type == "dir" } {
  464.         continue
  465.     }
  466.     set valueList [lrange $line 1 end]
  467.     $infoDict set [path_name concat $fullPath $name] $valueList
  468.     }
  469. }
  470.  
  471.  
  472. # Do a Continuus listing in the specified directories
  473. # and return a list of filenames.
  474. #
  475. proc ContCommand::shortListing {pathList} {
  476.     set existingPaths {}
  477.     foreach path $pathList {
  478.     if [file isdirectory $path] {
  479.         lappend existingPaths $path
  480.     }
  481.     }
  482.  
  483.     if [lempty $existingPaths] {
  484.     return ""
  485.     }
  486.  
  487.     # make command: set format options and add all paths
  488.     set lsCommand [ContCommand new "ls" "" "long listing"]
  489.     $lsCommand addOption "f \"%name %type\""
  490.     foreach path $existingPaths {
  491.     $lsCommand addArgument $path
  492.     }
  493.  
  494.     # Execute Continuus command
  495.     if { ![vsCommandHandler executeSilent $lsCommand] } {
  496.     return ""
  497.     }
  498.  
  499.     set fileList {}
  500.     if { [llength $existingPaths] == 1 } {
  501.     set fullPath [lindex $existingPaths 0]
  502.     } else {
  503.     regexp "(\[^ \]*) .*" $existingPaths dummy fullPath
  504.     }
  505.     foreach line [split [$lsCommand output] "\n"] {
  506.     if { [string trim $line] == "" } {
  507.         continue
  508.     }
  509.     if { [regexp {^[^ :]*:$} $line dirName] } {
  510.         if { [llength $existingPaths] == 1 } {
  511.         set fullPath [lindex $existingPaths 0]
  512.         } else {
  513.         regexp "(\[^ \]*) (.*)" $existingPaths dummy fullPath existingPaths
  514.         }
  515.         continue
  516.     }
  517.     
  518.     set name [lindex $line 0]
  519.     set type ""
  520.     if { [llength $line] > 1 } {
  521.         set type [lindex $line 1]
  522.     }
  523.     if { $type == "dir" } {
  524.         continue
  525.     }
  526.     lappend fileList [path_name concat $fullPath $name]
  527.     }
  528.  
  529.     return $fileList
  530. }
  531.  
  532.  
  533. # Get the comment for the specified object.
  534. #
  535. proc ContCommand::getComment {path} {
  536.     set commentCommand [ContCommand new "attr" "$path" "Get comment of $path"]
  537.     $commentCommand addOption "show comment"
  538.     if { ![vsCommandHandler executeSilent $commentCommand] } {
  539.     return ""
  540.     }
  541.  
  542.     return [$commentCommand output]
  543. }
  544.  
  545.  
  546. # Get the working versions of the named project
  547. # owned by the current user.
  548. #
  549. proc ContCommand::getWorkingProjectVersions {project} {
  550.     set queryCommand [ContCommand new "query" "" "Get working project versions"]
  551.     $queryCommand addOption "f %version"
  552.     $queryCommand addOption "n $project"
  553.     $queryCommand addOption "o [M4Login::getUserName]"
  554.     $queryCommand addOption "t project"
  555.     $queryCommand addOption "s working"
  556.     if { ![vsCommandHandler executeSilent $queryCommand] } {
  557.     return ""
  558.     }
  559.  
  560.     set versionList {}
  561.     foreach line [split [$queryCommand output] "\n"] {
  562.     # output returns first sequence number and then version name
  563.     lappend versionList [lindex $line 1]
  564.     }
  565.  
  566.     return $versionList
  567. }
  568.  
  569.  
  570. # Get the continuus type of the specified file.
  571. #
  572. proc ContCommand::getContinuusType {path} {
  573.     set lsCommand [ContCommand new "ls" "$path" "get type"]
  574.     $lsCommand addOption  "f %type"
  575.  
  576.     # Execute Continuus command
  577.     if { ![vsCommandHandler executeSilent $lsCommand] } {
  578.     return ""
  579.     }
  580.  
  581.     return [$lsCommand output]
  582. }
  583.  
  584.  
  585. # Add option to optionList.
  586. #
  587. method ContCommand::addOption {this option} {
  588.     set list [$this optionList]
  589.     lappend list $option
  590.     $this optionList $list
  591. }
  592.  
  593.  
  594. # Add argument to argument list.
  595. #
  596. method ContCommand::addArgument {this argument} {
  597.     $this arguments "[$this arguments] [list $argument]"
  598. }
  599.  
  600. method ContCommand::deleteArguments {this} {
  601.     $this arguments ""
  602. }
  603.  
  604. method ContCommand::classifyOutput {this} {
  605.     # not necessary for Continuus
  606. }
  607.  
  608.  
  609. # Construct the command from command, optionList and argumentList and execute it.
  610. #
  611. method ContCommand::execute {this classifyOutput} {
  612.     set commandString "exec [$this command]"
  613.  
  614.     # make option list
  615.     foreach option [$this optionList] {
  616.     if $win95 {
  617.         set commandString "$commandString /$option"
  618.     } else {
  619.         set commandString "$commandString \-$option"
  620.     }
  621.     }
  622.  
  623.     # add arguments
  624.     # with one argument, cd to the directory
  625.     # and execute there
  626.     set arguments [$this arguments]
  627.     set oldDir [pwd]
  628.     if { [llength $arguments] == 1 } {
  629.     set directory [string trim [path_name directory [lindex $arguments 0]]]
  630.     if [ catch { cd $directory }] {
  631.         $this errors "Directory $directory not found"
  632.         return
  633.     }
  634.     set commandString "$commandString [list [file tail [lindex $arguments 0]]]"
  635.     } else {
  636.     set commandString "$commandString $arguments"
  637.     }
  638.  
  639.     # Execute it
  640.     if [ catch { set output [eval $commandString] } errors] {
  641.     cd $oldDir
  642.     # continuus Commands return strange exit status sometimes
  643.     # ignore resulting tcl output
  644.     regsub {child process exited abnormally} $errors "" errors
  645.     $this errors $errors
  646.     return
  647.     }
  648.     cd $oldDir
  649.  
  650.     # Continuus sometimes throws in uninteresting lines in the
  651.     # output, remove it...
  652.     regsub {.*Updating database.*\.\.\..} $output "" output
  653.     $this output $output
  654.     if $classifyOutput {
  655.     $this classifyOutput
  656.     }
  657. }
  658.  
  659. # Do not delete this line -- regeneration end marker
  660.  
  661.