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 >
Text File  |  1997-06-06  |  10KB  |  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. proc fstorage::open {fileSpec {mode r} {fileClass externalText}} {
  185.     global fstoragePathCache
  186.     global fstorageObjectCache
  187.  
  188.     set vsSystem [fstorage::currentSystem]
  189.  
  190.     if [$vsSystem isNil] {
  191.     return 0
  192.     }
  193.  
  194.     set fileName [nt_get_name $fileSpec]
  195.     set fileType [nt_get_type $fileSpec]
  196.     set vsFile [$vsSystem findVSFile $fileName $fileType]
  197.  
  198.     case $mode {
  199.     r {
  200.         if { $vsFile == "" } {
  201.         # file does not exist in the repository but may exist
  202.         # in VCM system. Do an import in the latter case
  203.         if [$vsSystem fileExists $fileName $fileType] {
  204.             set vsFile [$vsSystem importVSFile $fileName $fileType]
  205.         }
  206.         if { $vsFile == "" } {
  207.             error "Unable to open file '$fileSpec' for read"
  208.             return ""
  209.         }
  210.         }
  211.  
  212.         set filePath [$vsFile getReference]
  213.         set handle [open $filePath r]
  214.         set fstorageObjectCache($handle) $vsFile
  215.         set fstoragePathCache($handle) $filePath
  216.  
  217.         return $handle
  218.     }
  219.     w {
  220.         # Create file if it does not exist
  221.         if { $vsFile == "" } {
  222.         if [$vsSystem fileExists $fileName $fileType] {
  223.             set vsFile [$vsSystem importVSFile $fileName $fileType]
  224.         } else {
  225.             set comment "Created by ObjectTeam"
  226.             set vsFile [$vsSystem createVSFile \
  227.                 $fileName $fileType "$comment"]
  228.         }
  229.         }
  230.  
  231.         if { $vsFile == "" } {
  232.         error "Creation of '$fileSpec' failed"
  233.         return ""
  234.         }
  235.  
  236.         global fstorage::cacheValid
  237.         set fstorage::cacheValid 0
  238.  
  239.         # try to check it out if it is not writable
  240.         set filePath [$vsFile path]
  241.         if { ![$vsFile isCheckedOut] } {
  242.         if {![file writable $filePath]} {
  243.             set comment "Checked out by ObjectTeam"
  244.             if {![$vsFile checkOut $comment]} {
  245.             error "Cannot obtain writable copy of '$fileSpec'"
  246.             }
  247.         } else {
  248.             # there is a writable copy but the file is not checked
  249.             # out: dangerous; let user do something about it
  250.             error "Cannot check out '$fileSpec': a writable copy exists in the user environment"
  251.         }
  252.         }
  253.  
  254.         # we have a writable copy: finish work
  255.         set handle [open $filePath w]
  256.         if { $handle == "" } {
  257.         error "Open file '$fileSpec' for write failed"
  258.         return ""
  259.         }
  260.         set fstorageObjectCache($handle) $vsFile
  261.         return $handle
  262.     }
  263.     default {
  264.         error "Invalid option '$mode' for fstorage::open"
  265.     }
  266.     }
  267. }
  268.  
  269. # Close $handle
  270. #
  271. proc fstorage::close {handle} {
  272.     global fstoragePathCache
  273.     global fstorageObjectCache
  274.  
  275.     if [info exists fstorageObjectCache($handle)] {
  276.     set vsFile $fstorageObjectCache($handle)
  277.     unset fstorageObjectCache($handle)
  278.     if [info exists fstoragePathCache($handle)] {
  279.         $vsFile deleteReference $fstoragePathCache($handle)
  280.         unset fstoragePathCache($handle)
  281.     }
  282.     } else {
  283.         puts "Warning fstorage::close called for unknown handle"
  284.     }
  285.  
  286.     close $handle
  287. }
  288.  
  289. # Return the path of $fileSpec in the "user environment"
  290. # if $is_absolute == absolute the path is absolute, else relative
  291. #
  292. proc fstorage::get_uenv_path {fileSpec {absolute relative}} {
  293.     set fileName [nt_get_name $fileSpec]
  294.     set fileType [nt_get_type $fileSpec]
  295.     set vsSystem [fstorage::currentSystem]
  296.     if [$vsSystem isNil] {
  297.     return ""
  298.     }
  299.  
  300.     set filePath [$vsSystem vsFileUserPath $fileName $fileType]
  301.  
  302.     if {$absolute == "absolute"} {
  303.     return $filePath
  304.     }
  305.  
  306.     # make relative path: strip path to system
  307.     set systemPath [$vsSystem path]
  308.     set relativeIndex [expr [string length $systemPath] +1]
  309.     return [string range $filePath $relativeIndex end]
  310. }
  311.  
  312. # Goto "system" $sys in phase $phase
  313. #
  314. proc fstorage::goto_system {sys {phase ""}} {
  315.     set clientCont [ClientContext::global]
  316.     set currentLevel [$clientCont currentLevel]
  317.     if { $currentLevel == "Project" ||  $currentLevel == "Corporate" } {
  318.         puts "invalid level: $currentLevel"
  319.         return
  320.     }
  321.  
  322.     set oldLevelPath [m4_var get M4_levelpath]
  323.     while { [$clientCont currentLevel] != "Phase" } {
  324.         $clientCont upLevel
  325.     }
  326.  
  327.     if {$phase != "" } {
  328.         $clientCont upLevel
  329.         if [catch {$clientCont downLevel $phase} msg] {
  330.         #puts $msg
  331.         $clientCont setLevelPath $oldLevelPath
  332.         return
  333.         }
  334.     }
  335.  
  336.     if [catch {$clientCont downLevel $sys} msg]  {
  337.         #puts $msg
  338.         $clientCont setLevelPath $oldLevelPath
  339.         return
  340.     }
  341. }
  342.  
  343. # Return the "Imported From" attribute from $obj
  344. #
  345. proc fstorage::get_imp_from {fileSpec} {
  346.     set vsFile [fstorage::getVSFile [path_name file $fileSpec]]
  347.  
  348.     if { $vsFile == "" } {
  349.     return ""
  350.     }
  351.  
  352.     return [$vsFile getClass]
  353. }
  354.  
  355. # Set the "Imported From" attribute of $obj to $value
  356. #
  357. proc fstorage::set_imp_from {fileSpec value} {
  358.     set vsFile [fstorage::getVSFile [path_name file $fileSpec]]
  359.  
  360.     if { $vsFile == "" } {
  361.     error "Unable to set property for '$fileSpec': it is not a file within this system"
  362.     }
  363.  
  364.     return [$vsFile setClass $value]
  365. }
  366.  
  367. # return path of object in user environment
  368. #
  369. proc fstorage::get_uenv_object_path {object} {
  370.     global VSSystem
  371.     return [$VSSystem::vsObjectUserPath $object]
  372. }
  373.  
  374. # Remove '$fullName' from VCM system
  375. #
  376. proc fstorage::remove {fullName} {
  377.     set vsFile [fstorage::getVSFile $fullName]
  378.  
  379.     if { $vsFile == "" } {
  380.     error "Unable remove '$fullName': it is not a file within this system"
  381.     }
  382.  
  383.     $vsFile removeFromVS
  384.     global fstorage::cacheValid
  385.     set fstorage::cacheValid 0
  386. }
  387.  
  388. # Do not delete this line -- regeneration end marker
  389.