PC World 1997 November/PCWorld_1997-11_cd.bin/software/programy/komix/DATA.Z/filehandle.tcl

Text File | 1997-05-14 | 7KB | 262 lines

#---------------------------------------------------------------------------
#
#      (c)     Cayenne Software Inc.    1997
#
#      File:           @(#)filehandle.tcl    /main/hindenburg/11
#      Author:         <generated>
#      Description:
#---------------------------------------------------------------------------
# SccsId = @(#)filehandle.tcl    /main/hindenburg/11   14 May 1997 Copyright 1997 Cayenne Software Inc.

# Start user added include file section
require cgen_msg.tcl
require machdep.tcl
# End user added include file section


# This class does generic file handling.

Class FileHandler : {GCObject} {
    constructor
    method destructor
    method getFileName
    method openFile
    method closeFile
    method checkUniqueFiles
    method writeSectionToFile
    method writeSectionToNamedFile
    method sourceTclFiles
    method sourceAllTclFilesInSystem
    method importExternal
    method findExternalSource
    method setImpFrom
}

constructor FileHandler {class this} {
    set this [GCObject::constructor $class $this]
    # Start constructor user section
    # End constructor user section
    return $this
}

method FileHandler::destructor {this} {
    # Start destructor user section
    # End destructor user section
}


# Returns file name for <class> with type <fileType>.
#
method FileHandler::getFileName {this class fileType} {
    return "[$class getName].$fileType"
}


# Opens the file for <class> with type <fileType>.
# Returns a file descriptor on success,
# the empty string on failure.
#
method FileHandler::openFile {this class fileType} {
    set fileName [$this getFileName $class $fileType]
    if [catch {set fd [fstorage::open $fileName r]}] {
    return ""
    }
    return $fd
}


# Closes a file that was opened
# by openFile
#
method FileHandler::closeFile {this fileDesc} {
    if {$fileDesc != ""} {
        fstorage::close $fileDesc
    }
}


# Checks whether the classes in the current
# system map to different file names.
# If this is not the case, an error is generated.
#
method FileHandler::checkUniqueFiles {this classList} {
    set fileToClass [Dictionary new]
    # any type will do for this check
    set aType [[$this getFileTypes] index 0]

    $classList foreach class {
    set fileName [$this getFileName $class $aType]
    if [$class isExternal] {
        continue
    }
    set className [$class getName]
    if [$fileToClass exists $fileName] {
        error "Classes '$className' and '[$fileToClass set $fileName]' map to the same file name" "" ERR_UNIQUE_FILENAME
    }
    $fileToClass set $fileName $className
    }
}


# Writes the contents of <section> to the file for
# <class> with type <fileType>. If
# - the file existed already and has not changed or
# - the section is empty or
# - there were checking errors
# the file is not written and 0 is returned.
# Otherwise 1 is returned.
#
#
method FileHandler::writeSectionToFile {this section class fileType} {
    if { [$section contents] == "" } {
    return 0
    }

    set fileName [$this getFileName $class $fileType]

    if [section_equals_file $section $fileName] {
    puts "$fileName has not changed: file not written"
    return 0
    }

    if {[M4CheckManager::getErrorCount] > 0} {
    puts "Not saving $fileName because of previous errors"
    return 0
    }

    puts stdout "Creating $fileName"

    if [catch {set fd [fstorage::open $fileName w]} reason] {
    puts stderr $reason
    m4_error $E_FILE_OPEN_WRITE $fileName
    return 0
    } else {
    if [catch {$this setImpFrom $fileName $class} reason] {
        puts stderr $reason
    }

    $section write $fd
    fstorage::close $fd
    }

    return 1
}


# Writes the contents of <section> to file <fileName>.
#
method FileHandler::writeSectionToNamedFile {this section fileName} {
    if [catch {set fd [fstorage::open $fileName w]} reason] {
        puts stderr $reason
        m4_error $E_FILE_OPEN_WRITE $fileName
        return
    }

    $section write $fd
    fstorage::close $fd
}


#
# Sources tcl files in the current system,
# and tcl files in the system called Tcl if it exists.
#
method FileHandler::sourceTclFiles {this} {
    set cc [ClientContext::global]

    set thisSystem [$cc levelNameAt System]

    if {![catch {fstorage::goto_system Tcl.system} msg]} {
    $this sourceAllTclFilesInSystem
    fstorage::goto_system $thisSystem
    }

    $this sourceAllTclFilesInSystem
}


# Sources all Tcl files in the current system.
#
method FileHandler::sourceAllTclFilesInSystem {this} {
    foreach fileName [fstorage::dir tcl] {
    set absoluteFileName [fstorage::get_uenv_path $fileName absolute]
    if [catch {source $absoluteFileName}] {
        m4_error $E_USER_TCL $absoluteFileName
        puts stderr $errorInfo
    }
    }
}


# Imports the external file <fileName> in the file
# for <class> with type <fileType>,
# if <fileName> exists. This is a legacy
# method with old code.
#
method FileHandler::importExternal {this class fileType fileName} {
    set class_name [$class getName]
    set newFileName [$this getFileName $class $fileType]

    set absoluteFileName [$this findExternalSource $fileName]
    if {$absoluteFileName == ""} {
    puts -nonewline "ERROR: class '[$class getName]': "
    puts "external class source file '$fileName' not found"
    return
    }

    puts "Importing external '$absoluteFileName'"
    puts "Creating $newFileName"

    if [catch {set out [fstorage::open $newFileName w]} reason] {
    puts stderr $reason
    m4_error $E_FILE_OPEN_WRITE $newFileName
    return
    }

    if [catch {fstorage::set_imp_from $newFileName [$class getName]} reason] {
    puts stderr $reason
    }

    set max 8092
    set in [open $absoluteFileName r]
    while {[set result [read $in $max]] != ""} {
    puts -nonewline $out $result
    }

    close $in
    fstorage::close $out
}


# Looks for a file named <fileName> in the current
# directory and in all directories specified by the
# global exsrc_searchpath. Returns the absolute
# file name on success, the empty string otherwise.
#
method FileHandler::findExternalSource {this fileName} {
    if [file exists $fileName] {
    return $fileName
    }

    global exsrc_searchpath
    if {! [info exists exsrc_searchpath]} {
    return ""
    }

    set sep [searchPathSeparator]
    foreach dirName [split $exsrc_searchpath $sep] {
    set absoluteFileName [path_name concat $dirName $fileName]
    if [file exists $absoluteFileName] {
        return $absoluteFileName
    }
    }
    return ""
}

method FileHandler::setImpFrom {this fileName class} {
    return [fstorage::set_imp_from $fileName [$class getName]]
}

# Do not delete this line -- regeneration end marker