filecopy.tcl

tornado 2.2 for ppc.tcc-cp1-xscale. this rar-files can update 2.2 to 2.2.1 just for education resea

        #
        # Finds the latest version and keeps it.  Removes the older versions.
        # After this step, the pIndx variable will end up holding the latest
        # version.
        #
        if {$numProdIndex > 1} {
            for {set i 1} {$i < $numProdIndex} {incr i} {
                set pIndx1 [lindex $multipleVersion($fileName) $i]

                if {[file mtime $f._${pIndx}_] < [file mtime $f._${pIndx1}_]} {
                    catch {file delete $f._${pIndx}_}
                    set pIndx $pIndx1
                } else {
                    catch {file delete $f._${pIndx1}_}
                }
            }
        }

        #
        # Take the appropriate steps to save and log the file before removing
        # it (if exists), since we always want the newest version among those
        # just installed regardless of the relative timestamp of the existing
        # one and the new one.
        #
        if {[file exists $f]} {
            if {[file mtime $f] > [file mtime $f._${pIndx}_]} {
                set newerFileArray($fileName) ""
            }

            if {[file mtime $f] != [file mtime $f._${pIndx}_]} {
                backup $fileName
            }

            while {1} {
                set retVal [fileRemove $f]
                if {($retVal == "OK") || ($retVal == "IGNORE")} {
                    break
                } elseif { $retVal == 0 } {
                    # for TEXT mode, if return value = 0, exit SETUP
                    if { ![isGUImode] } { return 0 }
                }
            }
        }

        #
        # Finally, make the newest version among those installed from this
        # session be the official one for use.
        #
        if ![catch {file rename $f._${pIndx}_ $f}] {
            uninstLog file "wind_base\t$fileName"
            archListPut $fileName $pIndx
        }
    }

    # write to the log file the list of overwritten files.

    if {[llength [array names newerFileArray]] > 0} {
        uninstLog setup ""
        uninstLog setup "SETUP has overwritten the following files which"
        uninstLog setup "are newer than those on the CDROM.  Original files"
        uninstLog setup "are zipped into $setupVals(uninstFile)."
        uninstLog setup "Use any unzip utility in case you need to get back"
        uninstLog setup "original version of the files."
        uninstLog setup ""

        foreach file [lsort [array names newerFileArray]] {
            uninstLog setup "\t$file"
        }
    }

    # write list of licensed products (if any) to setup.log

    if { [info exists licensedProds] && $licensedProds != "" } {
        uninstLog setup ""
        foreach prod $licensedProds {
            uninstLog setup $prod
        }
        uninstLog setup ""
    }
}

##############################################################################
#
# listDir - lists recursively Setup files/folders in a directory
#
# This procedure lists recursively the directories and files that reside in
# the Setup path passed as input.  The results are kept in a global array
# setupVals(setupFiles).
#
# SYNOPSIS
# listDir <dir>
#
# PARAMETERS: <dir> is the path to the Setup files on the CD ROM
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc listDir {dir} {

    global setupVals

    set setupFilesList [glob -nocomplain [file join $dir *]]

    foreach file $setupFilesList {
        set newDir [file join $dir $file]
        if ![file isdirectory $newDir] {
            lappend setupVals(setupFiles) $newDir
        } else {
            listDir $newDir
        }
    }
}

##############################################################################
#
# setupCopy - copies the Setup files from the CD ROM to the user's disk
#
# This procedure copies the Setup file from the CD ROM to the user's
# destination directory under $WIND_BASE.
#
# SYNOPSIS
# setupCopy
#
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#
proc setupCopy {} {
    global setupVals
    global tornadoInstalled

    set windDir [file join [destDirGet] SETUP WIND]
    catch {file mkdir $windDir}

    listDir "[cdromRootDirGet]/"

    if ![info exists setupVals(setupFiles)] {
        uninstLog setup "setupCopy: cannot obtain list of setup files"
        return
    }

    # skip copying non-native-host files under SETUP directory

    set setupFiles ""
    foreach file $setupVals(setupFiles) {
        if { [windHostTypeGet] == "sun4-solaris2" ||
             [windHostTypeGet] == "parisc-hpux10"    } {
            switch -regexp $file {
                DISK_ID|disk_id {}
                /WIND/|/wind/ {}
                /X86/|/x86/ {}
                default { lappend setupFiles $file }
            }
        } elseif { [windHostTypeGet] == "x86-win32" ||
                   [windHostTypeGet] == "x86-linux2" } {
            switch -regexp $file {
                DISK_ID|disk_id {}
                /WIND/|/wind/ {}
                /SUN4/|/sun4/ {}
                /X86/|/x86/ {
                    # for X86, separate Windows and Linux

                    if { [windHostTypeGet] == "x86-win32" } {
                        switch -regexp $file {
                            X86/LINUX2/|x86/linux2/ {}
                            default { lappend setupFiles $file }
                        }
                    } else { # linux
                        switch -regexp $file {
                            X86/WIN32/|x86/win32/ -
                            X86/WINNT/|x86/winnt/ {}
                            default { lappend setupFiles $file }
                        }
                    }
                }
                default { lappend setupFiles $file }
            }
        }
    }

    set count 0
    set totalFiles [llength $setupFiles]

    foreach file $setupFiles {
        if {$setupVals(cancel) == 1} {return}

        set percent [expr $count * 100 / $totalFiles]
        meterUpdate $percent "Preparing to copy files ..."
        incr count

        # remove "[cdromRootDirGet]" from file name
        regsub [dosToUnix [cdromRootDirGet]] [dosToUnix $file] {} rawFile

        # remove forward slash from rawFile so "file join" could work
        regsub "\/" $rawFile {} rawFile

        set destFile "[file join [dosToUnix [destDirGet]] SETUP $rawFile]"

        dbgputs [format "%20s\t%s" SETUP_COPY $destFile]
        fileDup $file $destFile update
 
    }
}

