home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / contsystem.tcl < prev    next >
Text File  |  1997-11-20  |  8KB  |  284 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)contsystem.tcl    /main/titanic/11
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)contsystem.tcl    /main/titanic/11   20 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 "vssystem.tcl" vcm
  15.  
  16. # This class represents a Continuus aware system.
  17.  
  18. Class ContSystem : {VSSystem} {
  19.     constructor
  20.     method destructor
  21.     method vsFileUserPath
  22.     method vsFileVSPath
  23.     method vsUserPath
  24.     method vsVsPath
  25.     method fileList
  26.     method currentProjectVersion
  27.     method fileExists
  28.     method move
  29.     method getVsType
  30. }
  31.  
  32. constructor ContSystem {class this name} {
  33.     set this [VSSystem::constructor $class $this $name]
  34.     # Start constructor user section
  35.     # End constructor user section
  36.     return $this
  37. }
  38.  
  39. method ContSystem::destructor {this} {
  40.     # Start destructor user section
  41.     # End destructor user section
  42.     $this VSSystem::destructor
  43. }
  44.  
  45.  
  46. # Use vsObjectUserPath to get path name to file.
  47. #
  48. method ContSystem::vsFileUserPath {this name type} {
  49.     # path method is redefined in VSSystem to use vsObjectUserPath
  50.     set systemPath [$this path]
  51.     set filePath [path_name concat $systemPath [$this getFileName $name $type]]
  52.     return $filePath
  53. }
  54.  
  55.  
  56. # Use vsObjectVSPath to make a relative path name starting with project.
  57. #
  58. method ContSystem::vsFileVSPath {this name type} {
  59.     set systemPath [ContSystem::vsObjectVSPath $this]
  60.     set filePath [path_name concat $systemPath [$this getFileName $name $type]]
  61.     return $filePath
  62. }
  63.  
  64. proc ContSystem::createVSPath {path} {
  65.     # cannot create a VCM path directly in continuus, only through
  66.     # some version of a project
  67.     return 1
  68. }
  69.  
  70. proc ContSystem::createUserPath {path} {
  71.     VSSystem::createUserPath ContSystem $path
  72. }
  73.  
  74.  
  75. # Get a continuus file object with given paths.
  76. #
  77. proc ContSystem::getFileObject {userPath vsPath} {
  78.     set contFile [VSSystem::getFileObject $userPath $vsPath]
  79.     ContFile promote $contFile
  80.     set system [$contFile systemVersion]
  81.     ContSystem promote $system
  82.     $contFile systemVersion $system
  83.     return $contFile
  84. }
  85.  
  86.  
  87. # Use default method, strip home directory and make a path to the work area.
  88. #
  89. proc ContSystem::vsObjectUserPath {object} {
  90.     set projectPath [ContSystem::vsObjectVSPath $object]
  91.     set project [lindex [file split $projectPath] 0]
  92.  
  93.     set workingVersions [ContCommand::getWorkingProjectVersions $project]
  94.     set versionCount [llength $workingVersions]
  95.     if { $versionCount == 0 } {
  96.     vsCommandHandler error "No working versions of Project $project found"
  97.     return ${ContCommand::ccmWorkArea}
  98.     }
  99.  
  100.     # if M4_cont_projects is set use the indicated version if it is a 
  101.     # working one
  102.     set version ""
  103.     set selectedVersions [m4_var get M4_cont_projects] 
  104.     if { $selectedVersions != "" } {
  105.     foreach projectVersion $selectedVersions {
  106.         regexp {(.*)-([^-]*)$} $projectVersion \
  107.             dummy selectedProject selectedVersion
  108.         if { ($selectedProject == $project) && \
  109.             ([lsearch -exact $workingVersions $selectedVersion] != -1 ) } {
  110.         set version $selectedVersion
  111.         break
  112.         }
  113.     }
  114.     }
  115.  
  116.     # version selection: use last working version
  117.     if { $version == "" } {
  118.     set version [lindex $workingVersions [expr $versionCount -1]]
  119.     }
  120.  
  121.     set projectVersion "$project\-$version"
  122.     global ContCommand::ccmWorkArea
  123.     set projectVersionPath [path_name concat\
  124.     ${ContCommand::ccmWorkArea} $projectVersion] 
  125.     set fullPath [path_name concat $projectVersionPath $projectPath]
  126.  
  127.     # final sanity check 
  128.     if { ![file isdirectory $projectVersionPath] } {
  129.     vsCommandHandler error "Project version $projectVersion not found in Work Area"
  130.     }
  131.  
  132.     return $fullPath
  133. }
  134.  
  135.  
  136. # Returns path of object, first component is project.
  137. #
  138. proc ContSystem::vsObjectVSPath {object} {
  139.     # get default path
  140.     if [$object isA SystemVersion] {
  141.     set objectPath [$object SystemVersion::path]
  142.     } else {
  143.     set objectPath [$object path]
  144.     }
  145.  
  146.     global ContCommand::contPathIgnore
  147.     set ignore ${ContCommand::contPathIgnore}
  148.     if { $ignore != "" } {
  149.     set comparePath [eval file join [file split $objectPath]]
  150.     if { ![string match "$ignore*" $comparePath] } {
  151.         VSSystem::warnForAbsolutePath
  152.         set ignore ""
  153.         return [eval file join [lrange [file split $objectPath] 1 end]]
  154.     }
  155.     }
  156.  
  157.     if { $ignore == "" } {
  158.     # strip homedir in default situation
  159.     set homeDir [M4Login::getHomeDir]
  160.     set projectPathIndex [expr [string length $homeDir] +1]
  161.     set projectPath [string range $objectPath $projectPathIndex end]
  162.     return $projectPath
  163.     }
  164.  
  165.     set ignoreLength [string length $ignore]
  166.     return [string range $objectPath [expr $ignoreLength + 1] end]
  167. }
  168.  
  169.  
  170. # Return user environment path of this system
  171. # using vsObjectUserPath.
  172. #
  173. method ContSystem::vsUserPath {this} {
  174.     return [ContSystem::vsObjectUserPath $this]
  175. }
  176.  
  177.  
  178. # Return vcm system path of this system using
  179. # vsObjectVSPath.
  180. #
  181. method ContSystem::vsVsPath {this} {
  182.     return [ContSystem::vsObjectVSPath $this]
  183. }
  184.  
  185.  
  186. # Returns a list of Continuus controlled files
  187. # int the directories specified by pathList.
  188. #
  189. method ContSystem::fileList {this pathList} {
  190.     return [ContCommand::shortListing $pathList]
  191. }
  192.  
  193.  
  194. # Extracts the currently selected project version
  195. # from the system user path and returns it.
  196. #
  197. method ContSystem::currentProjectVersion {this} {
  198.     set systemPath [$this path]
  199.     global ContCommand::ccmWorkArea 
  200.     set index [expr [string length ${ContCommand::ccmWorkArea}]+1]
  201.     set pathParts [file split [string range $systemPath $index end]]
  202.     # now first path component after work area is project version
  203.     if { [llength $pathParts] > 0 } {
  204.     return [lindex $pathParts 0]
  205.     } else {
  206.     return "None"
  207.     }
  208. }
  209.  
  210. proc ContSystem::renameVSDirectory {oldPath newPath} {
  211.     set renameCommand [ContCommand::rename $oldPath $newPath]
  212.     return [vsCommandHandler execute $renameCommand]
  213. }
  214.  
  215.  
  216. # Do nothing: Continuus dirs are always
  217. # created through the work area.
  218. #
  219. proc ContSystem::createVSDirectory {path} {
  220.     return 1 
  221. }
  222.  
  223.  
  224. # Create the specified path as Continuus directory element.
  225. # All pathname components except the last 
  226. # one must already exist.
  227. #
  228. proc ContSystem::createUserDirectory {path} {
  229.     set comment "Created by ObjectTeam"
  230.     set mkdirCommand [ContCommand::createObject $path dir $comment 0]
  231.     return [vsCommandHandler execute $mkdirCommand]
  232. }
  233.  
  234.  
  235. # Return whether the given user path is a directory in the Continuus
  236. # environment.
  237. #
  238. proc ContSystem::directoryExists {path} {
  239.     return [file isdirectory $path]
  240. }
  241.  
  242.  
  243. # Return whether file with given name and type exists in the VCM environment.
  244. #
  245. method ContSystem::fileExists {this name type} {
  246.     set filePath [$this vsFileUserPath $name $type]
  247.     return [file exists $filePath]
  248. }
  249.  
  250.  
  251. # Move file to this system and return
  252. # resulting object on success.
  253. #
  254. method ContSystem::move {this vsFile} {
  255.     if [[$vsFile systemVersion] isA ContSystem] {
  256.     set destDir [$this path]
  257.     # create directory if necessary
  258.     if { ![file isdirectory $destDir] } {
  259.         if { ![ContSystem::createUserPath $destDir] } {
  260.         return 0
  261.         }
  262.     }
  263.     set renameCommand [ContCommand::rename [$vsFile path] [$this path]]
  264.     return [vsCommandHandler execute $renameCommand]
  265.     }
  266.  
  267.     # source is not continuus: copy and delete
  268.     if { [$this VSSystem::copy $vsFile] != "" } {
  269.     return [$vsFile removeFromVS]
  270.     }
  271.  
  272.     return 0
  273. }
  274.  
  275.  
  276. # Return Continuus Type of specified file.
  277. #
  278. method ContSystem::getVsType {this path} {
  279.     return [ContCommand::getContinuusType $path]
  280. }
  281.  
  282. # Do not delete this line -- regeneration end marker
  283.  
  284.