home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / vsfstorage.tcl < prev    next >
Encoding:
Text File  |  1997-06-06  |  10.0 KB  |  390 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1993-1997 by Cayenne Software Inc.
  4. #
  5. # This software is furnished under a license and may be used only in
  6. # accordance with the terms of such license and with the inclusion of
  7. # the above copyright notice. This software or any other copies thereof
  8. # may not be provided or otherwise made available to any other person.
  9. # No title to and ownership of the software is hereby transferred.
  10. #
  11. # The information in this software is subject to change without notice
  12. # and should not be construed as a commitment by Cayenne Software Inc.
  13. #
  14. #---------------------------------------------------------------------------
  15. #
  16. #    File        : @(#)vsfstorage.tcl    /main/hindenburg/8
  17. #    Author        : frmo, Lex Warners
  18. #    Original date    : 23-2-1994
  19. #    Description    : File storage functions. The functions in this file
  20. #                         define the interface to the VCM system used to
  21. #                         store the files.
  22. #---------------------------------------------------------------------------
  23. #
  24.  
  25. # Start user added include file section
  26. global fstorage::custObjHandler
  27. set fstorage::custObjHandler ""
  28. require caynutil.tcl
  29. require s_otsh.tcl
  30.  
  31. global fstorage::vsFiles
  32. set fstorage::vsFiles ""
  33.  
  34. global fstorage::cacheValid
  35. set fstorage::cacheValid 0
  36. # End user added include file section
  37.  
  38. Class fstorage : {GCObject} {
  39.         constructor
  40.         method destructor
  41. }
  42.  
  43. constructor fstorage {class this} {
  44.         set this [GCObject::constructor $class $this]
  45.         # Start constructor user section
  46.         # End constructor user section
  47.         return $this
  48. }
  49.  
  50. method fstorage::destructor {this} {
  51.         # Start destructor user section
  52.         # End destructor user section
  53. }
  54.  
  55.  
  56. # internal proc that returns current system
  57. # issues error if not a system level
  58. #
  59. proc fstorage::currentSystem {} {
  60.     set clientContext [ClientContext::global]
  61.     set vsSystem [$clientContext currentSystem]
  62.  
  63.     if [$vsSystem isNil] {
  64.     error "Not at system level"
  65.     }
  66.  
  67.     return $vsSystem
  68. }
  69.  
  70. # Return a list of objects that have a type that is listed in $fileTypes
  71. # $fileTypes == {} means all file types
  72. #
  73. proc fstorage::dir {{fileTypes ""}} {
  74.     set vsSystem [fstorage::currentSystem]
  75.     
  76.     if [$vsSystem isNil] {
  77.     return
  78.     }
  79.    
  80.     global fstorage::cacheValid
  81.     global fstorage::vsFiles
  82.  
  83.     if ${fstorage::cacheValid} {
  84.     set vsFiles ${fstorage::vsFiles}
  85.     } else {
  86.     set vsFiles [$vsSystem vsFiles]
  87.         set fstorage::vsFiles $vsFiles
  88.         set fstorage::cacheValid 1
  89.     }
  90.  
  91.     set fileList ""
  92.     
  93.     foreach vsFile $vsFiles {
  94.     set fileName [$vsFile name]
  95.     set fileType [$vsFile type]
  96.     set fullName ${fileName}.${fileType}
  97.  
  98.     if {$fileTypes == ""} {
  99.         lappend fileList $fullName
  100.     } else {
  101.         foreach type $fileTypes {
  102.         if {$fileType == $type} {
  103.             lappend fileList $fullName
  104.             break;
  105.         }
  106.         }
  107.     }
  108.     }
  109.  
  110.     return $fileList
  111. }
  112.  
  113. proc fstorage::getVSFile {fileSpec} {
  114.     set vsSystem [fstorage::currentSystem]
  115.     if [$vsSystem isNil] {
  116.     return ""
  117.     }
  118.  
  119.     set fileName [nt_get_name $fileSpec]
  120.     set fileType [nt_get_type $fileSpec]
  121.  
  122.     set vsFile [$vsSystem findVSFile $fileName $fileType]
  123.     if { $vsFile == "" } {
  124.     # create VSFile object for this file
  125.     if [$vsSystem fileExists $fileName $fileType] {
  126.         set vsFile [$vsSystem importVSFile $fileName $fileType]
  127.     }
  128.     }
  129.  
  130.     return $vsFile
  131. }
  132.  
  133. # Return whether the file with the given file specification exists in the 
  134. # VCM system. file specification is in the form "name.type" where type
  135. # is a browser type.
  136.  
  137. proc fstorage::exists {fileSpec} {
  138.     set vsSystem [fstorage::currentSystem]
  139.     if [$vsSystem isNil] {
  140.     return 0
  141.     }
  142.  
  143.     set name [nt_get_name $fileSpec]
  144.     set type [nt_get_type $fileSpec]
  145.  
  146.     return [$vsSystem fileExists $name $type]
  147. }
  148.  
  149. proc fstorage::getMakeType {objType} {
  150.     return [[fstorage::getObjectSpec $objType] makeType]
  151. }
  152.  
  153. proc fstorage::getFsExtension {objType} {
  154.     set extension [[fstorage::getObjectSpec $objType] fsExtension]
  155.  
  156.     #
  157.     # Hack for persistent classes with target Gen
  158.     #
  159.  
  160.     if {$extension == "" && $objType == "esqlc++"} {
  161.         return [[fstorage::getObjectSpec c++] fsExtension]
  162.     }
  163.  
  164.     return $extension
  165. }
  166.  
  167. proc fstorage::getObjectSpec {objType} {
  168.     set vsSystem [fstorage::currentSystem]
  169.     if [$vsSystem isNil] {
  170.     return
  171.     }
  172.  
  173.     return [$vsSystem getTypeSpec $objType]
  174. }
  175.  
  176. proc fstorage::isAscii {objType} {
  177.     return [[fstorage::getObjectSpec $objType] isAscii]
  178. }
  179.  
  180. #
  181. # Open $obj for $mode. Mode is one of "r" and "w"
  182. # If $mode == w the object is created if it doesn't exist
  183. # 
  184.  
  185. proc fstorage::open {fileSpec {mode r} {fileClass externalText}} {
  186.     global fstoragePathCache
  187.     global fstorageObjectCache
  188.  
  189.     set vsSystem [fstorage::currentSystem]
  190.  
  191.     if [$vsSystem isNil] {
  192.     return 0
  193.     }
  194.  
  195.     set fileName [nt_get_name $fileSpec]
  196.     set fileType [nt_get_type $fileSpec]
  197.     set vsFile [$vsSystem findVSFile $fileName $fileType]
  198.  
  199.     case $mode {
  200.     r {
  201.         if { $vsFile == "" } {
  202.         # file does not exist in the repository but may exist
  203.         # in VCM system. Do an import in the latter case
  204.         if [$vsSystem fileExists $fileName $fileType] {
  205.             set vsFile [$vsSystem importVSFile $fileName $fileType]
  206.         }
  207.         if { $vsFile == "" } {
  208.             error "Unable to open file '$fileSpec' for read"
  209.             return ""
  210.         }
  211.         }
  212.  
  213.         set filePath [$vsFile getReference]
  214.         set handle [open $filePath r]
  215.         set fstorageObjectCache($handle) $vsFile
  216.         set fstoragePathCache($handle) $filePath
  217.  
  218.         return $handle
  219.     }
  220.     w {
  221.         # Create file if it does not exist
  222.         if { $vsFile == "" } {
  223.         if [$vsSystem fileExists $fileName $fileType] {
  224.             set vsFile [$vsSystem importVSFile $fileName $fileType]
  225.         } else {
  226.             set comment "Created by ObjectTeam"
  227.             set vsFile [$vsSystem createVSFile \
  228.                 $fileName $fileType "$comment"]
  229.         }
  230.         }
  231.  
  232.         if { $vsFile == "" } {
  233.         error "Creation of '$fileSpec' failed"
  234.         return ""
  235.         }
  236.  
  237.         global fstorage::cacheValid
  238.         set fstorage::cacheValid 0
  239.  
  240.         # try to check it out if it is not writable
  241.         set filePath [$vsFile path]
  242.         if { ![$vsFile isCheckedOut] } {
  243.         if {![file writable $filePath]} {
  244.             set comment "Checked out by ObjectTeam"
  245.             if {![$vsFile checkOut $comment]} {
  246.             error "Cannot obtain writable copy of '$fileSpec'"
  247.             }
  248.         } else {
  249.             # there is a writable copy but the file is not checked
  250.             # out: dangerous; let user do something about it
  251.             error "Cannot check out '$fileSpec': a writable copy exists in the user environment"
  252.         }
  253.         }
  254.  
  255.         # we have a writable copy: finish work
  256.         set handle [open $filePath w]
  257.         if { $handle == "" } {
  258.         error "Open file '$fileSpec' for write failed"
  259.         return ""
  260.         }
  261.         set fstorageObjectCache($handle) $vsFile
  262.         return $handle
  263.     }
  264.     default {
  265.         error "Invalid option '$mode' for fstorage::open"
  266.     }
  267.     }
  268. }
  269.  
  270. # Close $handle
  271. #
  272. proc fstorage::close {handle} {
  273.     global fstoragePathCache
  274.     global fstorageObjectCache
  275.  
  276.     if [info exists fstorageObjectCache($handle)] {
  277.     set vsFile $fstorageObjectCache($handle)
  278.     unset fstorageObjectCache($handle)
  279.     if [info exists fstoragePathCache($handle)] {
  280.         $vsFile deleteReference $fstoragePathCache($handle)
  281.         unset fstoragePathCache($handle)
  282.     }
  283.     } else {
  284.         puts "Warning fstorage::close called for unknown handle"
  285.     }
  286.  
  287.     close $handle
  288. }
  289.  
  290. # Return the path of $fileSpec in the "user environment"
  291. # if $is_absolute == absolute the path is absolute, else relative
  292. #
  293. proc fstorage::get_uenv_path {fileSpec {absolute relative}} {
  294.     set fileName [nt_get_name $fileSpec]
  295.     set fileType [nt_get_type $fileSpec]
  296.     set vsSystem [fstorage::currentSystem]
  297.     if [$vsSystem isNil] {
  298.     return ""
  299.     }
  300.  
  301.     set filePath [$vsSystem vsFileUserPath $fileName $fileType]
  302.  
  303.     if {$absolute == "absolute"} {
  304.     return $filePath
  305.     }
  306.  
  307.     # make relative path: strip path to system
  308.     set systemPath [$vsSystem path]
  309.     set relativeIndex [expr [string length $systemPath] +1]
  310.     return [string range $filePath $relativeIndex end]
  311. }
  312.  
  313. # Goto "system" $sys in phase $phase
  314. #
  315. proc fstorage::goto_system {sys {phase ""}} {
  316.     set clientCont [ClientContext::global]
  317.     set currentLevel [$clientCont currentLevel]
  318.     if { $currentLevel == "Project" ||  $currentLevel == "Corporate" } {
  319.         puts "invalid level: $currentLevel"
  320.         return
  321.     }
  322.  
  323.     set oldLevelPath [m4_var get M4_levelpath]
  324.     while { [$clientCont currentLevel] != "Phase" } {
  325.         $clientCont upLevel
  326.     }
  327.  
  328.     if {$phase != "" } {
  329.         $clientCont upLevel
  330.         if [catch {$clientCont downLevel $phase} msg] {
  331.         #puts $msg
  332.         $clientCont setLevelPath $oldLevelPath
  333.         return
  334.         }
  335.     }
  336.  
  337.     if [catch {$clientCont downLevel $sys} msg]  {
  338.         #puts $msg
  339.         $clientCont setLevelPath $oldLevelPath
  340.         return
  341.     }
  342. }
  343.  
  344. # Return the "Imported From" attribute from $obj
  345. #
  346. proc fstorage::get_imp_from {fileSpec} {
  347.     set vsFile [fstorage::getVSFile [path_name file $fileSpec]]
  348.  
  349.     if { $vsFile == "" } {
  350.     return ""
  351.     }
  352.  
  353.     return [$vsFile getClass]
  354. }
  355.  
  356. # Set the "Imported From" attribute of $obj to $value
  357. #
  358. proc fstorage::set_imp_from {fileSpec value} {
  359.     set vsFile [fstorage::getVSFile [path_name file $fileSpec]]
  360.  
  361.     if { $vsFile == "" } {
  362.     error "Unable to set property for '$fileSpec': it is not a file within this system"
  363.     }
  364.  
  365.     return [$vsFile setClass $value]
  366. }
  367.  
  368. # return path of object in user environment
  369. #
  370. proc fstorage::get_uenv_object_path {object} {
  371.     global VSSystem
  372.     return [$VSSystem::vsObjectUserPath $object]
  373. }
  374.  
  375. # Remove '$fullName' from VCM system
  376. #
  377. proc fstorage::remove {fullName} {
  378.     set vsFile [fstorage::getVSFile $fullName]
  379.  
  380.     if { $vsFile == "" } {
  381.     error "Unable remove '$fullName': it is not a file within this system"
  382.     }
  383.  
  384.     $vsFile removeFromVS
  385.     global fstorage::cacheValid
  386.     set fstorage::cacheValid 0
  387. }
  388.  
  389. # Do not delete this line -- regeneration end marker
  390.