##############################################################################
#
# bbrdListGet - obtains a list of bitmaps
#
# This routine walks thru all selected products, and extracts the available
# bitmaps.
#
# SYNOPSIS
# bbrdListGet <extension>
#
# PARAMETERS:
#    <extension> : bitmap file extension, supported extension are .BMP and .PPM
#
# RETURNS: a list of bitmap filename.
#
# ERRORS: N/A
#

proc bbrdListGet {extension} {
    global ctrlVals

    set retVal ""
    set newList ""

    if {[windHostTypeGet] == "x86-win32"} {
        set zipFile [cdromZipDirGet]\\WIND.000
    } else {
        set zipFile [cdromZipDirGet]/WIND.000
    }

    set prodNameList "prologue"
    lappend prodNameList [cdInfoGet selectedProdNameList]
    lappend prodNameList "epilogue"
    set prodNameList [join $prodNameList]

    foreach prodName $prodNameList {
        if ![catch {setupUnzip -o -qq -d [tempDirGet] $zipFile \
                    "$prodName/*$extension"} error] {

            set saveDir [pwd]
            cd [tempDirGet]/$prodName

            set bbrdList [glob -nocomplain "*$extension"]

            foreach bbrdFile $bbrdList {
                if {[windHostTypeGet] == "x86-win32"} {
                    lappend newList "[tempDirGet]\\$prodName\\$bbrdFile"
                } else {
                    lappend newList "[tempDirGet]/$prodName/$bbrdFile"
                }
            }
            cd $saveDir
        }
    }
    return $newList
}

##############################################################################
#
# execute - executes product pre/postInstall tcl script
#
# This procedure extracts the provided tclFile, if exists, then evaluates it.
#
# SYNOPSIS
# execute <tclFile>
#
# PARAMETERS:
#    <tclFile> : product preInstall.tcl or postInstall.tcl
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc execute {tclFile} {

    set zipFile [cdromZipDirGet]/WIND.000

    if {[file exists $zipFile]} {
        if ![catch {setupUnzip -o -qq -d [tempDirGet] \
                    $zipFile $tclFile} retVal] {
            if ![catch {open [tempDirGet]/$tclFile "r"} fp] {
                set retVal [read $fp]
                catch { close $fp } err

                dbgputs "Evaluating $tclFile"
                dbgputs "$retVal"

                if [catch {eval $retVal} error] {
                    puts "$error"
                }
            }
        }
    }
}

#############################################################################
#
# limitColors - determine whether environment variable SETUP_LIMITCOLORS is set
#
# This procedure will determine whether environment variable
# SETUP_LIMITCOLORS is set
#
# SYNOPSIS
# .tS
# limitColors
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: 0 if enviroment variable SETUP_LIMITCOLORS is not set
#          1 if enviroment variable SETUP_LIMITCOLORS is set
#
# ERRORS: N/A
#

proc limitColors {} {
    global env

    if {[info exists env(SETUP_LIMITCOLORS)]} {
        if {$env(SETUP_LIMITCOLORS)==1} {
            return 1
                }
    }

    return 0
}

#############################################################################
#
# bbrdUpdate - update the billboard
#
# This procedure will update the billboard
#
# SYNOPSIS
# .tS
# bbrdUpdate <percent>
# .tE
#
# PARAMETERS:
# .IP percent
# percentage of billboards that have been shown
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc bbrdUpdate {percent} {
    global ctrlVals

    if { $percent > $ctrlVals(bbrdElapse) } {

        incr ctrlVals(bbrdElapse) $ctrlVals(displayInt)

        set prevBbrdIndex $ctrlVals(nextBbrd)
        incr ctrlVals(nextBbrd)

        if { [lindex $ctrlVals(bbrdList) $ctrlVals(nextBbrd)] != "" } {
            controlValuesSet $ctrlVals(bbrdWindow).bbrd \
                    [lindex $ctrlVals(bbrdList) $ctrlVals(nextBbrd)]
        }
    }
}




######################################################################
# Dialog Text Messages
######################################################################

set strTable(FILESCOPY_TITLE) "Installation in Progress"

set strTable(FILESCOPY_LABEL) \
    "format %s \"SETUP is installing the product(s) you selected in\
                \[destDirGet\].\""


set strTable(FILESCOPY_FILE_EXISTS_NEWER_WARN) \
     "format %s \"The file \'\$current_file\' exists in your destination\
                directory path \'\[destDirGet\]\' and is newer.  You can\
                set the policy for handling duplicate files by\
                selecting one of the following options.  All files to be\
                overwritten will be backed up.\""

set strTable(FILESCOPY_DEFLATE_ERROR) \
    "format %s \"SETUP isn\'t able to deflate \[setupFileNameGet 0\]\
                 \n\nPlease select one of the following options\
                 to continue with the SETUP process.\""

set strTable(FILESCOPY_MEMORY_LOW_WARN) \
    "The system is running out of memory.  To continue, close applications\
     or increase the system swap space."

set strTable(FILESCOPY_DISK_FULL_WARN) \
    "No disk space left.  To continue, free up some disk space."

set strTable(FILESCOPY_CDROM_READ_ERROR) \
    "format %s \"SETUP cannot read \[setupFileNameGet 0\] from the CD-ROM.\
    Please ensure that the CD-ROM is properly mounted.\""

set strTable(FILESCOPY_FILE_ACCESS_ERROR) \
    "format %s \"SETUP cannot create/update file \[lindex \$args 0\]:\
    \[lindex \$args 1\]\""