filecopy.tcl

Tornado 2.0.2 source code!vxworks的源代码

            set setupVals(confirmation) ""
        }

        lappend setupVals(confirmation) "$desc"

        # Append info to the uninstall record

        uninstLog info "$desc"

        # Begin the copy loop

        set prevFileName ""

        foreach partIndex [productInfoGet selectedPartIndexList $prodIndex] {

            set partDesc [partInfoGet desc $partIndex]

            if [catch {setupFileSetMake $partIndex} error] {
                uninstLog setup "\tskip installing $partDesc: $error"
                dbgputs "unable to install $partDesc: $error"
                lastErrorSet "$error"
                continue
            } else {
                dbgputs "Installing [productInfoGet desc $prodIndex] -> $partDesc"
            }

            while { 1 } {
                if {$setupVals(cancel) == 1} {return}

                set fileName [setupFileNameGet 0]
                set current_file [checkPathLen $fileName]

                # update meter

                set percent [expr $i * 100 / $totalFiles]
                meterUpdate $percent $fileName
                if {![limitColors]} {
                    bbrdUpdate $percent
                }

                set f [destDirGet]/$fileName

                catch {setupFileExtract} retVal

                # change "group" and "other" execute permissions for Unix files.

                if {[isUnix]} {
                    setExecutePermissions $f
                }

                dbgputs [format "%20s\t%s" $retVal $fileName]

                if {[processInstall $retVal $fileName $prodIndex] == "break"} {
                    break
                }

                if {"$prevFileName" != "$fileName"} {
                    incr i
                    set prevFileName $fileName
                }
            }

        execute [productInfoGet name $prodIndex]/postInstall.tcl
        }
    }

    #
    # fix up multiple versions of file
    #
    set count 0
    set totalFiles [llength [array names multipleVersion]]

    foreach fileName [array names multipleVersion] {
        set percent [expr $count * 100 / $totalFiles]
        meterUpdate $percent "Resolving version conflicts..."
        incr count

        set f [destDirGet]/$fileName
        set numProdIndex [llength $multipleVersion($fileName)]
        set pIndx [lindex $multipleVersion($fileName) 0]

        #
        # 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
                }
            }
        }

        #
        # 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"
        }
    }
}

##############################################################################
#
# 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

    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
    }

    foreach file $setupVals(setupFiles) {
        if {[windHostTypeGet] == "x86-win32"} {
            switch -regexp $file {
                DISK_ID|disk_id {}
                WIND|wind {}
                SUN4|sun4 {}
                PARISC|parisc {}
                default { lappend setupFiles $file }
            }
        } elseif {[windHostTypeGet] == "sun4-solaris2"} {
            switch -regexp $file {
                DISK_ID|disk_id {}
                WIND|wind {}
                X86|x86 {}
                PARISC|parisc {}
                default { lappend setupFiles $file }
            }
        } elseif {[windHostTypeGet] == "parisc-hpux10"} {
            switch -regexp $file {
                DISK_ID|disk_id {}
                WIND|wind {}
                X86|x86 {}
                SUN4|sun4 {}
                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]
                close $fp

                dbgputs "Evaluating $tclFile"
                dbgputs "$retVal"

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