Tcl Source Code

Artifact [ae8cfb2f95]
Login

Artifact ae8cfb2f955f1fa83f134fe1db20513382ea27cf:

Attachment "main.tcl" to ticket [3461051fff] added by tombert 2011-12-17 01:00:38.
## wrapper for platform specific ping procedure
proc isping {host} {
    after 10
    return 1
}
proc isping {host} {
    if {$::tcl_platform(platform) == "windows"} {
        if {[catch {exec ping -n 1 $host} result]} {return 0}
    } else {
        if {[catch {exec ping -c 1 -n $host} result]} {return 0}
    }
    if {[regexp -nocase {(received){1}\s*[=]{1}\s*[1]{1}} $result]} {return 1}
    if {[regexp -nocase {[1]{1}\s(received){1}} $result]} {return 1}
    return 0
}

## procedure inside thread randomly looping to ping
proc pingCheckCycle {tid} {
    set newState [isping [tsv::get host [thread::id]]]
    if {$newState != [tsv::get pingStatus [thread::id]]} {
        tsv::set pingStatus [thread::id] $newState
        thread::send -async $tid [list puts [list %ping $newState]]
    }
    after 1000 [list pingCheckCycle $tid]
}

## create some threads that are continously pinging random hosts
proc threads {} {
    package re Thread
    for {set index 0} {$index < 20} {incr index} {
        ## create thread and host tsv
        set tid [thread::create {thread::wait}]
        puts $tid

        tsv::set host $tid 192.168.100.$index
        tsv::set pingStatus $tid {}
        ## provide main procedures to thread - we can spare sourcing
        foreach procName {isping pingCheckCycle} {
            set procBody [info body $procName]
            set procArgs [info args $procName]
            thread::send $tid [list proc $procName $procArgs $procBody]
        }
        thread::send -async $tid [list pingCheckCycle [thread::id]]
    }
}

proc entries {} {
    for {set top 1} {$top <= 200} {incr top} {
        set w [toplevel .top$top]
        for {set entry 1} {$entry <= 50} {incr entry} {
            set e [entry $w.e$entry]
            $e insert end ${top}.${entry}
            pack $e -fill x -expand yes
            update idletask
        }
        update
    }
    puts "."
    puts "finished"
}

console show




#after 1000 exit