Простое cgi-приложение
В программе используются 3 файла - иконка, файл с растром пунктира и подложка карты; так же в программе есть вызов для запроса данных о сети через прокси на sql, там на выходе данные вида:
lines:
{0 236 18 0.72 6 Описание 3 587 2904 785 1781 2 sw0336 cs0400}\
{0 150 104 4.10 6 Описание 1 327 1153 3067 1454 2 cs0272 cs0402}\
{0 167 87 3.44 6 Описание 1 2052 1535 3067 1454 2 cs6224 cs0402}\
{0 204 50 1.97 6 Описание 0 834 2296 3067 1454 2 cs0770 сs0402}\
{0 176 78 3.09 6 Описание 3 1985 781 3067 1454 2 sw0981 cs0402}\
....
{0 192 62 2.45 6 Описание 1 3912 432 1452 389 2 sw2153 sw6192}
routers:
{cs0402 ivanova547 ул._Иванова,_547 3067 1454 0 13.27 -3 0.000 119.646 135.354 2 1 0 }\
{sw0981 petrova25_5_8 ул.Петрова_29_5п_8э 1985 781 0 4.60 -3 0.000 208.080 46.920 2 1 0 }\
....
{sw6192 sidorova22 ул_Сидорова_22 1452 389 0 4.22 -3 0.000 211.956 43.044 2 1 0 }
ну и сам скрипт:
#!/bin/sh # \ exec wish -f "$0" ${1+"$@"} package require Tk set ver "0.8.4 alpha 2008.11.22" # где картинки set paath [file dirname $argv0] # максимальные координаты в мсскл set xmax 4237 set ymax 4228 # множитель для преобразования координат в метры set xy2m 4.608025478 # шаг сетки на максимальном масштабе set kletka 500 # делитель масштаба по умолчанию set mult 3 # шрифт на карте set plotFont {Helvetica 8} # подложка proc bgd_set {w} { if {$::bgd == 1} { set ::mult 1 refresh $w 0 } { refresh $w 0 } } # запрос информации с роутера proc info_router {w} { catch { set id [$w find withtag current] if {$id == ""} return if {[lindex $::obj($id) 0] == "Router:"} { set rid [lindex $::obj($id) 1] set ::currentObj "Please wait, get info from $rid" update idletasks set c $w.m toplevel $c wm title $c $::obj($id) frame $c.f -highlightthickness 1 -borderwidth 1 -relief sunken set t $c.f.text text $t -bg white -yscrollcommand "$c.scroll set" -setgrid true \ -width 120 -height 60 -wrap no -tabs {3c 5c 7c 9c 11c} -highlightthickness 0 -borderwidth 0 scrollbar $c.scroll -command "$t yview" pack $t -expand yes -fill both pack $c.scroll -side right -fill y pack $c.f -side top bind $c <Key-Escape> "destroy $c" # открытие сокета с роутером set s [socket $rid.lan.xxx.xxx.ru 7xxx] fconfigure $s -translation lf -buffering none puts $s "password" set message [read $s] if {$message == ""} {set message "No answer from router $rid"} close $s $t insert end $message } } } # выполняем body через каждые s секунд proc every {s body} {eval $body; after [expr {$s*1000}] [info level 0]} # Сохраням позицию окна и масштаб в $HOME/.maprc proc write_params {} { set fileId [open "$::env(HOME)/.maprc" w 0600] puts $fileId "set mult $::mult" puts $fileId "wm geometry . [wm geometry .]" close $fileId } # Запрос на биллинг через проксик # routers - выводит tcl-список роутеров, lines - связей proc mssql {c} { set s [socket xxx.xxxx.xxx.ru 7xxx] fconfigure $s -translation lf -buffering none -encoding utf-8 puts $s $c set message [read $s] close $s return $message } # Координатная сетка proc setka {w} { global xm ym set ym [expr {$::ymax/$::mult}] set xm [expr {$::xmax/$::mult}] # map scroll region $w configure -scrollregion "-30 -30 [expr {$xm+30}] [expr {$ym+30}]" # подложка в файле map-2.gif, в винде отъедает кучу памяти!!! if {$::mult == 1 && $::bgd == 1} { image create photo im_map -file [file join $::paath map-2.gif] $w create image 0 0 -image im_map -anchor nw } # setka for {set i 0} {$i <= [expr {$xm*$::xy2m/$::kletka}]} {incr i} { set x [expr {$i*$::kletka/$::xy2m}] $w create line $x 0 $x $ym -width 1 -fill grey $w create text $x [expr {$ym+2}] -text [expr {$::kletka*$::mult*$i}] -anchor n -font $::plotFont } for {set i 0} {$i <= [expr {$ym*$::xy2m/$::kletka}]} {incr i} { set y [expr {$ym - ($i*$::kletka/$::xy2m)}] $w create line 0 $y $xm $y -width 1 -fill grey $w create text -16 [expr {$y-7}] -text [expr {$i*$::kletka*$::mult}] -anchor n -font $::plotFont } # osi $w create line 0 $ym [expr {$xm+10}] $ym -width 2 -arrow last $w create line 0 -10 0 $ym -width 2 -arrow first } # Рисуем трассы proc trassa {w line} { foreach lin [mssql $line] { # coordinates set xb [expr {[lindex $lin 7]/$::mult}] set yb [expr {$::ym - [lindex $lin 8]/$::mult}] set xe [expr {[lindex $lin 9]/$::mult}] set ye [expr {$::ym - [lindex $lin 10]/$::mult}] # size in m set m [expr {round($::xy2m*hypot([lindex $lin 7]-[lindex $lin 9],[lindex $lin 8]-[lindex $lin 10]))}] # color set r [format "%.0f" [lindex $lin 0]] set g [format "%.0f" [lindex $lin 1]] set b [format "%.0f" [lindex $lin 2]] set clr [format "%02X%02X%02X" $r $g $b] set punkt "" set strel none set dir " == " # optika в файле punkt.xbm картинка для создания пунктирной линии if {[lindex $lin 4] eq 5} {set punkt "@[file join $::paath punkt.xbm]"} # direction if {[lindex $lin 6] eq 0} {set strel first; set dir " <== "} if {[lindex $lin 6] eq 1} {set strel last; set dir " ==> "} # line set item [$w create line $xb $yb $xe $ye -tags lines -arrow $strel \ -arrowshape {10 20 4} -stipple $punkt -width 1 -fill \#$clr ] set ::obj($item) "Link: [lindex $lin 12]$dir[lindex $lin 13] Ping: [lindex $lin 3] lenght=$m m" $w addtag point withtag $item } } # Рисуем обьекты proc router {w line} { # mo - размер АС,свитчей,АП; mor - размер БС set mo [expr {$::mult-5}] if {$mo == -1} {set mo -2} set mor [expr {$mo-2}] foreach point [mssql $line] { set name [lindex $point 0] set x [expr {[lindex $point 3]/$::mult}] set y [expr {$::ym - [lindex $point 4]/$::mult}] set r [format "%.0f" [lindex $point 8]] set g [format "%.0f" [lindex $point 9]] set b [format "%.0f" [lindex $point 10]] set c0lr [format "%02X%02X%02X" $r $g $b] # 0 - abonent station, -2,-3 - base station, 3 - switches, other - repiters switch -regexp -- "[lindex $point 7]" { "0" {set item [$w create oval [expr {$x-$mo}] [expr {$y-$mo}] [expr {$x+$mo}] [expr {$y+$mo}] \ -tags objects -fill \#$c0lr ] set o "Router:"} (-3|-2) {set item [$w create poly $x [expr {$y+$mor}] [expr {$x-$mor}] [expr {$y-$mor}] \ [expr {$x+$mor}] [expr {$y-$mor}] $x [expr {$y+$mor}] -tags objects -width 0 -fill \#$c0lr -outline black] if {$::mult ne 4} {$w create text [expr {$x+6}] [expr {$y+7}] -text [lindex $point 0] -anchor n -font $::plotFont} set o "Router:"} "3" {set item [$w create rect [expr {$x+$mo}] [expr {$y+$mo}] [expr {$x-$mo}] [expr {$y-$mo}] \ -tags objects -fill \#$c0lr ] set o "Switch:"} "default" {set item [$w create oval [expr {$x-$mo}] [expr {$y-$mo}] [expr {$x+$mo}] \ [expr {$y+$mo}] -tags objects -width 2 -fill white -outline \#$c0lr ] set o "AP:"} } set ::obj($item) "$o $name [lindex $point 1] [lindex $point 2] Ping: [lindex $point 6] Last seen: [lindex $point 14]" $w addtag point withtag $item } } # Обновление карты proc refresh {w i} { $w delete all setka $w catch { trassa $w lines router $w routers } set ::currentObj "MAP refreshed" update idletasks } # Обновление статус-строки proc newobj w { set id [$w find withtag current] if {$id != ""} { set ::currentObj $::obj($id) } update idletasks } # Картинкос image create photo ::img::delete -format GIF -data { R0lGODlhEAAQAIABAIQAAP///yH5BAEAAAEALAAAAAAQABAAAAIjjI+pmwAc3HGy PUSvqYpuvWQg40FfSVacBa5nN6JYDI3mzRQAOw== } image create photo ::img::refresh -format GIF -data { R0lGODlhEAAQAJEDAP///wAAACpnKv///yH5BAEAAAMALAAAAAAQABAAAAI63IKp xgcPH2ouwgBCw1HIxHCQ4F3hSJKmwZXqWrmWxj7lKJ2dndcon9EBUq+gz3brVXAR 2tICU0gXBQA7 } ############ main ########### if {[file exists "$env(HOME)/.maprc"]} {source "$env(HOME)/.maprc"} wm title . "MAP Viewer v$ver (c) Sanych" wm iconname . "map viever v$ver (c) Sanych" # файл с иконкой wm iconbitmap . @[file join $paath iconmap.xbm] wm geometry . +0+0 # status line label .entry -width 200 -font {-family times -size 12 -weight bold } -fg red -textvariable currentObj set currentObj "MAP v$ver (C) Sanych" pack .entry -side top # buttons frame .niz checkbutton .niz.chk -text "Background" -compound left -variable bgd -width 30 -command {bgd_set .c} button .niz.b1 -text "Quit(esc)" -image ::img::delete -compound left -width 100 -command {write_params; exit} button .niz.b2 -text "Refresh(r)" -image ::img::refresh -compound left -width 100 -command {refresh .c 0} scale .niz.mlt -relief flat -orient horizontal -from 1 -to 4 -variable mult -command {refresh .c} pack .niz.b1 .niz.b2 .niz.mlt .niz.chk -side right pack .niz -side bottom -padx 45 #trace variable currentObj w "objChanged .c" # paint region frame .grid scrollbar .hscroll -orient horiz -command ".c xview" scrollbar .vscroll -command ".c yview" canvas .c -relief flat -borderwidth 1 -scrollregion {-30 -30 4280 4230} -bg white -xscrollcommand ".hscroll set" -yscrollcommand ".vscroll set" pack .grid -expand yes -fill both -padx 1 -pady 1 grid rowconfig .grid 0 -weight 1 -minsize 0 grid columnconfig .grid 0 -weight 1 -minsize 0 grid .c -padx 1 -in .grid -pady 1 \ -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news grid .vscroll -in .grid -padx 1 -pady 1 \ -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news grid .hscroll -in .grid -padx 1 -pady 1 \ -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news # refresh every 60" every 60 {refresh .c 0} # keys .c bind point <Any-Enter> "newobj .c" .c bind point <Any-Leave> {set currentObj ""} bind .c <3> ".c scan mark %x %y" bind .c <1> "info_router .c" bind .c <B3-Motion> ".c scan dragto %x %y" bind . <Key-r> {refresh .c 0} #bind . <Key-b> "set $bgd [expr !$bgd];bgd_set .c" bind . <Key-Escape> {write_params; exit} bind . <Key-Down> {if {$mult < 4} {set mult [expr {$mult+1}]; refresh .c 0}} bind . <Key-Up> {if {$mult > 1} {set mult [expr {$mult-1}]; refresh .c 0}} bind .c <5> {if {$mult < 4} {set mult [expr {$mult+1}]; refresh .c 0}} bind .c <4> {if {$mult > 1} {set mult [expr {$mult-1}]; refresh .c 0}}
1382 просмотров
комментировать