1############################################################################# 2# Visual Tcl v1.11p1 Project 3# 4 5################################# 6# GLOBAL VARIABLES 7# 8#global awk; 9#global debug; 10#global no_global_query_symbol; 11#global pg_ctl_su; 12#global pg_ctl_nowait; 13#global post_label; 14#global ps; 15#global ps_args; 16#global ps_cmd_col; 17#global ps_heading; 18#global ps_heading_split; 19#global ps_pid_arg; 20#global ps_pid_param; 21#global ps_pre_cmd_params; 22#global super_user; 23#global ps_user_arg; 24#global ps_user_end; 25#global refresh_id; 26#global refresh_interval; 27#global show_all; 28#global sort_order; 29#global sort_param; 30#global sort_type; 31#global user; 32#global widget; 33 34#registerPlugin PGMonitor ::Pgmonitor::openWin 35 36namespace eval Pgmonitor { 37 38 variable Win 39 variable PgAcVar 40 41 ## 42 ## Initialize the array 43 ## 44 array set PgAcVar { 45 debug 0 46 awk "" 47 no_global_query_symbol "" 48 pg_ctl_su "" 49 pg_ctl_nowait "" 50 post_label "" 51 ps "" 52 ps_args "" 53 ps_cmd_col "" 54 ps_heading "" 55 ps_heading_split "" 56 ps_pid_arg "" 57 ps_pid_param "" 58 ps_pre_cmd_params "" 59 super_user "" 60 ps_user_arg "" 61 ps_user_end "" 62 refresh_id "" 63 refresh_interval "" 64 show_all "" 65 sort_order "" 66 sort_param "" 67 sort_type "" 68 user "" 69 widget "" 70 standalone 0 71 } 72} 73 74#---------------------------------------------------------- 75# ::Pgmonitor::openWin -- 76# 77# Opens PG Monitor window, but checks first to see if 78# PGAccess is running locally 79# 80# Arguments: 81# none 82# 83# Results: 84# none 85# 86#---------------------------------------------------------- 87# 88proc ::Pgmonitor::openWin {} { 89 90 variable Win 91 variable PgAcVar 92 93 if {![info exists PgAcVar(initialized)]} { 94 set PgAcVar(initialized) 0 95 } 96 97 ## 98 ## Check to see if it is localhost, blank, or the 99 ## name of the host 100 ## 101## if {![regexp "localhost|^$|$::env(HOSTNAME)" $::PgAcVar(opendb,host)]} { 102## showError \ 103## "[intlmsg {You must run PGAccess from the local host to use PG Monitor}]" 104## 105## return 106## } 107 108 vTclWindow.pgaw:Pgmonitor "" 109 110 if {![winfo exists .query_popup]} { 111 vTclWindow.query_popup .query_popup 112 Window hide .query_popup 113 } 114 115 116 117 #Window show .pgaw:Pgmonitor 118 #Window hide .query_popup 119 120 if {$PgAcVar(initialized) == 0} { 121 ::Pgmonitor::widget_init "" "" .pgaw:Pgmonitor 122 } 123 124 return 125 126}; # end proc ::Pgmonitor::openWin 127 128#---------------------------------------------------------- 129# ::Pgmonitor::close -- 130# 131# Closes the Pgmonitor window. If it is standalone, 132# then it exits the program. Else, if it is invoked 133# from Pgaccess, then it just closes the window. 134# 135# Arguments: 136# none 137# 138# Results: 139# none 140# 141#---------------------------------------------------------- 142# 143proc ::Pgmonitor::close {} { 144 145 variable PgAcVar 146 variable Win 147 148 if {$PgAcVar(standalone)} { 149 exit 150 } 151 152 Window hide $Win(base) 153 154 return 155 156}; # end proc ::Pgmonitor::close 157 158#---------------------------------------------------------- 159#---------------------------------------------------------- 160# 161proc ::Pgmonitor::set_defaults {} { 162 #global PgAcVar 163 variable PgAcVar 164#global debug; 165#global show_all; 166#global ps; 167 168 # set this to 1 to output debug messages 169 set PgAcVar(debug) 0 170 171 # set this to 1 to show all processes, including postmaster 172 set PgAcVar(show_all) 0 173 174 # see set_ps_args for customizing ps arguments 175} 176 177#---------------------------------------------------------- 178#---------------------------------------------------------- 179# 180proc ::Pgmonitor::help {} { 181tk_messageBox -type ok -message "pgmonitor 182version 0.56 183 184Right-click on an item for help."; 185} 186 187#---------------------------------------------------------- 188#---------------------------------------------------------- 189# 190proc ::Pgmonitor::adjust_refresh_setting {click_direction} { 191 variable PgAcVar 192#global refresh_id; 193#global refresh_interval; 194 195 if {$PgAcVar(refresh_interval) >= 1 || $click_direction < 1} { 196 set PgAcVar(refresh_interval) [expr {$PgAcVar(refresh_interval) - $click_direction}] 197 } 198 199 # cancel any previous timeout 200 catch {after cancel $PgAcVar(refresh_id)} 201 202 set PgAcVar(refresh_id) [after 500 ::Pgmonitor::show_backends .pgaw:Pgmonitor] 203} 204 205#---------------------------------------------------------- 206#---------------------------------------------------------- 207# 208proc ::Pgmonitor::save_preferences {} { 209 variable PgAcVar 210 #global PgAcVar 211#global debug; 212#global env; 213#global refresh_interval; 214#global sort_order; 215#global sort_param; 216#global sort_type; 217 218 # load defaults from user's home directory .pgmonitor file 219 if {![catch {open "$env(HOME)/.pgmonitor" w} options_fid]} { 220 puts $options_fid 1 ;# config file version 221 puts $options_fid $PgAcVar(refresh_interval) 222 puts $options_fid $PgAcVar(sort_param) 223 puts $options_fid $PgAcVar(sort_order) 224 puts $options_fid $PgAcVar(sort_type) 225 close $options_fid 226 if {$PgAcVar(debug)} {puts stdout "Options saved"} 227 } else { 228 if {$PgAcVar(debug)} {puts stdout "Option save failed: $options_fid"} 229 } 230} 231 232#---------------------------------------------------------- 233#---------------------------------------------------------- 234# 235proc ::Pgmonitor::load_preferences {} { 236 variable PgAcVar 237 #global PgAcVar 238#global debug; 239#global env; 240#global ps_pid_param; 241#global refresh_interval; 242#global sort_order; 243#global sort_param; 244#global sort_type; 245 246 set PgAcVar(sort_param) $PgAcVar(ps_pid_param) 247 set PgAcVar(sort_order) "" 248 set PgAcVar(sort_type) "n" 249 250 # load defaults from user's home directory .pgmonitor file 251 if {![catch {open "$env(HOME)/.pgmonitor" r} options_fid]} { 252 if {![catch {gets $options_fid} pgmonitor_version]} { 253 if {$pgmonitor_version == 1} { 254 if {![eof $options_fid]} {gets $options_fid PgAcVar(refresh_interval)} 255 if {![eof $options_fid]} {gets $options_fid PgAcVar(sort_param)} 256 if {![eof $options_fid]} {gets $options_fid PgAcVar(sort_order)} 257 if {![eof $options_fid]} {gets $options_fid PgAcVar(sort_type)} 258 if {$PgAcVar(debug)} {puts stdout "Options loaded"} 259 } else { 260 if {$PgAcVar(debug)} {puts stdout "Unknown options version"} 261 } 262 } else { 263 if {$PgAcVar(debug)} {puts stdout "Options gets failed with: $options_fid"} 264 } 265 close $options_fid 266 } else { 267 if {$PgAcVar(debug)} {puts stdout "Options file open failed with: $options_fid"} 268 } 269} 270 271#---------------------------------------------------------- 272#---------------------------------------------------------- 273# 274proc ::Pgmonitor::update_post_label {base} { 275 variable PgAcVar 276 #global PgAcVar 277#global debug; 278#global pg_ctl_su; 279#global pg_ctl_nowait; 280#global post_label; 281 282 # if disabled, return immediately 283 if {$PgAcVar(pg_ctl_su) == ""} { 284 return 285 } 286 287 # initialize 288 if [catch {set PgAcVar(post_label)}] { 289 set PgAcVar(post_label) "" 290 } 291 292 catch {eval exec $PgAcVar(pg_ctl_su) -c {"pg_ctl $PgAcVar(pg_ctl_nowait) status | head -1"}} pg_ctl_out 293 if {$PgAcVar(debug)} {puts stdout "pg_ctl output: $pg_ctl_out"} 294 295 if [string match "*is running*" $pg_ctl_out] { 296 # postmaster is running 297 if {$PgAcVar(post_label) == "" || 298 [string match "Start*" $PgAcVar(post_label)]} { 299 set PgAcVar(post_label) "Shutdown" 300 } 301 } elseif [string match "*not running*" $pg_ctl_out] { 302 # postmaster is not running 303 if {$PgAcVar(post_label) == "" || 304 ![string match "Start*" $PgAcVar(post_label)]} { 305 set PgAcVar(post_label) "Startup" 306 } 307 } else { 308 309 if {[winfo ismapped .pgaw:Pgmonitor]} { 310 tk_messageBox -type ok -message "Unknown response returned by 'pg_ctl status':\n\ 311 $pg_ctl_out" 312 } 313 return 314 } 315} 316 317#---------------------------------------------------------- 318#---------------------------------------------------------- 319# 320proc ::Pgmonitor::update_post_label_frequently {base} { 321 variable PgAcVar 322 323#global post_label; 324 325 update_post_label $base 326 if {$PgAcVar(post_label) != "Startup" || 327 $PgAcVar(post_label) != "Shutdown"} { 328 # schedule another update 329 after 500 ::Pgmonitor::update_post_label_frequently $base 330 } 331} 332 333#---------------------------------------------------------- 334#---------------------------------------------------------- 335# 336proc ::Pgmonitor::load_sort_buttons {} { 337 variable PgAcVar 338#global ps_heading_split; 339#global sort_param; 340 341 set i 0 342 foreach col $PgAcVar(ps_heading_split) { 343 radiobutton .sort_options.column.col_$i -background #ecf0a4 -highlightthickness 0 -text $col -value $i -variable ::Pgmonitor::PgAcVar(sort_param) 344 pack .sort_options.column.col_$i -in .sort_options.column -anchor w -expand 0 -fill none -side top 345 incr i 346 } 347} 348 349#---------------------------------------------------------- 350#---------------------------------------------------------- 351# 352proc ::Pgmonitor::show_sort_options {popup} { 353 354 if [winfo exists $popup] { 355 wm deiconify $popup 356 } else { 357 Window show $popup 358 load_sort_buttons 359 } 360} 361 362#---------------------------------------------------------- 363#---------------------------------------------------------- 364# 365proc ::Pgmonitor::start_stop_postmaster {base} { 366 variable PgAcVar 367 #global PgAcVar 368#global debug; 369#global pg_ctl_su; 370#global pg_ctl_nowait; 371#global post_label; 372#global super_user; 373 374 if {$PgAcVar(pg_ctl_su) == ""} { 375 tk_messageBox -type ok -message "This can be used only by the PostgreSQL super user or root." 376 return 377 } 378 379 if [string match "*..." $PgAcVar(post_label)] { 380 tk_messageBox -type ok -message "Change of status already in progress." 381 return 382 } 383 384 ## 385 ## Close down the database before shutting 386 ## down postmaster. Ideally, we would use notifies 387 ## so that the backend would notify PGAccess of this 388 ## going down, but this is not implemented yet. 389 ## 390 catch {::Mainlib::Database:Close} 391 if {$PgAcVar(post_label) == "Startup"} { 392 eval exec $PgAcVar(pg_ctl_su) -c {"pg_ctl $PgAcVar(pg_ctl_nowait) start"} >& /dev/null 393 set PgAcVar(post_label) "Starting up..." 394 } elseif {$PgAcVar(post_label) == "Shutdown"} { 395 eval exec $PgAcVar(pg_ctl_su) -c {"pg_ctl $PgAcVar(pg_ctl_nowait) stop"} >& /dev/null 396 set PgAcVar(post_label) "Shutdown (force)" 397 } elseif {$PgAcVar(post_label) == "Shutdown (force)"} { 398 eval exec $PgAcVar(pg_ctl_su) -c {"pg_ctl $PgAcVar(pg_ctl_nowait) -m fast stop"} >& /dev/null 399 set PgAcVar(post_label) "Forcing Shutdown..." 400 } 401 # update label frequently until complete 402 after 500 ::Pgmonitor::update_post_label_frequently $base 403} 404 405#---------------------------------------------------------- 406#---------------------------------------------------------- 407# 408proc ::Pgmonitor::send_signal {base signal} { 409 variable PgAcVar 410 #global PgAcVar 411#global debug; 412#global ps; 413#global ps_pid_param; 414#global refresh_id; 415 416 # find selected process id 417 if [catch {$base.list get [$base.list curselection]} cur_selection] { 418 tk_messageBox -type ok -message "No process selected." 419 return 420 } 421 #regsub -all " *" [string trim $cur_selection] " " cur_selection 422 #set selection_pid [lindex [split $cur_selection " "] $PgAcVar(ps_pid_param)] 423 set selection_pid [lindex $cur_selection $PgAcVar(ps_pid_param)] 424 if {$PgAcVar(debug)} {puts stdout "Selected PID: $selection_pid"} 425 426 if {$signal != 2} { 427 428 ## 429 ## Close down the database before shutting 430 ## down postmaster. Ideally, we would use notifies 431 ## so that the backend would notify PGAccess of this 432 ## going down, but this is not implemented yet. 433 ## 434 catch {::Mainlib::Database:Close} 435 436 } 437 438 # send the signal 439 if [catch {exec kill -$signal $selection_pid} err] { 440 if [string match "*permit*" $err] { 441 tk_messageBox -type ok -message "No permission." 442 return 443 } elseif [string match "*No such process*" $err] { 444 tk_messageBox -type ok -message "Process no longer exists." 445 return 446 } else { 447 tk_messageBox -type ok -message $err 448 return 449 } 450 } 451 # cancel any previous timeout 452 catch {after cancel $PgAcVar(refresh_id)} 453 454 # update display promptly 455 set PgAcVar(refresh_id) [after 500 ::Pgmonitor::show_backends $base] 456} 457 458#---------------------------------------------------------- 459#---------------------------------------------------------- 460# 461proc ::Pgmonitor::show_query {base popup} { 462 variable PgAcVar 463 #global PgAcVar 464#global debug; 465#global no_global_query_symbol; 466#global ps; 467#global ps_pid_param; 468#global super_user; 469#global user; 470 471 # find selected process id 472 if [catch {$base.list get [$base.list curselection]} cur_selection] { 473 tk_messageBox -type ok -message "No process selected." 474 return 475 } 476 regsub -all " *" [string trim $cur_selection] " " cur_selection 477 set selection_pid [lindex [split $cur_selection " "] $PgAcVar(ps_pid_param)] 478 if {$PgAcVar(debug)} {puts stdout "Selected PID: $selection_pid"} 479 480 # clear old contents 481 $popup.listboxscroll.border.list delete 0 [expr {[$popup.listboxscroll.border.list size] - 1}] 482 483 # do we have kill() permission. Easy way to check if we are the proper user. 484 if [catch {exec kill -0 $selection_pid} err] { 485 if [string match "*permit*" $err] { 486 tk_messageBox -type ok -message "No permission." 487 return 488 } elseif [string match "*No such process*" $err] { 489 tk_messageBox -type ok -message "Process no longer exists." 490 return 491 } else { 492 tk_messageBox -type ok -message $err 493 return 494 } 495 } 496 if {$PgAcVar(debug)} {puts stdout "Permission check OK for $selection_pid"} 497 498 # connect via gdb and get query string 499 if {$PgAcVar(no_global_query_symbol) != "Y"} { 500 set gdb_out [exec echo "set print elements 0\nprint (char *)debug_query_string\nquit\n" | sh -c "gdb -q -x /dev/stdin postgres $selection_pid 2>&1;exit 0"] 501 if {$PgAcVar(debug)} {puts stdout "gdb output using global symbol is: $gdb_out"} 502 if [string match "*No symbol table*" $gdb_out] { 503 tk_messageBox -type ok -message "Postgres pre-7.1.1 executables must have a patch applied or be compiled with debug symbols to use this feature." 504 return 505 } 506 if [string match "*No symbol \"*" $gdb_out] { 507 # we set this now and for later show_query calls 508 set PgAcVar(no_global_query_symbol) "Y" 509 } 510 } 511 if {$PgAcVar(no_global_query_symbol) == "Y"} { 512 set gdb_out [exec echo "set print elements 0\nprint pg_exec_query_string::query_string\nquit\n" | sh -c "gdb -q -x /dev/stdin postgres $selection_pid 2>&1;exit 0"] 513 if {$PgAcVar(debug)} {puts stdout "gdb output using function paramater is: $gdb_out"} 514 } 515 516 # interpret gdb output 517 # check permit first 518 if [string match "* permit*" $gdb_out] { 519 if {$PgAcVar(user) == "root"} { 520 tk_messageBox -type ok -message "No permission." 521 return 522 } elseif {$PgAcVar(user) != $PgAcVar(super_user)} { 523 tk_messageBox -type ok -message "No permission. Try running as $PgAcVar(super_user)." 524 return 525 } else { 526 tk_messageBox -type ok -message "No permission. Try running as root." 527 return 528 } 529 } elseif {[string match "*\$1 = 0x0*" $gdb_out] || 530 [string match "*No frame*" $gdb_out]} { 531 tk_messageBox -type ok -message "No query being executed." 532 return 533 } else { 534 # success, popup query window 535 if [winfo exists $popup] { 536 wm deiconify $popup 537 } else { 538 Window show $popup 539 } 540 set query [exec echo "$gdb_out" | grep "\\\$1" | sed "s/^\[^\"\]*\"//" | sed "s/\"\$//" | sed "s/\\\\n/\\\n/g"] 541 eval {$popup.listboxscroll.border.list insert 0} [split $query "\n"] 542 } 543} 544 545#---------------------------------------------------------- 546#---------------------------------------------------------- 547# 548proc ::Pgmonitor::show_backends {base} { 549 variable PgAcVar 550 #global PgAcVar 551#global awk; 552#global debug; 553#global ps; 554#global ps_args; 555#global ps_cmd_col; 556#global ps_pid_param; 557#global ps_pre_cmd_params; 558#global super_user; 559#global ps_user_arg; 560#global ps_user_end; 561#global refresh_id; 562#global refresh_interval; 563#global show_all; 564#global sort_order; 565#global sort_param; 566#global sort_type; 567 568 set ps_out "" 569 570 if {$PgAcVar(debug)} { 571 puts stdout "\nps output before awk/sort/cut is: \n" 572 puts stdout [exec $PgAcVar(ps) $PgAcVar(ps_args) $PgAcVar(ps_user_arg) $PgAcVar(super_user) | cut -c$PgAcVar(ps_user_end)-255 | sed -n "2,\$p"] 573 } 574 575 # ps, remove user column, non-backend lines, and sort 576 if [catch {split [exec $PgAcVar(ps) $PgAcVar(ps_args) $PgAcVar(ps_user_arg) $PgAcVar(super_user) | cut -c$PgAcVar(ps_user_end)-255 | sed -n "2,\$p" | $PgAcVar(awk) " 577 { 578 cmd=substr(\$0,$PgAcVar(ps_cmd_col)); # get just pgsql-generated status part of line 579 gsub(\"\\\\(\[^\\\\)\]*\\\\)\",\"\",cmd); # remove entries around parens, (), *BSD 580 gsub(\"^\[^:\]*:\",\"\",cmd); # remove command with colon, cmd:, Linux 581 split(cmd,cmd_split); # split up db-supplied info 582 # <7.1 had bug where fields were swapped on some platforms, correct them 583 if (cmd_split\[2\] ~ /^\[0-9\]\[0-9\]*\\.\[0-9\]\[0-9\]*\\.\[0-9\]|^\\\[local\\\]\$|^localhost\$/) 584 { 585 tmp = cmd_split\[2\]; 586 cmd_split\[2\] = cmd_split\[3\]; 587 cmd_split\[3\] = tmp; 588 } 589 # we try to find only backend processes based on the pgsql status display format; 590 # must have at least four params and connect info that is IP address or local 591 # localhost in 7.0.X, \[local\] in >=7.1 592 if ($PgAcVar(show_all) || 593 (cmd_split\[4\] != \"\" && 594 cmd_split\[3\] ~ /^\[0-9\]\[0-9\]*\\.\[0-9\]\[0-9\]*\\.\[0-9\]|^\\\[local\\\]\$|^localhost\$/)) 595 { 596 # prefix line with sorted field 597 if ($PgAcVar(sort_param) < $PgAcVar(ps_pre_cmd_params)) 598 printf \"%s^\", \$[expr {$PgAcVar(sort_param) + 1}]; 599 else printf \"%s^\", cmd_split\[[expr {$PgAcVar(sort_param) + 1 - $PgAcVar(ps_pre_cmd_params)}]\]; 600 601 # print full process detail line in padded format 602 printf \"%s %-10.10s%-10.10s%-17s %-s %-s %-s\\n\", 603 substr(\$0,1,[expr {$PgAcVar(ps_cmd_col) - 1}]), 604 cmd_split\[1\],cmd_split\[2\],cmd_split\[3\], 605 cmd_split\[4\],cmd_split\[5\],cmd_split\[6\]; 606 } 607 # sort by sorted column, then strip it off 608 }" | sort -t "^" -$PgAcVar(sort_order)$PgAcVar(sort_type) | cut -d "^" -f2] "\n"} ps_out] { 609 showError [intlmsg "ps failed: $ps_out\nIs PostgreSQL running on this machine?"] 610 return 0 611 } 612 613 # store active selection 614 if {![catch {$base.list get [$base.list curselection]} cur_selection]} { 615 # get pid of current selection 616 regsub -all " *" [string trim $cur_selection] " " cur_selection 617 set selection_pid [lindex [split $cur_selection " "] $PgAcVar(ps_pid_param)] 618 } else { 619 set selection_pid 0 620 } 621 622 #load up the listbox 623 $base.list delete 0 [expr {[$base.list size] - 1}] 624 eval {$base.list insert 0} $ps_out 625 626 # restore pid selection 627 if {$selection_pid != 0} { 628 set i 0 629 foreach ps_line $ps_out { 630 regsub -all " *" [string trim $ps_line] " " ps_line 631 set cur_pid [lindex [split $ps_line " "] $PgAcVar(ps_pid_param)] 632 if {$selection_pid == $cur_pid} { 633 $base.list selection set $i 634 break 635 } 636 incr i 637 } 638 } 639 640 update_post_label $base 641 642 # reschedule ourselves 643 if {$PgAcVar(refresh_interval) >= 1} { 644 set i [expr {$PgAcVar(refresh_interval) * 1000}] 645 } else { 646 set i 100 647 } 648 649 # if we were called by the Refresh button, cancel old timeout 650 catch {after cancel $::Pgmonitor::PgAcVar(refresh_id)} 651 652 set PgAcVar(refresh_id) [after $i ::Pgmonitor::show_backends $base] 653} 654 655#---------------------------------------------------------- 656#---------------------------------------------------------- 657# 658proc ::Pgmonitor::try_ps_args {argc argv} { 659 variable PgAcVar 660 #global PgAcVar 661#global awk; 662#global debug; 663#global ps; 664#global ps_args; 665#global ps_cmd_col; 666#global ps_heading; 667#global ps_pid_arg; 668#global ps_pid_param; 669#global super_user; 670#global ps_user_arg; 671#global ps_user_end; 672 673 # This proc either validates the ps_args, ps_user_arg, 674 # ps_pid_arg values, or throws an error. If successful, derived 675 # information is stored into ps_pid_param and other globals. 676 677 # get USER column parameter number 678 set ps_heading_user [split [string trim [exec $PgAcVar(ps) $PgAcVar(ps_args) $PgAcVar(ps_pid_arg) 1 2>/dev/null | sed -n "1p" | sed "s/ */ /g"]] " "] 679 if {$PgAcVar(debug)} {puts stdout "ps_heading_user: $ps_heading_user"} 680 set ps_user_param -1 681 set i 0 682 foreach col $ps_heading_user { 683 if {[lindex $ps_heading_user $i] == "USER" || 684 [lindex $ps_heading_user $i] == "UID"} { 685 set ps_user_param $i 686 break 687 } 688 incr i 689 } 690 if {$ps_user_param == -1} { 691 error "Can't find USER/UID column heading" 692 } 693 if {$PgAcVar(debug)} {puts stdout "ps_user_param: $ps_user_param"} 694 695 # check other columns before we test for postmaster and 696 # and process arg columns 697 if {![string match "*PID*" $ps_heading_user]} { 698 error "Can't find PID column heading" 699 } 700 if {![string match "*COMMAND*" $ps_heading_user] && 701 ![string match "*CMD*" $ps_heading_user]} { 702 error "Can't find COMMAND/CMD column heading" 703 } 704 if {$PgAcVar(debug)} {puts stdout "Found PID and COMMAND/CMD columns"} 705 706 if {$PgAcVar(debug)} {puts stdout "ps command used will be: $PgAcVar(ps) $PgAcVar(ps_args) $PgAcVar(ps_user_arg) $PgAcVar(super_user)"} 707 708 # get end of user column so it can be clipped off 709 if {$ps_user_param == 0} { 710 set PgAcVar(ps_user_end) [expr {[string length $PgAcVar(super_user)] + 1}] 711 } else { 712 set PgAcVar(ps_user_end) 1 713 } 714 if {$PgAcVar(debug)} {puts stdout "ps_user_end: $PgAcVar(ps_user_end)"} 715 716 # get PID column parameter number 717 set ps_heading_nouser [split [string trim [exec $PgAcVar(ps) $PgAcVar(ps_args) $PgAcVar(ps_pid_arg) 1 | sed -n "1p" | cut -c$PgAcVar(ps_user_end)-255 | sed "s/ */ /g"]] " "] 718 if {$PgAcVar(debug)} {puts stdout "ps_heading_nouser: $ps_heading_nouser"} 719 set PgAcVar(ps_pid_param) -1 720 set i 0 721 foreach col $ps_heading_nouser { 722 if {[lindex $ps_heading_nouser $i] == "PID"} { 723 set PgAcVar(ps_pid_param) $i 724 break 725 } 726 incr i 727 } 728 if {$PgAcVar(ps_pid_param) == -1} { 729 #puts stderr "Can't find PID column heading" 730 731 if {[winfo ismapped .pgaw:Pgmonitor]} { 732 showError [intlmsg "Can't find PID column heading"] 733 } 734 return 735 #exit 1 736 } 737 if {$PgAcVar(debug)} {puts stdout "ps_pid_param: $PgAcVar(ps_pid_param)"} 738 739 # get a new heading without the user column 740 set PgAcVar(ps_heading) [exec $PgAcVar(ps) $PgAcVar(ps_args) $PgAcVar(ps_user_arg) $PgAcVar(super_user) | sed -n "1p" | cut -c$PgAcVar(ps_user_end)-255] 741 if {$PgAcVar(debug)} {puts stdout "ps_heading: $PgAcVar(ps_heading)"} 742 743 # find the column of the COMMAND/CMD 744 if {[string first "COMMAND" $PgAcVar(ps_heading)] != -1} { 745 set PgAcVar(ps_cmd_col) [string first "COMMAND" $PgAcVar(ps_heading)] 746 } elseif {[string first "CMD" $PgAcVar(ps_heading)] != -1} { 747 set PgAcVar(ps_cmd_col) [string first "CMD" $PgAcVar(ps_heading)] 748 } else { 749 if {[winfo ismapped .pgaw:Pgmonitor]} { 750 showError [intlmsg "Can't find COMMAND/CMD column heading"] 751 } 752 return 753 #puts stderr "Can't find COMMAND/CMD column heading" 754 #exit 1 755 } 756 if {$PgAcVar(debug)} {puts stdout "ps_cmd_col: $PgAcVar(ps_cmd_col)"} 757 758 # adjust heading to be the way we want it 759 set PgAcVar(ps_heading) [exec echo "$PgAcVar(ps_heading)" | $PgAcVar(awk) "\{ 760 printf \"%s %-10.10s%-10.10s%-17s %-s\\n\", 761 substr(\$0,1,[expr {$PgAcVar(ps_cmd_col) - 1}]), 762 \"USER\", \"DATABASE\", \"CONNECTION\", \"QUERY\" 763 \}"] 764 if {$PgAcVar(debug)} {puts stdout "ps_heading: $PgAcVar(ps_heading)"} 765} 766 767#---------------------------------------------------------- 768#---------------------------------------------------------- 769# 770proc ::Pgmonitor::set_ps_args {argc argv} { 771 variable PgAcVar 772 #global PgAcVar 773#global debug; 774#global ps; 775#global ps_args; 776#global ps_pid_arg; 777#global ps_user_arg; 778 779 set failure 1 780 781 # If customizing ps columns, the USER should be first, 782 # the PID should be second, and COMMAND/CMD last 783 784 # 785 # BSD-style ps arguments mean: 786 # 787 # x show processes with no controlling terminal 788 # w 132 column display 789 # w another 'w' means display as wide as needed, no limit 790 # o specify list of columns 791 # 792 # This option would be nice, but Linux treats it differently 793 # r sort by cpu usage 794 # 795 # On Linux, args with no dash are BSD args, else SysV 796 # 797 # set this to customize your ps command 798 set PgAcVar(ps) "ps" 799 800 set PgAcVar(ps_args) "xwwouser,pid,start,%mem,vsz,inblk,oublk,state,%cpu,time,command" 801 802 # U show only certain user's processes 803 set PgAcVar(ps_user_arg) "-U" 804 805 # p show pid 806 set PgAcVar(ps_pid_arg) "-p" 807 808 if {$PgAcVar(debug)} {puts stdout "Trying BSD-style ps args"} 809 810 if {$failure && 811 [set failure [catch {try_ps_args $argc $argv} msg]]} { 812 if {$PgAcVar(debug)} {puts stdout "Solaris custom ps args failed with: $msg\nTrying BSD-style -u on Solaris"} 813 # u display user information 814 # x show processes with no controlling terminal 815 # w 132 column display 816 # w another 'w' means display as wide as needed, no limit 817 set PgAcVar(ps_args) "uxww" 818 # Try Solaris first because this is the one that displays arg changes 819 set PgAcVar(ps) "/usr/ucb/ps" 820 } 821 822 if {$failure && 823 [set failure [catch {try_ps_args $argc $argv} msg]]} { 824 if {$PgAcVar(debug)} {puts stdout "BSD-style Solaris custom ps args failed with: $msg\nTrying non-Solaris"} 825 # Try ordinary ps 826 set PgAcVar(ps) "ps" 827 } 828 829 if {$failure && 830 [set failure [catch {try_ps_args $argc $argv} msg]] == 1} { 831 if {$PgAcVar(debug)} {puts stdout "BSD-style -u ps args failed with: $msg\nTrying SysV-style"} 832 # 833 # try SysV-style ps flags: 834 # 835 # f display full listing, needs dash 836 # e display all processes 837 set PgAcVar(ps_args) "-ef" 838 839 # u show only certain user's processes 840 set PgAcVar(ps_user_arg) "-u" 841 } 842 843 if {$failure && 844 [set failure [catch {try_ps_args $argc $argv} msg]] == 1} { 845 error "Can't run 'ps'\nPlease send in a patch.\nSee the README for more information on debugging." 846 } 847} 848 849#---------------------------------------------------------- 850#---------------------------------------------------------- 851# 852proc ::Pgmonitor::set_heading {base} { 853 variable PgAcVar 854 #global PgAcVar 855#global debug; 856#global ps_heading; 857#global ps_heading_split; 858#global ps_pre_cmd_params; 859 860 # load the heading 861 #$base.listboxscroll.border.heading insert 0 $PgAcVar(ps_heading) 862 863 if {[llength $PgAcVar(ps_heading)] == 0} {return 0} 864 865 set Head [list] 866 foreach H $PgAcVar(ps_heading) { 867 lappend Head 0 [string tolower $H] left 868 } 869 $base.list configure \ 870 -columns $Head 871 if {$PgAcVar(debug)} {puts stdout "ps_heading is: $PgAcVar(ps_heading)"} 872 873 # load ps heading values 874 regsub -all " *" [string trim $PgAcVar(ps_heading)] " " PgAcVar(ps_heading_split) 875 set PgAcVar(ps_heading_split) [split $PgAcVar(ps_heading_split) " "] 876 set PgAcVar(ps_pre_cmd_params) [expr {[llength $PgAcVar(ps_heading_split)] - 4}] 877 if {$PgAcVar(debug)} {puts stdout "ps_pre_cmd_params: $PgAcVar(ps_pre_cmd_params)"} 878} 879 880#---------------------------------------------------------- 881#---------------------------------------------------------- 882# 883proc ::Pgmonitor::set_awk {} { 884 variable PgAcVar 885 #global PgAcVar 886#global awk; 887#global debug; 888 889 # find awk version that supports gsub() 890 if {![catch {exec echo | awk "{gsub(\".\",\"\")}"}]} { 891 set PgAcVar(awk) "awk" 892 } elseif {![catch {exec echo | nawk "{gsub(\".\",\"\")}"}]} { 893 set PgAcVar(awk) "nawk" 894 } elseif {![catch {exec echo | gawk "{gsub(\".\",\"\")}"}]} { 895 set PgAcVar(awk) "gawk" 896 } else { 897 error "Can't find awk version that supports gsub()" 898 } 899 if {$PgAcVar(debug)} {puts stdout "awk version selected: $PgAcVar(awk)"} 900} 901 902#---------------------------------------------------------- 903#---------------------------------------------------------- 904# 905proc ::Pgmonitor::set_user {} { 906 variable PgAcVar 907 #global PgAcVar 908#global debug; 909#global user; 910 911 if [catch {exec id | cut -d "(" -f2 | cut -d ")" -f1} PgAcVar(user)] { 912 tk_messageBox -type ok -message "Can not determine your user name." 913 error "'id' command returns: $PgAcVar(user)" 914 return 915 } 916 if {$PgAcVar(debug)} {puts stdout "Username is: $PgAcVar(user)"} 917} 918 919#---------------------------------------------------------- 920#---------------------------------------------------------- 921# 922proc ::Pgmonitor::set_super_user {argc argv} { 923 variable PgAcVar 924 #global PgAcVar 925#global awk; 926#global debug; 927#global super_user; 928#global env; 929 930 if {[catch {set port "$env(PGPORT)"}]} { 931 set port 5432 932 } 933 934 # get pg username, either from command line or postmaster process owner 935 if {$argc>0} { 936 set PgAcVar(super_user) [lindex $argv 0] 937 # try PGDATA directory ownership 938 } elseif {![catch {exec ls -ld "$env(PGDATA)" | $PgAcVar(awk) "{print \$3}"} PgAcVar(super_user)]} { 939 # try user name for postmaster from lock file 940 } elseif {![catch {exec ls -l "/tmp/.s.PGSQL.$port.lock" | $PgAcVar(awk) "{print \$3}"} PgAcVar(super_user)]} { 941 # try user name for postmaster from socket 942 } elseif {![catch {exec ls -l "/tmp/.s.PGSQL.$port" | $PgAcVar(awk) "{print \$3}"} PgAcVar(super_user)]} { 943 } else { 944 if {[winfo ismapped .pgaw:Pgmonitor]} { 945 showError [intlmsg "Can't find Can't find the username of the PostgreSQL server.\ 946 Either start the post master, define PGDATA or PGPORT, or\ 947 supply the username on the command line."] 948 } 949 return 950 #puts stderr "Can't find the username of the PostgreSQL server.\nEither start the postmaster, define PGDATA or PGPORT, or\nsupply the username on the command line." 951 #exit 1 952 } 953 if {$PgAcVar(debug)} {puts stdout "super_user: $PgAcVar(super_user)"} 954} 955 956#---------------------------------------------------------- 957#---------------------------------------------------------- 958# 959proc ::Pgmonitor::set_pg_ctl_su {user super_user} { 960 variable PgAcVar 961#global debug; 962#global pg_ctl_su; 963 964 # set pg_ctl_su properly 965 if {$super_user == $user} { 966 set PgAcVar(pg_ctl_su) "sh" 967 } elseif {$user == "root"} { 968 # Linux needs -m to preserve environment/PATH 969 set PgAcVar(pg_ctl_su) "su -m $super_user" 970 } else { 971 set PgAcVar(pg_ctl_su) "" 972 } 973 if {$PgAcVar(debug)} {puts stdout "pg_ctl_su: $PgAcVar(pg_ctl_su)"} 974} 975 976#---------------------------------------------------------- 977#---------------------------------------------------------- 978# 979proc ::Pgmonitor::set_pg_ctl_nowait {} { 980 variable PgAcVar 981 #global PgAcVar 982#global debug; 983#global pg_ctl_nowait; 984#global pg_ctl_su; 985 986 # determine no-wait pg_ctl parameter 987 if {$PgAcVar(pg_ctl_su) != ""} { 988 if [catch {eval exec $PgAcVar(pg_ctl_su) -c {"pg_ctl -W -h"}}] { 989 set PgAcVar(pg_ctl_nowait) "" 990 } else { 991 set PgAcVar(pg_ctl_nowait) "-W" 992 } 993 if {$PgAcVar(debug)} {puts stdout "pg_ctl_nowait: $PgAcVar(pg_ctl_nowait)"} 994 } 995} 996 997#---------------------------------------------------------- 998#---------------------------------------------------------- 999# 1000proc ::Pgmonitor::set_buttons {base user super_user} { 1001 variable PgAcVar 1002 #global PgAcVar 1003#global debug; 1004#global pg_ctl_su; 1005 1006 if {$user != "root" && $user != $super_user} { 1007 puts stderr "Not running as PostgreSQL super user or root. Inappropriate buttons removed." 1008 destroy $base.button.query 1009 destroy $base.button.cancel 1010 destroy $base.button.terminate 1011 destroy $base.button.start_stop 1012 } else { 1013 # Is postgres in our path? If not, remove query button 1014 if {[catch {eval exec postgres --help} postgres_out]} { 1015 puts stderr "Can not find postgres executable. Query button removed." 1016 if {$PgAcVar(debug)} {puts stdout "postgres output: $postgres_out"} 1017 catch {destroy $base.button.query} 1018 } 1019 } 1020 1021 # Is pg_ctl in our path? If not, remove postmaster button 1022 if {$PgAcVar(pg_ctl_su) != "" && 1023 [catch {eval exec $PgAcVar(pg_ctl_su) -c {"pg_ctl --help"}} pg_ctl_out]} { 1024 puts stderr "Can not find pg_ctl executable or \$PGDATA not set. Postmaster status button removed." 1025 if {$PgAcVar(debug) && $PgAcVar(pg_ctl_su) != ""} {puts stdout "pg_ctl output: $pg_ctl_out"} 1026 catch {destroy $base.button.start_stop} 1027 set PgAcVar(pg_ctl_su) "" 1028 } 1029} 1030 1031#---------------------------------------------------------- 1032#---------------------------------------------------------- 1033# 1034proc ::Pgmonitor::widget_init {argc argv base} { 1035 variable PgAcVar 1036 variable Win 1037 #global PgAcVar 1038#global debug; 1039#global no_#global_query_symbol; 1040#global super_user; 1041#global refresh_id; 1042#global refresh_interval; 1043#global user; 1044 1045 if {$base == ""} { 1046 set base . 1047 } 1048 1049 set_defaults 1050 set_awk; 1051 set_user; 1052 set_super_user $argc $argv 1053 set_pg_ctl_su $PgAcVar(user) $PgAcVar(super_user) 1054 set_pg_ctl_nowait 1055 1056 set_ps_args $argc $argv 1057 set_heading $base 1058 load_preferences 1059 1060 set PgAcVar(no_global_query_symbol) "N" 1061 1062 set_buttons $base $PgAcVar(user) $PgAcVar(super_user) 1063 1064 show_backends $base 1065 1066 focus $base.list 1067 1068 # keyboard defaults 1069 bind all <Control-c> {destroy .pgaw:Pgmonitor} 1070 bind .pgaw:Pgmonitor <Destroy> {save_preferences; catch {after cancel $::Pgmonitor::PgAcVar(refresh_id)}} 1071 1072 # not sure why this is needed, but hangs without it 1073 # vtcl has trouble with this, not sure why 1074 bind .pgaw:Pgmonitor <Destroy> {destroy .pgaw:Pgmonitor} 1075 # vtcl has trouble with this because it is dynamically loaded 1076 #load_sort_buttons 1077 1078 wm withdraw .query_popup 1079 #wm withdraw .sort_options 1080 1081 set PgAcVar(initialized) 1 1082} 1083 1084#---------------------------------------------------------- 1085#---------------------------------------------------------- 1086# 1087proc ::Pgmonitor::main {argc argv} { 1088 1089 variable Win 1090 1091 widget_init $argc $argv $Win(base) 1092 1093 return 1094} 1095 1096#---------------------------------------------------------- 1097#---------------------------------------------------------- 1098# 1099proc ::Pgmonitor::Window {args} { 1100global vTcl 1101 set cmd [lindex $args 0] 1102 set name [lindex $args 1] 1103 set newname [lindex $args 2] 1104 set rest [lrange $args 3 end] 1105 if {$name == "" || $cmd == ""} {return} 1106 if {$newname == ""} { 1107 set newname $name 1108 } 1109 set exists [winfo exists $newname] 1110 switch $cmd { 1111 show { 1112 if {$exists == "1" && $name != "."} {wm deiconify $name; return} 1113 if {[info procs vTclWindow(pre)$name] != ""} { 1114 eval "vTclWindow(pre)$name $newname $rest" 1115 } 1116 if {[info procs vTclWindow$name] != ""} { 1117 eval "vTclWindow$name $newname $rest" 1118 } 1119 if {[info procs vTclWindow(post)$name] != ""} { 1120 eval "vTclWindow(post)$name $newname $rest" 1121 } 1122 } 1123 hide { if $exists {wm withdraw $newname; return} } 1124 iconify { if $exists {wm iconify $newname; return} } 1125 destroy { if $exists {destroy $newname; return} } 1126 } 1127} 1128 1129################################# 1130# VTCL GENERATED GUI PROCEDURES 1131# 1132 1133#proc vTclWindow. {base} { 1134# if {$base == ""} { 1135# set base . 1136# } 1137# ################### 1138# # CREATING WIDGETS 1139# ################### 1140# wm focusmodel $base active 1141# wm geometry $base 200x200 1142# wm maxsize $base 1009 738 1143# wm minsize $base 1 1 1144# wm overrideredirect $base 0 1145# wm resizable $base 1 1 1146# wm withdraw $base 1147# wm title $base "vt.tcl" 1148# ################### 1149# # SETTING GEOMETRY 1150# ################### 1151#} 1152 1153#---------------------------------------------------------- 1154#---------------------------------------------------------- 1155# 1156proc vTclWindow.query_popup {base} { 1157 if {$base == ""} { 1158 set base .query_popup 1159 } 1160 if {[winfo exists $base]} { 1161 wm deiconify $base; return 1162 } 1163 ################### 1164 # CREATING WIDGETS 1165 ################### 1166 toplevel $base -class Toplevel \ 1167 -background #c4eeec -borderwidth 2 1168 wm focusmodel $base passive 1169 wm geometry $base 647x298 1170 wm maxsize $base 1009 738 1171 wm minsize $base 1 1 1172 wm overrideredirect $base 0 1173 wm resizable $base 1 1 1174 wm deiconify $base 1175 wm title $base "Query String" 1176 frame $base.listboxscroll \ 1177 -background #c4eeec -highlightbackground #c4eeec 1178 scrollbar $base.listboxscroll.xscroll \ 1179 -activebackground #ecf0a4 -background #ecf0a4 \ 1180 -command {.query_popup.listboxscroll.border.list xview} \ 1181 -highlightbackground #c4eeec -highlightthickness 0 -orient horizontal \ 1182 -takefocus 0 -troughcolor #c4eeec 1183 scrollbar $base.listboxscroll.yscroll \ 1184 -activebackground #ecf0a4 -background #ecf0a4 \ 1185 -command {.query_popup.listboxscroll.border.list yview} \ 1186 -highlightbackground #c4eeec -highlightthickness 0 -takefocus 0 \ 1187 -troughcolor #c4eeec 1188 frame $base.listboxscroll.border \ 1189 -background #ecf0a4 -borderwidth 4 -highlightbackground #c4eeec \ 1190 -relief sunken 1191 listbox $base.listboxscroll.border.list \ 1192 -background #ecf0a4 -borderwidth 0 -font {Fixed -12 bold} -height 1 \ 1193 -highlightbackground #e8dc4c -highlightthickness 0 -relief flat \ 1194 -selectbackground #dade4a -takefocus 1 -width 1 \ 1195 -xscrollcommand {.query_popup.listboxscroll.xscroll set} \ 1196 -yscrollcommand {.query_popup.listboxscroll.yscroll set} 1197 button $base.exit \ 1198 -activebackground #fe4020 -activeforeground #ecf0a4 \ 1199 -background #be4020 -command {wm withdraw .query_popup} \ 1200 -foreground #ecf0a4 -padx 9 -pady 3 -takefocus 1 -text Close 1201 ################### 1202 # SETTING GEOMETRY 1203 ################### 1204 pack $base.listboxscroll \ 1205 -in .query_popup -anchor center -expand 1 -fill both -side top 1206 pack $base.listboxscroll.xscroll \ 1207 -in .query_popup.listboxscroll -anchor center -expand 0 -fill x \ 1208 -side bottom 1209 pack $base.listboxscroll.yscroll \ 1210 -in .query_popup.listboxscroll -anchor center -expand 0 -fill y \ 1211 -side right 1212 pack $base.listboxscroll.border \ 1213 -in .query_popup.listboxscroll -anchor center -expand 1 -fill both \ 1214 -padx 6 -pady 6 -side top 1215 pack $base.listboxscroll.border.list \ 1216 -in .query_popup.listboxscroll.border -anchor center -expand 1 \ 1217 -fill both -padx 5 -pady 6 -side bottom 1218 pack $base.exit \ 1219 -in .query_popup -anchor e -expand 0 -fill x -padx 5 -pady 5 \ 1220 -side bottom 1221} 1222 1223#---------------------------------------------------------- 1224#---------------------------------------------------------- 1225# 1226proc vTclWindow.sort_options {base} { 1227 if {$base == ""} { 1228 set base .sort_options 1229 } 1230 if {[winfo exists $base]} { 1231 wm deiconify $base; return 1232 } 1233 ################### 1234 # CREATING WIDGETS 1235 ################### 1236 toplevel $base -class Toplevel \ 1237 -background #c4eeec -borderwidth 2 1238 wm focusmodel $base passive 1239 wm geometry $base 244x513 1240 wm maxsize $base 1009 738 1241 wm minsize $base 1 1 1242 wm overrideredirect $base 0 1243 wm resizable $base 1 1 1244 wm deiconify $base 1245 wm title $base "Sort Options" 1246 label $base.sort_column \ 1247 -background #c4eeec -text Column 1248 frame $base.column \ 1249 -background #ecf0a4 -borderwidth 2 -relief sunken 1250 label $base.sort_order \ 1251 -background #c4eeec -text Order 1252 frame $base.order \ 1253 -background #ecf0a4 -borderwidth 2 -relief sunken 1254 radiobutton $base.order.ascending \ 1255 -background #ecf0a4 -highlightthickness 0 -text Ascending \ 1256 -variable ::Pgmonitor::PgAcVar(sort_order) 1257 radiobutton $base.order.descending \ 1258 -background #ecf0a4 -highlightthickness 0 -text Descending -value r \ 1259 -variable ::Pgmonitor::PgAcVar(sort_order) 1260 label $base.sort_type \ 1261 -background #c4eeec -text Type 1262 frame $base.type \ 1263 -background #ecf0a4 -borderwidth 2 -relief sunken 1264 radiobutton $base.type.numeric \ 1265 -background #ecf0a4 -highlightthickness 0 -text Numeric -value n \ 1266 -variable ::Pgmonitor::PgAcVar(sort_type) 1267 radiobutton $base.type.alphabetic \ 1268 -background #ecf0a4 -highlightthickness 0 -text Alphabetic \ 1269 -variable ::Pgmonitor::PgAcVar(sort_type) 1270 button $base.exit \ 1271 -activebackground #fe4020 -activeforeground #ecf0a4 \ 1272 -background #be4020 -command {wm withdraw .sort_options} \ 1273 -foreground #ecf0a4 -padx 9 -pady 3 -takefocus 1 -text Close 1274 ################### 1275 # SETTING GEOMETRY 1276 ################### 1277 pack $base.sort_column \ 1278 -in .sort_options -anchor w -expand 1 -fill both -side top 1279 pack $base.column \ 1280 -in .sort_options -anchor w -expand 1 -fill x -side top 1281 pack $base.sort_order \ 1282 -in .sort_options -anchor w -expand 1 -fill both -side top 1283 pack $base.order \ 1284 -in .sort_options -anchor w -expand 1 -fill x -side top 1285 pack $base.order.ascending \ 1286 -in .sort_options.order -anchor w -expand 0 -fill none -side top 1287 pack $base.order.descending \ 1288 -in .sort_options.order -anchor w -expand 0 -fill none -side top 1289 pack $base.sort_type \ 1290 -in .sort_options -anchor w -expand 1 -fill both -side top 1291 pack $base.type \ 1292 -in .sort_options -anchor w -expand 1 -fill x -side top 1293 pack $base.type.numeric \ 1294 -in .sort_options.type -anchor w -expand 0 -fill none -side top 1295 pack $base.type.alphabetic \ 1296 -in .sort_options.type -anchor w -expand 0 -fill none -side top 1297 pack $base.exit \ 1298 -in .sort_options -anchor e -expand 0 -fill x -padx 5 -pady 5 \ 1299 -side bottom 1300} 1301 1302#---------------------------------------------------------- 1303#---------------------------------------------------------- 1304# 1305proc vTclWindow.pgaw:Pgmonitor {base} { 1306 1307 if {$base == ""} { 1308 set base .pgaw:Pgmonitor 1309 } 1310 1311 set ::Pgmonitor::Win(base) $base 1312 1313 if {[winfo exists $base]} { 1314 wm deiconify $base; return 1315 } 1316 1317 ################### 1318 # CREATING WIDGETS 1319 ################### 1320 toplevel $base -class Pgmonitor \ 1321 -borderwidth 2 1322 wm focusmodel $base passive 1323 wm geometry $base 725x350 1324 wm maxsize $base 1009 738 1325 wm minsize $base 1 1 1326 wm overrideredirect $base 0 1327 wm resizable $base 1 1 1328 wm deiconify $base 1329 1330 if {([info exists ::env(HOSTNAME)]) && (![string match "" $::env(HOSTNAME)])} { 1331 wm title $base "pgmonitor - HOST: $::env(HOSTNAME)" 1332 1333 set Pgmonitor::PgAcVar(status) "HOST: $::env(HOSTNAME)" 1334 } else { 1335 wm title $base "pgmonitor" 1336 } 1337# frame $base.listboxscroll \ 1338# -background #c4eeec -highlightbackground #c4eeec 1339 scrollbar $base.xscroll \ 1340 -command {.pgaw:Pgmonitor.list xview} \ 1341 -highlightthickness 0 -orient horizontal \ 1342 -takefocus 0 1343 scrollbar $base.yscroll \ 1344 -command {.pgaw:Pgmonitor.list yview} \ 1345 -highlightthickness 0 -takefocus 0 1346# frame $base.listboxscroll.border \ 1347# -background #ecf0a4 -borderwidth 4 -highlightbackground #c4eeec \ 1348# -relief sunken 1349# listbox $base.listboxscroll.border.heading \ 1350# -background #ecf0a4 -font {Fixed -12 bold} -height 1 \ 1351# -highlightbackground #e8dc4c -highlightthickness 0 -relief raised \ 1352# -selectbackground #dade4a -takefocus 0 -width 1 \ 1353# -xscrollcommand {.pgaw:Pgmonitor.listboxscroll.xscroll set} 1354# listbox $base.listboxscroll.border.list \ 1355# -background #ecf0a4 -borderwidth 0 -font {Fixed -12 bold} -height 1 \ 1356# -highlightbackground #e8dc4c -highlightthickness 0 -relief flat \ 1357# -selectbackground #dade4a -takefocus 1 -width 1 \ 1358# -xscrollcommand {.pgaw:Pgmonitor.listboxscroll.xscroll set} \ 1359# -yscrollcommand {.pgaw:Pgmonitor.listboxscroll.yscroll set} 1360 1361 set Win(mclist) [tablelist::tablelist $base.list \ 1362 -yscrollcommand {.pgaw:Pgmonitor.yscroll set} \ 1363 -xscrollcommand {.pgaw:Pgmonitor.xscroll set} \ 1364 -labelcommand tablelist::sortByColumn \ 1365 -background #fefefe \ 1366 -stripebg #e0e8f0 \ 1367 -selectbackground #DDDDDD \ 1368 -font {Helvetica 10} \ 1369 -labelfont {Helvetica 11 bold} \ 1370 -stretch all \ 1371 -selectforeground #708090 \ 1372 -labelbackground #DDDDDD \ 1373 -labelforeground navy 1374 ] 1375 1376 set body [$Win(mclist) bodypath] 1377 bind $body <Double-Button-1> [bind TablelistBody <Double-Button-1>] 1378 bind $body <Double-Button-1> +[list ::Pgmonitor::show_query .pgaw:Pgmonitor .query_popup] 1379 #bind $base.listboxscroll.border.list <Double-Button-1> { 1380 #::Pgmonitor::show_query .pgaw:Pgmonitor .query_popup 1381 #} 1382 #bind $base.listboxscroll.border.list <Key-Return> { 1383 #::Pgmonitor::show_query {$base .query_popup} 1384 #} 1385 frame $base.button 1386 button $base.button.refresh \ 1387 -command {after idle {::Pgmonitor::show_backends .pgaw:Pgmonitor}} \ 1388 -padx 9 -pady 3 -takefocus 1 -text Refresh 1389 bind $base.button.refresh <Button-3> { 1390 tk_messageBox -type ok -message "Refreshes the process listing." 1391 } 1392 #scrollbar $base.button.refresh_scroll \ 1393 #-command {::Pgmonitor::adjust_refresh_setting} -orient vert \ 1394 #-width 7 1395 SpinBox $base.button.refresh_scroll \ 1396 -range {1 500 1} \ 1397 -textvariable ::Pgmonitor::PgAcVar(refresh_interval) \ 1398 -width 5 1399 1400 set ::Pgmonitor::PgAcVar(refresh_interval) 10 1401 1402 #label $base.button.refresh_setting \ 1403 #-anchor e -padx 0 -pady 0 -text 1 \ 1404 #-textvariable ::Pgmonitor::PgAcVar(refresh_interval) -width 3 1405 label $base.button.seconds \ 1406 -anchor w -padx 0 -pady 3 -text seconds -width 7 1407 #button $base.button.sort \ 1408 #-command {::Pgmonitor::show_sort_options .sort_options} \ 1409 #-padx 9 -pady 3 -takefocus 1 -text Sort 1410 #bind $base.button.sort <Button-3> { 1411 #tk_messageBox -type ok -message "Allows sorting of processes." 1412 #} 1413 button $base.button.query \ 1414 -command {::Pgmonitor::show_query .pgaw:Pgmonitor .query_popup} \ 1415 -padx 9 -pady 3 -takefocus 1 -text Query 1416 bind $base.button.query <Button-3> { 1417 tk_messageBox -type ok -message "Shows query currently executing by a process.\nDouble-clicking on a process does the same thing." 1418 } 1419 button $base.button.cancel \ 1420 -command {::Pgmonitor::send_signal .pgaw:Pgmonitor 2} \ 1421 -padx 9 -pady 3 -takefocus 1 -text Cancel 1422 bind $base.button.cancel <Button-3> { 1423 tk_messageBox -type ok -message "Cancels the currently running query." 1424 } 1425 button $base.button.terminate \ 1426 -command {::Pgmonitor::send_signal .pgaw:Pgmonitor 15} \ 1427 -padx 9 -pady 3 -takefocus 1 -text Terminate 1428 bind $base.button.terminate <Button-3> { 1429 tk_messageBox -type ok -message "Terminates the process." 1430 } 1431 button $base.button.start_stop \ 1432 -command {::Pgmonitor::start_stop_postmaster .pgaw:Pgmonitor} \ 1433 -padx 9 -pady 3 -takefocus 1 -textvariable ::Pgmonitor::PgAcVar(post_label) 1434 bind $base.button.start_stop <Button-3> { 1435 tk_messageBox -type ok -message "Starts up and shuts down the postmaster. Shutdown waits for all clients to exit. Shutdown (force) terminates all clients immediately." 1436 } 1437 button $base.button.exit \ 1438 -command {::Pgmonitor::close} -padx 9 \ 1439 -pady 3 -takefocus 1 -text Close 1440 1441 if {$::Pgmonitor::PgAcVar(standalone)} { 1442 $base.button.exit configure -text Exit 1443 } 1444 bind $base.button.exit <Button-3> { 1445 tk_messageBox -type ok -message "Exits the application." 1446 } 1447 button $base.button.help \ 1448 -command ::Pgmonitor::help -padx 9 \ 1449 -pady 3 -takefocus 1 -text Help 1450 bind $base.button.help <Button-3> { 1451 tk_messageBox -type ok -message "You want help about 'help'?" 1452 } 1453 1454 frame $base.label 1455 1456 label $base.label.hostname \ 1457 -textvariable ::Pgmonitor::PgAcVar(status) \ 1458 -relief groove \ 1459 -font [list Helvetica 12 bold] \ 1460 -foreground navy 1461 1462 ################### 1463 # SETTING GEOMETRY 1464 ################### 1465 #pack $base.listboxscroll \ 1466 #-in .top -anchor center -expand 1 -fill both -side top 1467 1468 pack $base.label \ 1469 -side bottom \ 1470 -anchor w 1471 1472 pack $base.label.hostname \ 1473 -side left \ 1474 -expand 1 \ 1475 -ipadx 4 1476 1477 pack $base.button \ 1478 -in .pgaw:Pgmonitor -anchor center -expand 0 -fill x -side bottom 1479 pack $base.xscroll \ 1480 -in .pgaw:Pgmonitor -anchor center -expand 0 -fill x -side bottom 1481 pack $base.yscroll \ 1482 -in .pgaw:Pgmonitor -anchor center -expand 0 -fill y -side right 1483 #pack $base.listboxscroll.border \ 1484 #-in .pgaw:Pgmonitor.listboxscroll -anchor center -expand 1 -fill both -padx 6 \ 1485 #-pady 6 -side top 1486 #pack $base.listboxscroll.border.heading \ 1487 #-in .pgaw:Pgmonitor.listboxscroll.border -anchor center -expand 0 -fill x \ 1488 #-padx 5 -pady 6 -side top 1489 pack $base.list \ 1490 -in .pgaw:Pgmonitor -anchor center -expand 1 -fill both \ 1491 -padx 5 -pady 6 -side top 1492 pack $base.button.refresh \ 1493 -in .pgaw:Pgmonitor.button -anchor e -expand 0 -fill none -padx 5 -pady 5 \ 1494 -side left 1495 pack $base.button.refresh_scroll \ 1496 -in .pgaw:Pgmonitor.button -anchor center -expand 0 -fill none -side left 1497 #pack $base.button.refresh_setting \ 1498 #-in .pgaw:Pgmonitor.button -anchor e -expand 0 -fill none -side left 1499 pack $base.button.seconds \ 1500 -in .pgaw:Pgmonitor.button -anchor center -expand 0 -fill none -side left 1501 #pack $base.button.sort \ 1502 #-in .pgaw:Pgmonitor.button -anchor e -expand 0 -fill none -padx 5 -pady 5 \ 1503 #-side left 1504 pack $base.button.query \ 1505 -in .pgaw:Pgmonitor.button -anchor e -expand 1 -fill none -padx 5 -pady 5 \ 1506 -side left 1507 pack $base.button.cancel \ 1508 -in .pgaw:Pgmonitor.button -anchor e -expand 0 -fill none -padx 5 -pady 5 \ 1509 -side left 1510 pack $base.button.terminate \ 1511 -in .pgaw:Pgmonitor.button -anchor e -expand 0 -fill none -padx 5 -pady 5 \ 1512 -side left 1513 pack $base.button.start_stop \ 1514 -in .pgaw:Pgmonitor.button -anchor e -expand 0 -fill none -padx 5 -pady 5 \ 1515 -side left 1516 pack $base.button.exit \ 1517 -in .pgaw:Pgmonitor.button -anchor e -expand 0 -fill none -padx 5 -pady 5 \ 1518 -side right 1519 pack $base.button.help \ 1520 -in .pgaw:Pgmonitor.button -anchor e -expand 1 -fill none -padx 5 -pady 5 \ 1521 -side right 1522 1523} 1524 1525#Window show . 1526#Window show .query_popup 1527#Window show .sort_options 1528#Window show .top 1529 1530#main $argc $argv 1531 1532#puts "PS: $PgAcVar(ps) ARGS: $PgAcVar(ps_args) USER: $PgAcVar(ps_user_arg) SUPER: $PgAcVar(super_user) END: $PgAcVar(ps_user_end)" 1533 1534## 1535## This lets pgmonitor.tcl to startup standalone. Note 1536## that at this time, SpinBox and tablelist are required 1537## 1538if {([info exists argv0]) && ([string match "pgmonitor.tcl" $argv0])} { 1539 package require tablelist 1540 package require BWidget 1541 1542 Pgmonitor::openWin 1543 1544 wm withdraw . 1545 1546 .pgaw:Pgmonitor.button.exit configure \ 1547 -command exit \ 1548 -text exit 1549} 1550