home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / filehandle.tcl < prev    next >
Text File  |  1997-10-15  |  7KB  |  270 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)filehandle.tcl    /main/titanic/14
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)filehandle.tcl    /main/titanic/14   15 Oct 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. require cgen_msg.tcl
  13. require machdep.tcl
  14. # End user added include file section
  15.  
  16.  
  17. # This class does generic file handling.
  18.  
  19. Class FileHandler : {GCObject} {
  20.     constructor
  21.     method destructor
  22.     method getFileName
  23.     method getFsFileName
  24.     method openFile
  25.     method closeFile
  26.     method checkUniqueFiles
  27.     method writeSectionToFile
  28.     method writeSectionToNamedFile
  29.     method sourceTclFiles
  30.     method sourceAllTclFilesInSystem
  31.     method importExternal
  32.     method findExternalSource
  33.     method setImpFrom
  34. }
  35.  
  36. constructor FileHandler {class this} {
  37.     set this [GCObject::constructor $class $this]
  38.     # Start constructor user section
  39.     # End constructor user section
  40.     return $this
  41. }
  42.  
  43. method FileHandler::destructor {this} {
  44.     # Start destructor user section
  45.     # End destructor user section
  46. }
  47.  
  48.  
  49. # Returns file name for <class> with type <fileType>.
  50. #
  51. method FileHandler::getFileName {this class fileType} {
  52.     return "[$class getName].$fileType"
  53. }
  54.  
  55. method FileHandler::getFsFileName {this class fileType} {
  56.     set fileV ""
  57.     return [fstorage::getFilePath fileV "[$class getName].$fileType"]
  58. }
  59.  
  60.  
  61. # Opens the file for <class> with type <fileType>.
  62. # Returns a file descriptor on success,
  63. # the empty string on failure.
  64. #
  65. method FileHandler::openFile {this class fileType} {
  66.     set fileName [$this getFileName $class $fileType]
  67.     if [catch {set fd [fstorage::open $fileName r]}] {
  68.     return ""
  69.     }
  70.     return $fd
  71. }
  72.  
  73.  
  74. # Closes a file that was opened
  75. # by openFile
  76. #
  77. method FileHandler::closeFile {this fileDesc} {
  78.     if {$fileDesc != ""} {
  79.         fstorage::close $fileDesc
  80.     }
  81. }
  82.  
  83.  
  84. # Checks whether the classes in the current
  85. # system map to different file names.
  86. # If this is not the case, an error is generated.
  87. #
  88. method FileHandler::checkUniqueFiles {this classList} {
  89.     set fileToClass [Dictionary new]
  90.     # any type will do for this check
  91.     set aType [[$this getFileTypes] index 0]
  92.  
  93.     $classList foreach class {
  94.     set fileName [$this getFileName $class $aType]
  95.     if [$class isExternal] {
  96.         continue
  97.     }
  98.     set className [$class getName]
  99.     if [$fileToClass exists $fileName] {
  100.         error "Classes '$className' and '[$fileToClass set $fileName]' map to the same file name" "" ERR_UNIQUE_FILENAME
  101.     }
  102.     $fileToClass set $fileName $className
  103.     }
  104. }
  105.  
  106.  
  107. # Writes the contents of <section> to the file for
  108. # <class> with type <fileType>. If
  109. # - the file existed already and has not changed or 
  110. # - the section is empty or
  111. # - there were checking errors
  112. # the file is not written and 0 is returned.
  113. # Otherwise 1 is returned.
  114. # 
  115. #
  116. method FileHandler::writeSectionToFile {this section class fileType} {
  117.     if { [$section contents] == "" } {
  118.     return 0
  119.     }
  120.  
  121.     set fileName [$this getFileName $class $fileType]
  122.  
  123.     if [section_equals_file $section $fileName] {
  124.     puts "$fileName has not changed: file not written"
  125.     return 0
  126.     }
  127.  
  128.     if {[M4CheckManager::getErrorCount] > 0} {
  129.     puts "Not saving $fileName because of previous errors"
  130.     return 0
  131.     }
  132.  
  133.     puts stdout "Creating $fileName"
  134.  
  135.     if [catch {set fd [fstorage::open $fileName w]} reason] {
  136.     puts stderr $reason
  137.     m4_error $E_FILE_OPEN_WRITE $fileName
  138.     return 0
  139.     } else {
  140.     if [catch {$this setImpFrom $fileName $class} reason] {
  141.         puts stderr $reason
  142.     }
  143.  
  144.     $section write $fd
  145.     fstorage::close $fd
  146.     }
  147.  
  148.     return 1
  149. }
  150.  
  151.  
  152. # Writes the contents of <section> to file <fileName>.
  153. #
  154. method FileHandler::writeSectionToNamedFile {this section fileName} {
  155.     if [catch {set fd [fstorage::open $fileName w]} reason] {
  156.         puts stderr $reason
  157.         m4_error $E_FILE_OPEN_WRITE $fileName
  158.         return
  159.     }
  160.  
  161.     $section write $fd
  162.     fstorage::close $fd
  163. }
  164.  
  165.  
  166. # 
  167. # Sources tcl files in the current system,
  168. # and tcl files in the system called Tcl if it exists.
  169. #
  170. method FileHandler::sourceTclFiles {this} {
  171.     set cc [ClientContext::global]
  172.  
  173.     set thisSystem [$cc levelNameAt System]
  174.  
  175.     if {![catch {fstorage::goto_system Tcl.system} msg]} {
  176.     $this sourceAllTclFilesInSystem
  177.     fstorage::goto_system $thisSystem
  178.     }
  179.  
  180.     $this sourceAllTclFilesInSystem
  181. }
  182.  
  183.  
  184. # Sources all Tcl files in the current system.
  185. #
  186. method FileHandler::sourceAllTclFilesInSystem {this} {
  187.     foreach fileName [fstorage::dir tcl] {
  188.     regsub -all {\\} [fstorage::get_uenv_path $fileName absolute] \
  189.         {\\\\} absoluteFileName
  190.  
  191.     if [catch {uplevel #0 source $absoluteFileName}] {
  192.         m4_error $E_USER_TCL $absoluteFileName
  193.         puts stderr $errorInfo
  194.     }
  195.     }
  196. }
  197.  
  198.  
  199. # Imports the external file <fileName> in the file
  200. # for <class> with type <fileType>,
  201. # if <fileName> exists. This is a legacy 
  202. # method with old code.
  203. #
  204. method FileHandler::importExternal {this class fileType fileName} {
  205.     set class_name [$class getName]
  206.     set newFileName [$this getFileName $class $fileType]
  207.  
  208.     set absoluteFileName [$this findExternalSource $fileName]
  209.     if {$absoluteFileName == ""} {
  210.     puts -nonewline "ERROR: class '[$class getName]': "
  211.     puts "external class source file '$fileName' not found"
  212.     return
  213.     }
  214.  
  215.     puts "Importing external '$absoluteFileName'"
  216.     puts "Creating $newFileName"
  217.  
  218.     if [catch {set out [fstorage::open $newFileName w]} reason] {
  219.     puts stderr $reason
  220.     m4_error $E_FILE_OPEN_WRITE $newFileName
  221.     return
  222.     }
  223.  
  224.     if [catch {fstorage::set_imp_from $newFileName [$class getName]} reason] {
  225.     puts stderr $reason
  226.     }
  227.  
  228.     set max 8092
  229.     set in [open $absoluteFileName r]
  230.     while {[set result [read $in $max]] != ""} {
  231.     puts -nonewline $out $result
  232.     }
  233.  
  234.     close $in
  235.     fstorage::close $out
  236. }
  237.  
  238.  
  239. # Looks for a file named <fileName> in the current
  240. # directory and in all directories specified by the
  241. # global exsrc_searchpath. Returns the absolute
  242. # file name on success, the empty string otherwise.
  243. #
  244. method FileHandler::findExternalSource {this fileName} {
  245.     if [file exists $fileName] {
  246.     return $fileName
  247.     }
  248.  
  249.     global exsrc_searchpath
  250.     if {! [info exists exsrc_searchpath]} {
  251.     return ""
  252.     }
  253.  
  254.     set sep [searchPathSeparator]
  255.     foreach dirName [split $exsrc_searchpath $sep] {
  256.     set absoluteFileName [path_name concat $dirName $fileName]
  257.     if [file exists $absoluteFileName] {
  258.         return $absoluteFileName
  259.     }
  260.     }
  261.     return ""
  262. }
  263.  
  264. method FileHandler::setImpFrom {this fileName class} {
  265.     return [fstorage::set_imp_from $fileName [$class getName]]
  266. }
  267.  
  268. # Do not delete this line -- regeneration end marker
  269.  
  270.