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