home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / cccommand.tcl < prev    next >
Text File  |  1997-11-25  |  23KB  |  833 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)cccommand.tcl    /main/titanic/16
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)cccommand.tcl    /main/titanic/16   25 Nov 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 knows everything about ClearCase commands.
  17.  
  18. Class CCCommand : {VSCommand} {
  19.     method destructor
  20.     constructor
  21.     method classifyOutput
  22.     method execute
  23. }
  24.  
  25.  
  26. # The name of the cleartool command.
  27. #
  28. global CCCommand::cleartoolCommand
  29. set CCCommand::cleartoolCommand "cleartool"
  30.  
  31.  
  32. # This contains the cleartool path, it is set
  33. # during system initialization and only used on Windows.
  34. #
  35. global CCCommand::cleartoolPath
  36. set CCCommand::cleartoolPath ""
  37.  
  38.  
  39. method CCCommand::destructor {this} {
  40.     # Start destructor user section
  41.     # End destructor user section
  42.     $this VSCommand::destructor
  43. }
  44.  
  45. constructor CCCommand {class this command path description} {
  46.     set this [VSCommand::constructor $class $this $command $description]
  47.     # Start constructor user section
  48.     global CCCommand::cleartoolCommand
  49.     if { $path != "" } {
  50.     set command "$command [quoteIf $path]"
  51.     }
  52.     $this command "${CCCommand::cleartoolCommand} $command"
  53.     # End constructor user section
  54.     return $this
  55. }
  56.  
  57.  
  58. # Get a command to chheck out a ClearCase object.
  59. #
  60. proc CCCommand::checkOut {path comment reserved} {
  61.     set command "co "
  62.     if { $comment == "" } {
  63.     append command "-nc"
  64.     } else {
  65.     append command "-c \"$comment\""
  66.     }
  67.     if { !$reserved } {
  68.     set command "$command -unreserve"
  69.     }
  70.     return [CCCommand new "$command" "$path" "Checkout $path"]
  71. }
  72.  
  73.  
  74. # Get a command to check in a ClearCase object.
  75. #
  76. proc CCCommand::checkIn {path noComment comment} {
  77.     set tempFile ""
  78.     if $noComment {
  79.     set command "ci -nc"
  80.     } else {
  81.     # normally we would just pass the empty comment to the command line
  82.     # however, on Windows CC freaks on this. So we just make an empty
  83.     # file for this case and use a different command line argument
  84.     if { ($comment == "")  && $win95 } {
  85.         set tempFile [BasicFS::tmpFile]
  86.         set command "ci -cfile \"$tempFile\""
  87.     } else {
  88.         set command "ci -c \"$comment\""
  89.     }
  90.     }
  91.  
  92.     set checkInCommand [CCCommand new "$command" "$path" "Checkin $path"]
  93.     if { $tempFile != "" } {
  94.     $checkInCommand addTempFile $tempFile
  95.     }
  96.  
  97.     return $checkInCommand
  98. }
  99.  
  100.  
  101. # Get a command to un check out a ClearCase object.
  102. #
  103. proc CCCommand::unCheckOut {path keepPrivate} {
  104.     if $keepPrivate {
  105.     set command "unco -keep"
  106.     } else {
  107.     set command "unco -rm"
  108.     }
  109.  
  110.     return [CCCommand new "$command" "$path" "Uncheckout $path"]
  111. }
  112.  
  113.  
  114. # Get a command to create a ClearCase object.
  115. #
  116. proc CCCommand::createElem {path type comment} {
  117.     if { $type == "" } {
  118.     set type "text_file"
  119.     }
  120.     set command "mkelem -eltype $type "
  121.     if { $comment == "" } {
  122.     append command "-nc"
  123.     } else {
  124.     append command "-c \"$comment\""
  125.     }
  126.     return [CCCommand new "$command" "$path" "Create file $path"]
  127. }
  128.  
  129.  
  130. # Get command to set attribute value on all
  131. # versions of vob element specified in path.
  132. #
  133. proc CCCommand::setAttribute {path name value} {
  134.     set command "mkattr -replace $name \\\"$value\\\""
  135.     return [CCCommand new "$command" "${path}@@" "set attribute $name"]
  136. }
  137.  
  138.  
  139. # Get a command to remove a ClearCase name.
  140. #
  141. proc CCCommand::removeName {path} {
  142.     set command "rmname"
  143.     return [CCCommand new "$command" "$path" "Delete file $path"]
  144. }
  145.  
  146.  
  147. # Get a command to rename a ClearCase object.
  148. #
  149. proc CCCommand::rename {oldPath newPath} {
  150.     set command "mv [quoteIf $oldPath] [quoteIf $newPath]"
  151.     return [CCCommand new "$command" "" "Rename $oldPath" ]
  152. }
  153.  
  154.  
  155. # Get a command to create a ClearCase branch.
  156. #
  157. proc CCCommand::createBranch {path type comment} {
  158.     set command "mkbranch "
  159.     if { $comment == "" } {
  160.     append command "-nc"
  161.     } else {
  162.     append command "-c \"$comment\""
  163.     }
  164.     append command " $type"
  165.     return [CCCommand new "$command" "$path" "Create branch $type on $path"]
  166. }
  167.  
  168.  
  169. # Get a command to destroy a ClearCase branch.
  170. #
  171. proc CCCommand::destroyBranch {path} {
  172.     set command "rmbranch -f -nc"
  173.     return [CCCommand new "$command" "$path" "Destroy branch"]
  174. }
  175.  
  176.  
  177. # Get a command to create a new ClearCase branch type.
  178. #
  179. proc CCCommand::newBranchType {type comment vob} {
  180.     set command "mkbrtype "
  181.     if { $comment == "" } {
  182.     append command "-nc"
  183.     } else {
  184.     append command "-c \"$comment\""
  185.     }
  186.     append command " -vob [quoteIf $vob] $type"
  187.     return [CCCommand new "$command" "" "New branch type $type"]
  188. }
  189.  
  190.  
  191. # Get a command to destroy the specified branch type
  192. # in the specified vob.
  193. #
  194. proc CCCommand::destroyBranchType {type vob} {
  195.     set command "rmtype -brtype -vob [quoteIf $vob] $type"
  196.     return [CCCommand new "$command" "" "Destroy branch type $type"]
  197. }
  198.  
  199.  
  200. # get a command to reserve a ClearCase checkout.
  201. #
  202. proc CCCommand::reserve {path} {
  203.     set command "reserve"
  204.     return [CCCommand new "$command" "$path" "Reserve $path"]
  205. }
  206.  
  207.  
  208. # Get a command to unreserve a ClearCase checkout.
  209. #
  210. proc CCCommand::unreserve {path} {
  211.     set command "unreserve"
  212.     return [CCCommand new "$command" "$path" "Unreserve $path"]
  213. }
  214.  
  215.  
  216. # Get a command to list checkouts of a ClearCase object.
  217. #
  218. proc CCCommand::listCheckout {path} {
  219.     set command "lsco"
  220.     return [CCCommand new "$command" "$path" "List checkouts of $path"]
  221. }
  222.  
  223.  
  224. # Get a command to change the comment for a ClearCase object.
  225. #
  226. proc CCCommand::changeComment {path comment} {
  227.     set command "chevent "
  228.     if { $comment == "" } {
  229.     append command "-nc"
  230.     } else {
  231.     append command "-c \"$comment\""
  232.     }
  233.     append command " -replace"
  234.     return [CCCommand new "$command" "$path" "Change comment of $path"]
  235. }
  236.  
  237.  
  238. # Get command to show diff of selected version
  239. # with specified version.
  240. #
  241. proc CCCommand::diff {path version graphical} {
  242.     if $graphical {
  243.     set command "xdiff"
  244.     } else {
  245.     set command "diff -col 160"
  246.     }
  247.     set command "$command [quoteIf $path\@\@$version] [quoteIf $path]"
  248.  
  249.     return [CCCommand new "$command" "" "Show diff with other version"]
  250. }
  251.  
  252.  
  253. # Returns whether the directory specified by
  254. # directory is checked out.
  255. #
  256. proc CCCommand::isCheckedOut {directory} {
  257.     set command "lsco -cview -fmt %u -directory"
  258.     set lscoCommand [CCCommand new "$command" "$directory" "Get checkout status of $directory"]
  259.     vsCommandHandler errorsSuspended 1
  260.     if { ![vsCommandHandler executeSilent $lscoCommand] } {
  261.     vsCommandHandler errorsSuspended 0
  262.     return 0
  263.     }
  264.  
  265.     vsCommandHandler errorsSuspended 0
  266.     if { [$lscoCommand output] != "" } {
  267.     return 1
  268.     }
  269.  
  270.     return 0
  271. }
  272.  
  273.  
  274. # Return whether the file path refers to exists in the vob.
  275. #
  276. proc CCCommand::existsInVob {path} {
  277.     # this should not be called if path does not exist
  278.     set command "ls -vob"
  279.     set lsCommand [CCCommand new "$command" "$path" "Searching $path in vob"]
  280.     if { ![vsCommandHandler executeSilent $lsCommand] } {
  281.     return 0
  282.     }
  283.  
  284.     if { [$lsCommand output] != "" } {
  285.     return 1
  286.     }
  287.  
  288.     return 0    
  289. }
  290.  
  291.  
  292. # Returns the previous version of path.
  293. #
  294. proc CCCommand::getPredecessor {path} {
  295.     set command "describe -fmt \"%PVn\""
  296.     set descCommand [CCCommand new "$command" "$path" "Get previous version of $path"]
  297.     if { ![vsCommandHandler executeSilent $descCommand] } {
  298.     return ""
  299.     }
  300.  
  301.     return "[$descCommand output]"
  302. }
  303.  
  304.  
  305. # Get value of attribute specified by name
  306. # from versions specified by path.
  307. #
  308. proc CCCommand::getAttributeValue {path name} {
  309.     set command "describe -s -aattr $name"
  310.     set getCommand [CCCommand new "$command" "${path}@@" "Get attribute $name"]
  311.     if { ![vsCommandHandler executeSilent $getCommand] } {
  312.     return ""
  313.     }
  314.  
  315.     regsub -all {"} [string trim [$getCommand output]] "" value
  316.     return $value
  317. }
  318.  
  319.  
  320. # Executes the remove branch command without
  321. # actually removing and intercepts the remove warning and
  322. # returns it.
  323. #
  324. proc CCCommand::getRemoveBranchWarning {path} {
  325.     set command "rmbranch -nc"
  326.     set rmCommand [CCCommand new "$command" "$path" "Destroy branch"]
  327.     $rmCommand input "no"
  328.  
  329.     # since 3.0 ClearCase returns error exit status on this
  330.     # command so use error output in that case  
  331.     vsCommandHandler errorsSuspended 1
  332.     set correctedError 0
  333.     if { ![vsCommandHandler executeSilent $rmCommand] } {
  334.     $rmCommand output [$rmCommand errors] 
  335.     set correctedError 1
  336.     }
  337.     vsCommandHandler errorsSuspended 0
  338.  
  339.     # remove superfluous output from warning
  340.     if { ![regsub -all {\[no\]} [$rmCommand output] "" warning] \
  341.     && $correctedError } {
  342.     return ""
  343.     }
  344.     return $warning
  345. }
  346.  
  347.  
  348. # Do a ClearCase listing in the specified paths and add following information to infoDict:
  349. # filename, version, checkout status, rule.
  350. #
  351. proc CCCommand::longListing {pathList infoDict} {
  352.     set existingPaths {}
  353.     foreach path $pathList {
  354.     if [file isdirectory $path] {
  355.         lappend existingPaths $path
  356.     }
  357.     }
  358.  
  359.     if [lempty $existingPaths] {
  360.     return ""
  361.     }
  362.  
  363.     set pathList $existingPaths
  364.  
  365.     set lsCommandString "ls -l "
  366.     # uncomment lsd parts for directory support (post titanic?)
  367.     # set lsdCommandString "ls -l -dir "
  368.     set lscoCommandString "lsco -cview "
  369.     foreach path $pathList {
  370.     set lsCommandString "$lsCommandString [quoteIf $path]"
  371.     # set lsdCommandString "$lsdCommandString [quoteIf $path]"
  372.     set lscoCommandString "$lscoCommandString [quoteIf $path]"
  373.      }
  374.  
  375.     # execute ClearCase ls commands
  376.     set lsCommand [CCCommand new "$lsCommandString" "" "$lsCommandString"]
  377.     if { ![vsCommandHandler executeSilent $lsCommand] } {
  378.     return
  379.     }
  380.  
  381.     # set lsdCommand [CCCommand new "$lsdCommandString" "" "$lsdCommandString"]
  382.     # if { ![vsCommandHandler executeSilent $lsdCommand] } {
  383.     #    return
  384.     #}
  385.  
  386.     # set lsOutput "[$lsCommand output]\n[$lsdCommand output]"
  387.     set lsOutput [$lsCommand output]
  388.  
  389.     # it succeeded, now format output so the browser understands it
  390.     foreach line [split $lsOutput "\n"] {
  391.     # it is either 'version' or 'directory version'. Strip directory
  392.     # to keep formatting simple
  393.     # regsub {^directory.} $line "" line
  394.     # for titanic skip directories
  395.         if [regexp {^directory.} $line] {
  396.             continue
  397.         }
  398.     if { ![regexp "^version" $line] } {
  399.         if { ![regexp {no version selected} $line] } {
  400.         continue
  401.         }
  402.         # no version selected: retrieve name
  403.         regexp {([^     ]+)\@\@} $line dummy name
  404.         set version "Not Selected"
  405.         set infoList {}
  406.         lappend infoList $version
  407.         lappend infoList ""
  408.         lappend infoList ""
  409.         $infoDict set $name $infoList
  410.         continue
  411.     }
  412.  
  413.     # if there is no 'Rule' in the line it is not a selected version
  414.     if { ![regexp {Rule:} $line] } {
  415.         continue
  416.     }
  417.  
  418.     # get version path name of file
  419.     regexp {^version[     ]+(.*)[     ]+Rule:} $line dummy nameVersion
  420.     # get just the path in filePath
  421.     regexp {(.*)\@\@} $nameVersion dummy filePath
  422.     # get the version name
  423.     regexp {\@\@([^     ]+)[     ]+} $nameVersion dummy version
  424.     # get the selection rule
  425.     regexp {Rule: (.*)$} $line dummy rule
  426.  
  427.     # if file is checkedout append 'from' information
  428.     if { [regexp { from [^      ]* } $line fromVersion] } {
  429.         set version "$version $fromVersion"
  430.         set status "Reserved"
  431.     } else {
  432.         set status "CheckedIn"
  433.     }
  434.     set infoList {}
  435.     lappend infoList $version
  436.     lappend infoList $status
  437.     lappend infoList $rule
  438.     $infoDict set $filePath $infoList
  439.     }
  440.  
  441.     # obtain checkout information
  442.     set lscoCommand [CCCommand new "$lscoCommandString" "" "$lscoCommandString"]
  443.     if { ![vsCommandHandler executeSilent $lscoCommand] } {
  444.     return
  445.     }
  446.  
  447.     # if the checkout line contains 'unreserved' retrieve the file name
  448.     # and update in dictionary
  449.     foreach line [split [$lscoCommand output] "\n"] {
  450.     if { [regexp {\(unreserved\)$} $line] } {
  451.         regexp { checkout version \"([^"]*)\" } $line dummy filePath
  452.         set infoList [$infoDict set $filePath]
  453.         $infoDict set $filePath [lreplace $infoList 1 1 "Unreserved"]
  454.     }
  455.     }
  456. }
  457.  
  458.  
  459. # Do a clearcase listing in the directories in
  460. # pathList and return a list with filenames.
  461. #
  462. proc CCCommand::shortListing {pathList} {
  463.     set existingPaths {}
  464.     foreach path $pathList {
  465.     if [file isdirectory $path] {
  466.         lappend existingPaths $path
  467.     }
  468.     }
  469.  
  470.     if [lempty $existingPaths] {
  471.     return ""
  472.     }
  473.  
  474.     set pathList $existingPaths
  475.     set lsCommandString "ls "
  476.     foreach path $pathList {
  477.     set lsCommandString "$lsCommandString [quoteIf $path]"
  478.      }
  479.  
  480.     # execute ClearCase ls commands
  481.     set lsCommand [CCCommand new "$lsCommandString" "" "$lsCommandString"]
  482.     if { ![vsCommandHandler executeSilent $lsCommand] } {
  483.     return ""
  484.     }
  485.  
  486.     # retrieve versions only: go through output and select
  487.     set fileList {}
  488.     foreach line [split [$lsCommand output] "\n"] {
  489.     # if there is no 'Rule' in the line it is not a selected version
  490.     if { ![regexp {Rule:} $line] } {
  491.         continue
  492.     }
  493.  
  494.     # get just the path in filePath
  495.     regexp {(.*)\@\@} $line dummy filePath
  496.     lappend fileList $filePath
  497.     }
  498.  
  499.     return $fileList
  500. }
  501.  
  502.  
  503. # Do a description on the specified ClearCase object and add to InfoDict:
  504. # Comments, Labels, Attributes, Hyperlinks value pairs.
  505. #
  506. proc CCCommand::describe {path infoDict} {
  507.     # First command: retrieve everything but hyperlinks
  508.     set commandString "describe -fmt %Na\\n%Vd\\n%u\\n%Nl\\n%c"
  509.     set command [CCCommand new "$commandString" "$path" "Retrieving info of $path"]
  510.     if { ![vsCommandHandler executeSilent $command] } {
  511.     return
  512.     }
  513.  
  514.     # parse output and add to the dictionary
  515.     set descLines [split [$command output] "\n"]
  516.     $infoDict set Attributes [lindex $descLines 0]
  517.     $infoDict set Created [lindex $descLines 1]
  518.     $infoDict set "Created By" [lindex $descLines 2]
  519.     $infoDict set Labels [lindex $descLines 3]
  520.     set comments [join [lrange $descLines 4 end] "\n"]
  521.     $infoDict set Comments $comments
  522.  
  523.     # Get hyperlinks and ClearCase Type
  524.     set commandString "describe"
  525.     set command [CCCommand new "$commandString" "$path" "Retrieving description of $path"]
  526.     if { ![vsCommandHandler executeSilent $command] } {
  527.     return
  528.     }
  529.  
  530.     # parse output and retrieve information
  531.     # hyperlinks part start with a HyperLinks: line, element type
  532.     # is on an element type: line
  533.     set inHyperLinkLines 0
  534.     set hyperLinkLines {}
  535.     set ccType ""
  536.     foreach descLine [split [$command output] "\n"] {
  537.     if [regexp {element type: (.*)} $descLine dummy type] {
  538.         set ccType $type
  539.     }
  540.  
  541.     # normally nothing follows the Hyperlinks: part, but be careful
  542.     # just in case the comment contains a Hyperlinks: part
  543.     if $inHyperLinkLines {
  544.         if { ![regexp :$ $descLine] } {
  545.         lappend hyperLinkLines $descLine
  546.         } else {
  547.         set inHyperLinkLines 0
  548.         }
  549.     }
  550.  
  551.     if [regexp {Hyperlinks:} $descLine] {
  552.         set inHyperLinkLines 1
  553.         set hyperLinkLines {}
  554.     }
  555.     }
  556.  
  557.     set hyperLinks [join $hyperLinkLines "\n"]
  558.     $infoDict set Hyperlinks [string trim $hyperLinks]
  559.     $infoDict set "ClearCase Type" $ccType
  560.  
  561.     # get class that this file was generated from
  562.     global VSFile::classAttribute
  563.     set name [CCCommand::getAttributeValue $path ${VSFile::classAttribute}]
  564.     $infoDict set "Generated From Class" $name
  565. }
  566.  
  567.  
  568. # Get the known branch types in the current vob and return them.
  569. #
  570. proc CCCommand::getBranchTypes {vob} {
  571.     set command "lstype -brtype -fmt \"%n \" -vob"
  572.     set listBranchCommand [CCCommand new "$command" "$vob" "List branch types"]
  573.     if { ![vsCommandHandler executeSilent $listBranchCommand] } {
  574.     return ""
  575.     }
  576.  
  577.     return "[$listBranchCommand output]"
  578. }
  579.  
  580.  
  581. # Get the version tree on 'path' and return it.
  582. #
  583. proc CCCommand::getVersions {path} {
  584.     set command "lsvtree -all -s -nco"
  585.     set lsVersionsCommand [CCCommand new "$command" "$path" "Retrieving versions of $path"]
  586.     if { ![vsCommandHandler executeSilent $lsVersionsCommand] } {
  587.     return ""
  588.     }
  589.  
  590.     # parse output: get version extensions only
  591.     # discard versions that are not printable versions such as /main
  592.     set versionList {}
  593.     foreach outputLine [split [$lsVersionsCommand output] "\n"] {
  594.     regsub -all {.*\@\@} $outputLine "" version
  595.     if [regexp {.*[0-9]} $version] {
  596.         lappend versionList $version
  597.     }
  598.     }
  599.  
  600.     return $versionList
  601. }
  602.  
  603.  
  604. # Get the active views on this machine and return in list.
  605. #
  606. proc CCCommand::getActiveViews {} {
  607.     set command "lsview"
  608.     set lsViewCommand [CCCommand new "$command" "" "Listing active views"]
  609.     if { ![vsCommandHandler executeSilent $lsViewCommand] } {
  610.     return ""
  611.     }
  612.  
  613.     # parse view list: get active view names only
  614.     set viewList {}
  615.     foreach outputLine [split [$lsViewCommand output] "\n"] {
  616.     if [regexp {\*[     ]+(.*)} $outputLine dummy viewLine] {
  617.         regsub {[/A-Z\\].*} $viewLine "" view
  618.         lappend viewList [string trim $view]
  619.     }
  620.     }
  621.  
  622.     return $viewList
  623. }
  624.  
  625.  
  626. # Return the clearcase type of this file.
  627. #
  628. proc CCCommand::getClearCaseType {path} {
  629.     set commandString "describe"
  630.     set command [CCCommand new "$commandString" "$path" "Retrieving description of $path"]
  631.     if { ![vsCommandHandler executeSilent $command] } {
  632.     return
  633.     }
  634.  
  635.     # parse output and retrieve information
  636.     # hyperlinks part start with a HyperLinks: line, element type
  637.     # is on an element type: line
  638.     set ccType ""
  639.     foreach descLine [split [$command output] "\n"] {
  640.     if [regexp {element type: (.*)} $descLine dummy type] {
  641.         set ccType $type
  642.     }
  643.     }
  644.  
  645.     return $ccType
  646. }
  647.  
  648.  
  649. # Returns whether the specified view exists in
  650. # the view directory.
  651. #
  652. proc CCCommand::viewIsActive {view} {
  653.     if $win95 {
  654.     set viewPath [path_name concat M:\\ $view]
  655.     } else {
  656.     set viewPath [path_name concat /view $view]
  657.     }
  658.  
  659.     return [file isdirectory $viewPath]
  660. }
  661.  
  662. proc CCCommand::getWorkingView {} {
  663.     set command "pwv -s -set"
  664.     set pwvCommand [CCCommand new "$command" "" "Determine working view"]
  665.     if { ![vsCommandHandler executeSilent $pwvCommand] } {
  666.     return ""
  667.     }
  668.  
  669.     set view [$pwvCommand output]
  670.     if [regexp  {\*\* NONE \*\*} $view] {
  671.     return ""
  672.     }
  673.     return $view
  674. }
  675.  
  676.  
  677. # Try to start the specified view.
  678. #
  679. proc CCCommand::startView {view} {
  680.     set command "startview"
  681.     set startViewCommand [CCCommand new "$command" "$view" "Start view $view"]
  682.     return [vsCommandHandler execute $startViewCommand]
  683. }
  684.  
  685.  
  686. # Get config spec of specified view.
  687. #
  688. proc CCCommand::getConfigSpec {view} {
  689.     set command "catcs -tag"
  690.     set getConfigSpecCommand [CCCommand new "$command" "$view" "Get config spec of $view"]
  691.     if { ![vsCommandHandler executeSilent $getConfigSpecCommand] } {
  692.     return ""
  693.     }
  694.  
  695.     return [$getConfigSpecCommand output]
  696. }
  697.  
  698.  
  699. # Set specified config spec of specified view.
  700. #
  701. proc CCCommand::setConfigSpec {view specFile} {
  702.     set command "setcs -tag [quoteIf $view] $specFile"
  703.     set setConfigSpecCommand [CCCommand new "$command" "" "Set config spec of $view"]
  704.     return [vsCommandHandler execute $setConfigSpecCommand]
  705. }
  706.  
  707.  
  708. # Determines the path to cleartool and save it in
  709. # cleartoolPath. Prepend cleartool command.
  710. # Windows only.
  711. #
  712. proc CCCommand::initializeCleartoolPath {} {
  713.     global CCCommand::cleartoolPath
  714.     global CCCommand::cleartoolCommand
  715.     if { ${CCCommand::cleartoolPath} != "" } {
  716.     return
  717.     }
  718.  
  719.     set fullName [VSCommand::findPath atria cleartool]
  720.     if { $fullName != "" } {
  721.     set CCCommand::cleartoolPath [path_name directory $fullName]
  722.     set CCCommand::cleartoolCommand $fullName
  723.     } else {
  724.     vsCommandHandler error "cleartool path not found"
  725.     }
  726. }
  727.  
  728.  
  729. # Returns the version release number of ClearCase.
  730. #
  731. proc CCCommand::getClearCaseVersion {} {
  732.     set getVersionCommand [CCCommand new "" "" "Get ClearCase version"]
  733.     $getVersionCommand command "${CCCommand::cleartoolCommand} -version"
  734.     if { ![vsCommandHandler executeSilent $getVersionCommand] } {
  735.     return ""
  736.     }
  737.  
  738.     set versionInfo [$getVersionCommand output]
  739.     # try to find most relevant version info
  740.     if [regexp {ClearCase version ([^ ]+) } $versionInfo dummy version] {
  741.     return $version
  742.     }
  743.     if [regexp {cleartool version ([^ ]+) } $versionInfo dummy version] {
  744.     return $version
  745.     }
  746.     if [regexp { version ([^ ]+) } $versionInfo dummy version] {
  747.     return $version
  748.     }
  749.  
  750.     return ""
  751. }
  752.  
  753.  
  754. # Classify the ClearCase output.
  755. #
  756. method CCCommand::classifyOutput {this} {
  757.     set outputLines {}
  758.     set warningLines {}
  759.     foreach line [split [$this output] "\n"] {
  760.     if [regexp -nocase {warning\:} $line] {
  761.         lappend warningLines $line
  762.         continue
  763.     }
  764.     lappend outputLines $line
  765.     }
  766.     if { $warningLines != "" } {
  767.     $this warnings [join $warningLines "\n"]
  768.     }
  769.     $this output [join $outputLines "\n"]
  770. }
  771.  
  772.  
  773. # Execute the command and classify if classifyOutput is set.
  774. #
  775. method CCCommand::execute {this {classifyOutput 0}} {
  776.     # if there is input feed it to command
  777.     if { [$this input] != "" } {
  778.     if $win95 {
  779.         set echoCommand "cmd.exe /c echo"
  780.     } else {
  781.         set echoCommand "echo"
  782.     }
  783.     set commandString "exec $echoCommand [$this input] |"
  784.     } else {
  785.     set commandString "exec"
  786.     }
  787.  
  788.     # do this to keep backslashes
  789.     set commandParts [$this command]
  790.     while { "$commandParts" != "" } {
  791.     if { ![regexp {^"([^"]*)"[     ]*(.*)$} $commandParts \
  792.         dummy commandPart commandParts] } {
  793.         regexp {^([^     ]*)[     ]*(.*)$} $commandParts \
  794.             dummy commandPart commandParts
  795.     }
  796.     if { "$commandPart" == "" } {
  797.         set commandString "$commandString {}"
  798.     } else {
  799.         if [regexp {\"} $commandPart] {
  800.         set commandString "$commandString $commandPart"
  801.         } else {
  802.         set commandString "$commandString [list $commandPart]"
  803.         }
  804.     }
  805.     }
  806.  
  807.     # do it
  808.     if [ catch { set output [eval $commandString] } errors] {
  809.     # Remove cleartool strings from output
  810.     regsub -all {cleartool[^:]*: } $errors "" commandOutput
  811.  
  812.     # Cleartool has error exit status on warnings so check
  813.     # if this really was an error
  814.     if { ![regexp -nocase {warning:} $commandOutput] } {
  815.         $this errors $commandOutput
  816.         $this removeTempFiles
  817.         return
  818.     }
  819.     } else {
  820.     # Remove cleartool strings
  821.     regsub -all {cleartool[^:]*: } $output "" commandOutput
  822.     }
  823.  
  824.     $this output $commandOutput
  825.     if $classifyOutput {
  826.     $this classifyOutput
  827.     }
  828.     $this removeTempFiles
  829. }
  830.  
  831. # Do not delete this line -- regeneration end marker
  832.  
  833.