home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # (c) Cayenne Software Inc. 1997
- #
- # File: @(#)vssystem.tcl /main/hindenburg/8
- # Author: <generated>
- # Description:
- #---------------------------------------------------------------------------
- # SccsId = @(#)vssystem.tcl /main/hindenburg/8 6 Jun 1997 Copyright 1997 Cayenne Software Inc.
-
- # Start user added include file section
- # End user added include file section
-
-
- # This class represents a VCM aware system.
-
- Class VSSystem : {Object} {
- constructor
- method destructor
- method vsFiles
- method path
- method getPathList
- method updatePath
- method localFileVersions
- method copy
- method findVSFile
- method createVSFile
- method importVSFile
- method getFileName
- method getObjectName
- method objectToFileName
- method getType
- method getTypeSpec
- method typeMapper
-
- # Cache for path name of this system in user
- # environment.
- #
- attribute _path
-
- attribute _OTPath
-
- # Path list for this system.
- #
- attribute _pathList
- attribute _typeMapper
- }
-
- constructor VSSystem {class this name} {
- set this [Object::constructor $class $this $name]
- # Start constructor user section
- # End constructor user section
- return $this
- }
-
- method VSSystem::destructor {this} {
- set ref [$this _typeMapper]
- if {$ref != ""} {
- $ref _system ""
- }
- # Start destructor user section
- # End destructor user section
- }
-
-
- # Returns all the vsFiles in this system, using
- # VCM specific list mechanisms implemented in fileList.
- # For each file found a VSFile is created and the result
- # is a list containing all these objects.
- #
- method VSSystem::vsFiles {this} {
- set vsFileList {}
-
- # find VS files and return them
- foreach fileName [$this fileList [$this getPathList]] {
- set name [path_name base $fileName]
- set type [$this getType $name [path_name type $fileName]]
- set objectName [$this getObjectName $name $type]
- if { ![isCommand $objectName] } {
- set vsFile [VSFile new $objectName $type $this]
- $this promoteFile $vsFile
- }
- # only show files of known type
- if { [$objectName type] != "" } {
- lappend vsFileList $objectName
- }
- }
- return $vsFileList
- }
-
-
- # Redefinition of default path method that uses
- # vsObjectUserPath.
- #
- method VSSystem::path {this} {
- set needUpdate 0
- if { [$this _path] == "" } {
- set needUpdate 1
- } else {
- # check if cached path is still valid by checking OTpath
- if { [$this _OTPath] != [$this SystemVersion::path] } {
- set needUpdate 1
- }
- }
-
- if $needUpdate {
- $this _path [$this vsUserPath]
- $this _OTPath [$this SystemVersion::path]
- }
-
- return [$this _path]
- }
-
-
- # Returns list of paths where files of this system are stored.
- #
- method VSSystem::getPathList {this} {
- set needUpdate 0
- if { [$this _pathList] == "" } {
- set needUpdate 1
- } else {
- # check if cached path is still valid by checking OTpath
- if { [$this _OTPath] != [$this SystemVersion::path] } {
- set needUpdate 1
- }
- }
-
- if $needUpdate {
- $this updatePath
- $this _OTPath [$this SystemVersion::path]
- set pathList {}
- foreach type [[$this typeMapper] typeList] {
- set filePath [path_name directory [$this vsFileUserPath dummy $type]]
- # check existence of path. This cannot be done with lsearch
- # because it does not work well with windows pathnames
- set existsInList 0
- foreach path $pathList {
- if { [file_split $path] == [file_split $filePath] } {
- set existsInList 1
- }
- }
- if !$existsInList {
- lappend pathList $filePath
- }
- }
- $this _pathList $pathList
- }
-
- return [$this _pathList]
- }
-
-
- # Forces system to update its path (stored in _path).
- #
- method VSSystem::updatePath {this} {
- $this _path ""
- $this _pathList ""
- }
-
-
- # Return localFileVersions of a VCM aware system.
- #
- method VSSystem::localFileVersions {this} {
- return ""
- }
-
-
- # Perform copy of VSFile to this system.
- # Needed for Edit and drag'n drop operations.
- #
- method VSSystem::copy {this vsFile} {
- # make new object
- set type [$vsFile type]
- set objectName [$this getObjectName [$vsFile name] $type]
- set newVSFile [VSFile new $objectName $type $this]
-
- # check if copy succeeded
- if { $newVSFile == "" } {
- return ""
- }
-
- $this promoteFile $newVSFile
-
- # if creation in the VCM system fails remove the object
- if { ![$this fileExists [$vsFile name] $type] } {
- set comment "Copied from [$vsFile vsPath]"
- if { ![$newVSFile createInVS [list "$comment"]] } {
- # check if it really was not created
- if { ![$this fileExists [$vsFile name] $type] } {
- $newVSFile delete
- return ""
- }
- }
- } else {
- wmtkinfo "File [$vsFile vsPath] already exists"
- return ""
- }
-
- # check out if necessary
- set userPath [$newVSFile path]
- if { ![$newVSFile isCheckedOut] } {
- set comment "Copied from [$vsFile vsPath]"
- if { ![$newVSFile checkOut $comment] } {
- return ""
- }
- }
-
- # get reference to old file and perform the copy
- set source [$vsFile getReference]
- if [catch { BasicFS::copyFile $source $userPath } message] {
- vsCommandHandler error "Copying [$vsFile path]: $message"
- }
- $vsFile deleteReference $source
-
- # copy class attribute
- $newVSFile setClass [$vsFile getClass]
- return $newVSFile
- }
-
-
- # Find the object for the VSFile with the given name
- # and return it.
- #
- method VSSystem::findVSFile {this name type} {
- set object [$this getObjectName $name $type]
- if [isCommand $object] {
- return $object
- }
- return ""
- }
-
-
- # Creates the file with the given name in this system
- # and in the VCM environment. Returns resulting object.
- # If this action succeeds a checked out copy is in the
- # user environment.
- #
- method VSSystem::createVSFile {this name type args} {
- set objectName [$this getObjectName $name $type]
- set newVSFile [VSFile new $objectName $type $this]
- if { $newVSFile == "" } {
- return ""
- }
-
- # promote it to a specific VCM object
- $this promoteFile $newVSFile
-
- # if creation in the VCM system fails remove the object
- if { ![$newVSFile createInVS $args] } {
- # check if the file does not exist, keep the link if it does
- if { ![$this fileExists $name $type] } {
- $newVSFile delete
- return ""
- }
- }
-
- return $newVSFile
- }
-
-
- # Creates an object for the file specified by name and type (precondition: it exists in the VCM)
- # and returns the resulting VSFile object.
- #
- method VSSystem::importVSFile {this name type} {
- set objectName [$this getObjectName $name $type]
- set newVSFile [VSFile new $objectName $type $this]
- if { $newVSFile == "" } {
- return ""
- }
-
- # promote it to a specific VCM object
- $this promoteFile $newVSFile
- return $newVSFile
- }
-
-
- # Create the specified path in the VCM environment
- # by calling the createVSDirectory for each
- # path name component that does not yet
- # exist. This indicates the class of this system, used
- # to work around limitations of OO Tcl.
- #
- proc VSSystem::createVSPath {this path} {
- set dirList ""
- while { ![file isdirectory $path] } {
- set dirList "[quoteIf [path_name file $path]] $dirList"
- set path [path_name directory $path]
- }
-
- # create the directories one by one
- foreach directory $dirList {
- set path [path_name concat $path $directory]
- if { ![$this::createVSDirectory $path] } {
- return 0
- }
- }
- return 1
- }
-
-
- # Create the specified path in the user environment
- # by calling createUserDirectory for each
- # path name component that does not yet exist.
- #
- proc VSSystem::createUserPath {this path} {
- set dirList ""
- while { ![file isdirectory $path] } {
- set dirList "[quoteIf [path_name file $path]] $dirList"
- set path [path_name directory $path]
- }
-
- # create the directories one by one
- foreach directory $dirList {
- set path [path_name concat $path $directory]
- if { ![$this::createUserDirectory $path] } {
- return 0
- }
- }
- return 1
- }
-
-
- # Returns the (file system) file name for a file with
- # the given name and (browser) type.
- #
- method VSSystem::getFileName {this name type} {
- set fsExtension [[$this typeMapper] getExtension $type]
- if { $fsExtension == "" } {
- return $name
- }
- return "$name.$fsExtension"
- }
-
-
- # Get object name for file object with given name
- # and type.
- #
- method VSSystem::getObjectName {this name type} {
- regsub -all {\.} [$this identity] "_" sysId
- if { $type == "" } {
- return "${sysId}_VSFile:$name"
- }
- return "${sysId}_VSFile:${name}_$type"
- }
-
-
- # Maps an object id of a VSFile to a filename.
- #
- method VSSystem::objectToFileName {this objectId} {
- regsub {.*_VSFile:} $objectId "" fileSpec
- regsub {_[^_]*} $fileSpec "" name
- return $name
- }
-
-
- # Returns ObjectTeam type for file with given
- # name and file system extension.
- #
- method VSSystem::getType {this name extension} {
- return [[$this typeMapper] getType $name $extension]
- }
-
-
- # Gets the object specification for the specified browserType.
- #
- method VSSystem::getTypeSpec {this browserType} {
- set typeSpec [[$this getObjHandler] getObjectSpec ExternalFileVersion \
- $browserType]
-
- if { $typeSpec == "" } {
- vsCommandHandler error "Unknown object type '$browserType'"
- }
-
- return $typeSpec
- }
-
- # Do not delete this line -- regeneration end marker
-
- method VSSystem::typeMapper {this args} {
- if {$args == ""} {
- return [$this _typeMapper]
- }
- set ref [$this _typeMapper]
- if {$ref != ""} {
- $ref _system ""
- }
- set obj [lindex $args 0]
- if {$obj != ""} {
- $obj _system $this
- }
- $this _typeMapper $obj
- }
-
-