home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / fstorage.tcl < prev    next >
Encoding:
Text File  |  1997-05-26  |  7.7 KB  |  345 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)fstorage.tcl    /main/hindenburg/5
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)fstorage.tcl    /main/hindenburg/5   26 May 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12.  
  13. require caynutil.tcl
  14.  
  15. # End user added include file section
  16.  
  17.  
  18. Class fstorage : {GCObject} {
  19.     constructor
  20.     method destructor
  21. }
  22.  
  23. global fstorage::custObjHandler
  24. set fstorage::custObjHandler ""
  25.  
  26.  
  27. constructor fstorage {class this} {
  28.     set this [GCObject::constructor $class $this]
  29.     # Start constructor user section
  30.     # End constructor user section
  31.     return $this
  32. }
  33.  
  34. method fstorage::destructor {this} {
  35.     # Start destructor user section
  36.     # End destructor user section
  37. }
  38.  
  39.  
  40. # Return a list of objects that have a type that is listed in $fileTypes
  41. # $fileTypes == {} means all file types
  42. #
  43. proc fstorage::dir {{fileTypes ""}} {
  44.     set cc [ClientContext::global]
  45.     set systemV [$cc currentSystem]
  46.  
  47.     if {[$systemV isNil]} {
  48.         error "Unable to find files: not at system level"
  49.     }
  50.  
  51.     set fileList ""
  52.  
  53.     foreach fileV [$systemV localFileVersions] {
  54.         set fileName [[$fileV file] name]
  55.         set fileType [[$fileV file] type]
  56.         set fullName ${fileName}.${fileType}
  57.  
  58.         if {$fileTypes == ""} {
  59.         lappend fileList $fullName
  60.         } else {
  61.         foreach type $fileTypes {
  62.             if {$fileType == $type} {
  63.             lappend fileList $fullName
  64.             break;
  65.             }
  66.         }
  67.         }
  68.     }
  69.  
  70.     return $fileList
  71. }
  72.  
  73.  
  74. # Return repository object for specified file
  75. #
  76. proc fstorage::getFileVersion {fullName} {
  77.     set cc [ClientContext::global]
  78.     set systemV [$cc currentSystem]
  79.  
  80.     if {[$systemV isNil]} {
  81.         error "Unable to find file '$fullName': not at system level"
  82.     }
  83.  
  84.     set fileName [nt_get_name $fullName]
  85.     set fileType [nt_get_type $fullName]
  86.  
  87.     return [$systemV findFileVersion $fileName $fileType]
  88. }
  89.  
  90.  
  91. # Test if $fullName exists
  92. #
  93. proc fstorage::exists {fullName} {
  94.     set fileV [fstorage::getFileVersion $fullName]
  95.  
  96.     if {[$fileV isNil]} {
  97.         return 0
  98.     }
  99.  
  100.     return 1;
  101. }
  102.  
  103. proc fstorage::getMakeType {objType} {
  104.     return [[fstorage::getObjectSpec $objType] makeType]
  105. }
  106.  
  107. proc fstorage::getFsExtension {objType} {
  108.     set extension [[fstorage::getObjectSpec $objType] fsExtension]
  109.  
  110.     #
  111.     # Hack for persistent classes with target Gen
  112.     #
  113.  
  114.     if {$extension == "" && $objType == "esqlc++"} {
  115.         return [[fstorage::getObjectSpec c++] fsExtension]
  116.     }
  117.  
  118.     return $extension
  119. }
  120.  
  121. proc fstorage::getObjectSpec {objType} {
  122.     global fstorage::custObjHandler
  123.     set custObjHandler ${fstorage::custObjHandler}
  124.  
  125.     if {$custObjHandler == ""} {
  126.         set custObjHandler [CustObjHandler new]
  127.         set fstorage::custObjHandler $custObjHandler
  128.         $custObjHandler setCurrentContext
  129.     }
  130.  
  131.     set objSpec [$custObjHandler getObjectSpec ExternalFileVersion $objType]
  132.  
  133.     if {$objSpec == ""} {
  134.         error "Unknown objecttype '$objType'"
  135.     }
  136.  
  137.     return $objSpec
  138. }
  139.  
  140. proc fstorage::isAscii {objType} {
  141.     return [[fstorage::getObjectSpec $objType] isAscii]
  142. }
  143.  
  144.  
  145. # Open $fullName for $mode. Mode is one of "r" and "w".
  146. # If $mode == w the object is created if it doesn't exist.
  147. #
  148. proc fstorage::open {fullName {mode "r"} {fileClass "externalText"}} {
  149.     global fstorageCache
  150.     set cc [ClientContext::global]
  151.     set systemV [$cc currentSystem]
  152.  
  153.     if {[$systemV isNil]} {
  154.         return 0
  155.     }
  156.  
  157.     set fileV [fstorage::getFileVersion $fullName]
  158.  
  159.     case $mode {
  160.         r {
  161.         if {[$fileV isNil]} {
  162.             error "Unable to open file '$fullName' for read"
  163.         }
  164.  
  165.         $fileV lockForRead "Locked by fstorage::open"
  166.  
  167.         if {[$fileV status] == "working"} {
  168.             set handle [open [$fileV path] r]
  169.             set fstorageCache($handle) $fileV
  170.             return $handle
  171.         }
  172.  
  173.         $fileV synchWithFileSystem
  174.  
  175.         set handle [open [$fileV path] r]
  176.         set fstorageCache($handle) $fileV
  177.  
  178.         return $handle
  179.         }
  180.         w {
  181.         set configV [$cc currentConfig]
  182.  
  183.         if {[$fileV isNil]} {
  184.             set fileName [nt_get_name $fullName]
  185.             set fileType [nt_get_type $fullName]
  186.             set fileV [$systemV createFileVersion $fileName cl 0 $fileType $fileClass $configV]
  187.             $fileV lockForWrite "Locked by fstorage::open"
  188.  
  189.             set fileExt [fstorage::getFsExtension $fileType]
  190.  
  191.             if {$fileExt == ""} {
  192.             $fileV setProperty fileSystemPath $fileName
  193.             } else {
  194.             $fileV setProperty fileSystemPath $fileName.$fileExt
  195.             }
  196.  
  197.             $fileV synchWithFileSystem
  198.             set handle [open [$fileV path] w]
  199.             set fstorageCache($handle) $fileV
  200.  
  201.             return $handle
  202.         }
  203.  
  204.         if {[$fileV status] == "working"} {
  205.             $fileV lockForWrite "Locked by fstorage::open"
  206.             set handle [open [$fileV path] w]
  207.             set fstorageCache($handle) $fileV
  208.  
  209.             return $handle
  210.         }
  211.  
  212.         set newFileV [$systemV derive -fileVersion $fileV $configV]
  213.         $newFileV lockForWrite "Locked by fstorage::open"
  214.         set handle [open [$newFileV path] w]
  215.         set fstorageCache($handle) $newFileV
  216.         $newFileV synchWithFileSystem
  217.  
  218.         return $handle
  219.         }
  220.         default {
  221.         error "Invalid option '$mode' for fstorage::open"
  222.         }
  223.     }
  224. }
  225.  
  226.  
  227. # Close $handle
  228. #
  229. proc fstorage::close {handle} {
  230.     global fstorageCache
  231.  
  232.     if [info exists fstorageCache($handle)] {
  233.         $fstorageCache($handle) unlock
  234.         unset fstorageCache($handle)
  235.     } else {
  236.         puts "Warning fstorate::close called for unknown handle"
  237.     }
  238.  
  239.     close $handle
  240. }
  241.  
  242.  
  243. # Remove '$fullName' from repository
  244. #
  245. proc fstorage::remove {fullName} {
  246.     set cc [ClientContext::global]
  247.     set systemV [$cc currentSystem]
  248.  
  249.     if [$systemV isNil] {
  250.         error "Unable to remove file: not at system level"
  251.     }
  252.  
  253.     set fileV [fstorage::getFileVersion $fullName]
  254.  
  255.     if [$fileV isNil] {
  256.         error "Unable to remove file '$fullName': file not found"
  257.     }
  258.  
  259.     $systemV remove -fileVersion $fileV
  260. }
  261.  
  262.  
  263. # Return the path of $fullName in the "user environment".
  264. # If $absolute == "absolute" the path is absolute, else relative.
  265. #
  266. proc fstorage::get_uenv_path {fullName {absolute "relative"}} {
  267.     set fileV [fstorage::getFileVersion $fullName]
  268.  
  269.     if {[$fileV isNil]} {
  270.         error "Object '$fullName' not found in the repository"
  271.     }
  272.  
  273.     if {$absolute == "absolute"} {
  274.         return [$fileV path]
  275.     }
  276.  
  277.     set relative [$fileV getPropertyValue fileSystemPath]
  278.  
  279.     if {$relative == ""} {
  280.         return $fullName
  281.     }
  282.  
  283.     return $relative
  284. }
  285.  
  286.  
  287. # Goto system $sys in phase $phase
  288. #
  289. proc fstorage::goto_system {sys {phase ""}} {
  290.     set clientCont [ClientContext::global]
  291.     set currentLevel [$clientCont currentLevel]
  292.  
  293.     if {$currentLevel == "Project" || $currentLevel == "Corporate"} {
  294.         puts "invalid level: $currentLevel"
  295.         return
  296.     }
  297.  
  298.     set oldLevelPath [m4_var get M4_levelpath]
  299.     while {[$clientCont currentLevel] != "Phase"} {
  300.         $clientCont upLevel
  301.     }
  302.  
  303.     if {$phase != ""} {
  304.         $clientCont upLevel
  305.         if [catch {$clientCont downLevel $phase} msg] {
  306.         $clientCont setLevelPath $oldLevelPath
  307.         error $msg
  308.         }
  309.     }
  310.  
  311.     if [catch {$clientCont downLevel $sys} msg] {
  312.         $clientCont setLevelPath $oldLevelPath
  313.         error $msg
  314.     }
  315. }
  316.  
  317.  
  318. # Return the "Imported From" attribute from $fullName
  319. #
  320. proc fstorage::get_imp_from {fullName} {
  321.     set fileV [fstorage::getFileVersion $fullName]
  322.  
  323.     if {[$fileV isNil]} {
  324.         return ""
  325.     }
  326.  
  327.     return [$fileV getPropertyValue imp_from]
  328. }
  329.  
  330.  
  331. # Set the "Imported From" property of $fullName to $value
  332. #
  333. proc fstorage::set_imp_from {fullName value} {
  334.     set fileV [fstorage::getFileVersion $fullName]
  335.  
  336.     if {[$fileV isNil]} {
  337.         error "Unable to set property for '$fullName': it is not a file within this system"
  338.     }
  339.  
  340.     return [$fileV setProperty imp_from $value]
  341. }
  342.  
  343. # Do not delete this line -- regeneration end marker
  344.  
  345.