home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / vssystem.tcl < prev    next >
Text File  |  1997-11-20  |  14KB  |  533 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)vssystem.tcl    /main/titanic/17
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)vssystem.tcl    /main/titanic/17   20 Nov 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. require_module_file vstypemapp.tcl vcm
  13. # End user added include file section
  14.  
  15.  
  16. # This class represents a VCM aware system.
  17.  
  18. Class VSSystem : {Object} {
  19.     constructor
  20.     method destructor
  21.     method vsFiles
  22.     method path
  23.     method getPathList
  24.     method updatePath
  25.     method localFileVersions
  26.     method copy
  27.     method findVSFile
  28.     method createVSFile
  29.     method importVSFile
  30.     method getObjHandler
  31.     method getFileName
  32.     method getObjectName
  33.     method objectToFileName
  34.     method getType
  35.     method getTypeSpec
  36.     method typeMapper
  37.  
  38.     # Cache for path name of this system in user
  39.     # environment.
  40.     #
  41.     attribute _path
  42.     attribute _OTPath
  43.  
  44.     # Path list for this system.
  45.     #
  46.     attribute _pathList
  47.  
  48.     # Indicates the presence of a makefile in this system.
  49.     #
  50.     attribute makeFilePresent
  51.  
  52.     # The path of the makefile i.e. where make should
  53.     # be run.
  54.     #
  55.     attribute makeFilePath
  56.     attribute _typeMapper
  57. }
  58.  
  59.  
  60. # List to keep track of all objects with
  61. # a wrong path specification, to avoid 
  62. # multiple identical warnings.
  63. #
  64. global VSSystem::wrongPathObjectList
  65. set VSSystem::wrongPathObjectList ""
  66.  
  67.  
  68. constructor VSSystem {class this name} {
  69.     set this [Object::constructor $class $this $name]
  70.     $this makeFilePresent 0
  71.     # Start constructor user section
  72.     # End constructor user section
  73.     return $this
  74. }
  75.  
  76. method VSSystem::destructor {this} {
  77.     set ref [$this _typeMapper]
  78.     if {$ref != ""} {
  79.         $ref _system ""
  80.     }
  81.     # Start destructor user section
  82.     # End destructor user section
  83. }
  84.  
  85.  
  86. # Returns all the vsFiles in this system, using
  87. # VCM specific list mechanisms implemented in fileList.
  88. # For each file found a VSFile is created and the result
  89. # is a list containing all these objects.
  90. #
  91. method VSSystem::vsFiles {this} {
  92.     set vsFileList {}
  93.  
  94.     # find VS files and return them
  95.     $this makeFilePresent 0
  96.     foreach fileName [$this fileList [$this getPathList]] {
  97.     set filePath ""
  98.     if { [file pathtype $fileName] == "absolute" } {
  99.         set filePath [path_name directory $fileName]
  100.     } 
  101.     set name [path_name base $fileName]
  102.     set type [$this getType $fileName [path_name type $fileName] $filePath]
  103.     set objectName [$this getObjectName $name $type]
  104.     if { ![isCommand $objectName] } {
  105.         set vsFile [VSFile new $objectName $type $this]
  106.         $this promoteFile $vsFile
  107.     }
  108.     # only show files of known type
  109.     if { [$objectName type] != "" } {
  110.         lappend vsFileList $objectName
  111.     }
  112.     # detect makefiles
  113.     if { [$objectName type] == "makefile" } {
  114.         $this makeFilePresent 1
  115.         $this makeFilePath [path_name directory [$objectName path]]
  116.     }
  117.     }
  118.     return $vsFileList
  119. }
  120.  
  121.  
  122. # Redefinition of default path method that uses
  123. # vsObjectUserPath.
  124. #
  125. method VSSystem::path {this} {
  126.     set needUpdate 0
  127.     if { [$this _path] == "" } {
  128.     set needUpdate 1
  129.     } else {
  130.     # check if cached path is still valid by checking OTpath
  131.     if { [$this _OTPath] != [$this SystemVersion::path] } {
  132.         set needUpdate 1
  133.     }
  134.     } 
  135.  
  136.     if $needUpdate {
  137.     $this _path [$this vsUserPath]
  138.     $this _OTPath [$this SystemVersion::path]
  139.     }
  140.  
  141.     return [$this _path]
  142. }
  143.  
  144.  
  145. # Returns list of paths where files of this system are stored.
  146. #
  147. method VSSystem::getPathList {this} {
  148.     set needUpdate 0
  149.     if { [$this _pathList] == "" } {
  150.     set needUpdate 1
  151.     } else {
  152.     # check if cached path is still valid by checking OTpath
  153.     if { [$this _OTPath] != [$this SystemVersion::path] } {
  154.         set needUpdate 1
  155.     }
  156.     } 
  157.  
  158.     if $needUpdate {
  159.     $this updatePath
  160.     $this _OTPath [$this SystemVersion::path]
  161.     set pathList {}
  162.     foreach type [[$this typeMapper] typeList] {
  163.         set filePath [path_name directory [$this vsFileUserPath dummy $type]]
  164.         # check existence of path. This cannot be done with lsearch
  165.         # because it does not work well with windows pathnames
  166.         set existsInList 0
  167.         foreach path $pathList {
  168.         if { [file split $path] == [file split $filePath] } {
  169.             set existsInList 1
  170.         }
  171.         }
  172.         if !$existsInList {
  173.         lappend pathList $filePath
  174.         }
  175.     }
  176.     $this _pathList $pathList
  177.     }
  178.  
  179.     return [$this _pathList]
  180. }
  181.  
  182.  
  183. # Forces system to update its path (stored in _path).
  184. #
  185. method VSSystem::updatePath {this} {
  186.     $this _path ""
  187.     $this _pathList ""
  188. }
  189.  
  190.  
  191. # Return localFileVersions of a VCM aware system.
  192. #
  193. method VSSystem::localFileVersions {this} {
  194.     return ""
  195. }
  196.  
  197.  
  198. # Perform copy of VSFile to this system.
  199. # Needed for Edit and drag'n drop operations.
  200. #
  201. method VSSystem::copy {this vsFile} {
  202.     # make new object
  203.     set type [$vsFile type]
  204.     set objectName [$this getObjectName [$vsFile name] $type]
  205.     set newVSFile [VSFile new $objectName $type $this]
  206.     
  207.     # check if copy succeeded
  208.     if { $newVSFile == "" } {
  209.     return ""
  210.     }
  211.  
  212.     $this promoteFile $newVSFile
  213.  
  214.     # if creation in the VCM system fails remove the object
  215.     if { ![$this fileExists [$vsFile name] $type] } {
  216.     set comment "Copied from [[$this system] name]"
  217.     if { ![$newVSFile createInVS [list "$comment"]] } {
  218.         # check if it really was not created
  219.         if { ![$this fileExists [$vsFile name] $type] } {
  220.         $newVSFile delete
  221.         return ""
  222.         }
  223.     }    
  224.     } else {
  225.     wmtkinfo "File [$vsFile vsPath] already exists"
  226.     return ""
  227.     }
  228.  
  229.     # check out if necessary
  230.     set userPath [$newVSFile path]
  231.     if { ![$newVSFile isCheckedOut] } {
  232.     set comment "Copied from [$vsFile vsPath]"
  233.     if { ![$newVSFile checkOut $comment] } {
  234.         return ""
  235.     }
  236.     }
  237.  
  238.     # get reference to old file and perform the copy
  239.     set source [$vsFile getReference]
  240.     if [catch { BasicFS::copyFile $source $userPath } message] {
  241.     vsCommandHandler error "Copying [$vsFile path]: $message"
  242.     }
  243.     $vsFile deleteReference $source
  244.  
  245.     # copy class attribute
  246.     $newVSFile setClass [$vsFile getClass]
  247.     return $newVSFile
  248. }
  249.  
  250.  
  251. # Find the object for the VSFile with the given name
  252. # and return it.
  253. #
  254. method VSSystem::findVSFile {this name type} {
  255.     set object [$this getObjectName $name $type]
  256.     if [isCommand $object] {
  257.         return $object
  258.     }
  259.     return ""
  260. }
  261.  
  262.  
  263. # Creates the file with the given name in this system 
  264. # and in the VCM environment. Returns resulting object.
  265. # If this action succeeds a checked out copy is in the 
  266. # user environment.
  267. #
  268. method VSSystem::createVSFile {this name type args} {
  269.     set objectName [$this getObjectName $name $type]
  270.     set newVSFile [VSFile new $objectName $type $this]
  271.     if { $newVSFile == "" } {
  272.     return ""
  273.     }
  274.  
  275.     # promote it to a VCM specific object
  276.     $this promoteFile $newVSFile
  277.  
  278.     # if creation in the VCM system fails remove the object
  279.     if { ![$newVSFile createInVS $args] } {
  280.     # check if the file does not exist, keep the link if it does
  281.     if { ![$this fileExists $name $type] } {
  282.         $newVSFile delete
  283.         return ""
  284.     }
  285.     }
  286.  
  287.     return $newVSFile
  288. }
  289.  
  290.  
  291. # Creates an object for the file specified by name and type (precondition: it exists in the VCM)
  292. # and returns the resulting VSFile object. 
  293. #
  294. method VSSystem::importVSFile {this name type} {
  295.     set objectName [$this getObjectName $name $type]
  296.     set newVSFile [VSFile new $objectName $type $this]
  297.     if { $newVSFile == "" } {
  298.     return ""
  299.     }
  300.  
  301.     # promote it to a specific VCM object
  302.     $this promoteFile $newVSFile
  303.     return $newVSFile
  304. }
  305.  
  306.  
  307. # Searches the level where an absolute path
  308. # has been specified, if it does not exist
  309. # in wrongPathObjectList add and issue warning.
  310. #
  311. proc VSSystem::warnForAbsolutePath {} {
  312.     set clientContext [ClientContext::global]
  313.     set wrongObject ""
  314.     
  315.     set currentSystem [$clientContext currentSystem]
  316.     if { ![$currentSystem isNil] } {
  317.     set systemPathPart [$currentSystem getPropertyValue fileSystemPath]
  318.     if { [file pathtype $systemPathPart] != "relative" } {
  319.         set wrongObject $currentSystem
  320.         set description "System level"
  321.     }
  322.     }
  323.  
  324.     set currentPhase [$clientContext currentPhase]
  325.     if { ($wrongObject == "") && ![$currentPhase isNil] } {
  326.     set phasePathPart [$currentPhase getPropertyValue fileSystemPath]
  327.     if { [file pathtype $phasePathPart] != "relative" } {
  328.         set wrongObject $currentPhase
  329.         set description "Phase level"
  330.     }
  331.     }
  332.  
  333.     set currentConfig [$clientContext currentConfig]
  334.     if { ($wrongObject == "") && ![$currentConfig isNil] } {
  335.     set configPathPart [$currentConfig getPropertyValue fileSystemPath]
  336.     if { [file pathtype $configPathPart] != "relative" } {
  337.         set wrongObject $currentConfig
  338.         set description "Configuration level"
  339.     }
  340.     }
  341.  
  342.     set currentProject [$clientContext currentProject]
  343.     if { ($wrongObject == "") && ![$currentProject isNil] } {
  344.     set projectPathPart [$currentProject getPropertyValue fileSystemPath]
  345.     if { [file pathtype $projectPathPart] != "relative" } {
  346.         set wrongObject $currentProject
  347.         set description "Project level"
  348.     }
  349.     }
  350.  
  351.     if { $wrongObject == "" } {
  352.     return
  353.     }
  354.  
  355.     global VSSystem::wrongPathObjectList
  356.     if { [lsearch -exact ${VSSystem::wrongPathObjectList} $wrongObject] == -1 } {
  357.     lappend VSSystem::wrongPathObjectList $wrongObject
  358.     wmtkwarning "Specified absolute path at $description"
  359.     }
  360. }
  361.  
  362.  
  363. # Create the specified path in the VCM environment
  364. # by calling the createVSDirectory for each
  365. # path name component that does not yet
  366. # exist. This indicates the class of this system, used
  367. # to work around limitations of OO Tcl.
  368. #
  369. proc VSSystem::createVSPath {this path} {
  370.     set dirList ""
  371.     while { ![file isdirectory $path] } {
  372.     set dirList "[quoteIf [file tail $path]] $dirList"
  373.     set path [path_name directory $path]
  374.     }
  375.  
  376.     # create the directories one by one
  377.     foreach directory $dirList {
  378.     set path [path_name concat $path $directory]
  379.     if { ![$this::createVSDirectory $path] } {
  380.         return 0
  381.     }
  382.     }
  383.     return 1
  384. }
  385.  
  386.  
  387. # Create the specified path in the user environment
  388. # by calling createUserDirectory for each
  389. # path name component that does not yet exist.
  390. #
  391. proc VSSystem::createUserPath {this path} {
  392.     set dirList ""
  393.     while { ![file isdirectory $path] } {
  394.     set dirList "[quoteIf [file tail $path]] $dirList"
  395.     set path [path_name directory $path]
  396.     }
  397.  
  398.     # create the directories one by one
  399.     foreach directory $dirList {
  400.     set path [path_name concat $path $directory]
  401.     if { ![$this::createUserDirectory $path] } {
  402.         return 0
  403.     }
  404.     }
  405.     return 1
  406. }
  407.  
  408.  
  409. # Get a file object for a file in the given locations, regardless
  410. # of whether it exists.
  411. #
  412. proc VSSystem::getFileObject {userPath vsPath} {
  413.     regsub -all {\.} [file tail $userPath] "_" fileName
  414.     set objectName "VSFile:$fileName"
  415.     set name [path_name base $userPath]
  416.     set extension [path_name type $userPath]
  417.     set newVSFile [Object new $objectName]
  418.     if { $newVSFile == "" } {
  419.     return ""
  420.     }
  421.     VSFile promote $newVSFile
  422.     $newVSFile name $fileName
  423.     $newVSFile _path $userPath
  424.     $newVSFile _vsPath $vsPath
  425.  
  426.     # hacked this together for configure actions at phase level
  427.     if { [[ClientContext::global] currentLevel] == "system" } {
  428.     set system [[ClientContext::global] currentSystem]
  429.     } else {
  430.     set system [VSSystem new "System:$fileName"]
  431.     VSTypeMapper new $system
  432.     [$system typeMapper] initialize
  433.     }
  434.     $newVSFile type [[$system typeMapper] getType $name $extension]
  435.     $newVSFile systemVersion $system
  436.     return $newVSFile
  437. }
  438.  
  439. method VSSystem::getObjHandler {this} {
  440.     global fstorage::custObjHandler
  441.     set custObjHandler ${fstorage::custObjHandler}
  442.  
  443.     if { $custObjHandler == "" } {
  444.         set moduleHandler [ModuleHandler new]
  445.         set custObjHandler [CustObjHandler new $moduleHandler]
  446.         set fstorage::custObjHandler $custObjHandler
  447.         $custObjHandler setCurrentContext
  448.     }
  449.  
  450.     return $custObjHandler
  451. }
  452.  
  453.  
  454. # Returns the (file system) file name for a file with 
  455. # the given name and (browser) type.
  456. #
  457. method VSSystem::getFileName {this name type} {
  458.     set fsExtension [[$this typeMapper] getExtension $type]
  459.     if { $fsExtension == "" } {
  460.     return $name
  461.     }
  462.     return "$name.$fsExtension"
  463. }
  464.  
  465.  
  466. # Get object name for file object with given name
  467. # and type.
  468. #
  469. method VSSystem::getObjectName {this name type} {
  470.     regsub -all {\.} [$this identity] "_" sysId
  471.     if { $type == "" } {
  472.         return "${sysId}_VSFile:$name"
  473.     }
  474.     return "${sysId}_VSFile:${name}_$type"
  475. }
  476.  
  477.  
  478. # Maps an object id of a VSFile to a filename.
  479. #
  480. method VSSystem::objectToFileName {this objectId type} {
  481.     regsub {.*_VSFile:} $objectId "" fileSpec
  482.  
  483.     # hack for types with _ such as sql_script
  484.     if [regexp _ $type] {
  485.     regsub "$type" $fileSpec "" fileName
  486.     } else {
  487.     set fileName $fileSpec
  488.     }
  489.     regsub {_[^_]*$} $fileName "" name
  490.     return $name
  491. }
  492.  
  493.  
  494. # Returns ObjectTeam type for file with given
  495. # name and file system extension.
  496. #
  497. method VSSystem::getType {this name extension {path ""}} {
  498.     return [[$this typeMapper] getType $name $extension $path]
  499. }
  500.  
  501.  
  502. # Gets the object specification for the specified browserType.
  503. #
  504. method VSSystem::getTypeSpec {this browserType} {
  505.     set typeSpec [[$this getObjHandler] getObjectSpec ExternalFileVersion \
  506.             $browserType]
  507.  
  508.     if { $typeSpec == "" } {
  509.         vsCommandHandler error "Unknown object type '$browserType'"
  510.     }
  511.  
  512.     return $typeSpec
  513. }
  514.  
  515. # Do not delete this line -- regeneration end marker
  516.  
  517. method VSSystem::typeMapper {this args} {
  518.     if {$args == ""} {
  519.         return [$this _typeMapper]
  520.     }
  521.     set ref [$this _typeMapper]
  522.     if {$ref != ""} {
  523.         $ref _system ""
  524.     }
  525.     set obj [lindex $args 0]
  526.     if {$obj != ""} {
  527.         $obj _system $this
  528.     }
  529.     $this _typeMapper $obj
  530. }
  531.  
  532.  
  533.