fspace.tcl

好东西,欢迎下在,联系方式E-mail:[e-mail]

# fspace.tcl - Installation program for Unix platforms.
#
# history
# -------
# 01c,07dec96,pdn  added support for AIX host
# 01b,14nov96,pdn  used windHostTypeGet to get WIND_HOST_TYPE
# 01a,30aug96,jc   written
#

proc fspace {dir} {

    if ![file isdirectory $dir] {return "$dir: bad directory name"}

    # get the directory name in extension

    set here [pwd]
    cd $dir
    set dir [pwd]

    set free "unknown"

    switch [windHostTypeGet] {
        sun4-solaris2 {
            set free [lindex [exec /bin/df -k $dir] 10]
        }

        sun4-sunos4 {
            set free [lindex [exec /bin/df $dir] 10]
        }

        parisc-hpux9 -
        parisc-hpux10 {
            set found 0
            set ix 0
            while {$found == 0} {
                incr ix
                if {$ix > 30} {
                    break
                }
                if [catch "exec /bin/df $dir" res] {
                    # go backward one step looking for actual mounting
                    # point or device name alias
                    set dir [file dirname $dir]
                } else {
                    set freeSize [lindex [exec /bin/df $dir] 3]
                    if {[regexp {[^0-9]+} $freeSize] == 0} {
                        set free [expr $freeSize / 2]
                    }
                    set found 1
                }
            }
        }

        rs6000-aix4 {
            set free [lindex [exec /bin/df $dir] 10]
        }

        default         {}
    }
    cd $here
    return $free
}