#!perl -w
use Tk;
use DBI;
use encoding \'euc_cn\';
###创建窗体
my $mw = MainWindow->new(-title => "system monitor");
##定义左边菜单框体
$FRAME_L = $mw->Frame->pack(qw/-side left -fill both /);
#定义下拉菜单框
$WIDGET_F = $FRAME_L->Labelframe()->pack(qw/-side top -fill both -expand 1 /);
####定义菜单##########################################################################
#
#\'Widget\' 可以试任何的部件支持滚动条 比如 Text,Listbox,etc
#
#
my $frm_menu = $mw -> Frame() ->pack(-side=>"top",-fill => \'x\');
#my $txt = $frm_menu -> Scrolled(\'Text\',-width => 50,-scrollbars=>\'e\') -> pack ();
#Declare that there is a menu
my $mbar = $frm_menu -> Menu();
$mw -> configure(-menu => $mbar);
#The Main Buttons
my $file = $mbar -> cascade(-label=>"File", -underline=>0, -tearoff => 0);
my $others = $mbar -> cascade(-label =>"others", -underline=>0, -tearoff => 0);
my $tools = $mbar -> cascade(-label =>"tools", -underline=>0, -tearoff => 0);
my $help = $mbar -> cascade(-label =>"Help", -underline=>0, -tearoff => 0);
## File Menu ##
$file -> command(-label => "New", -underline=>0,
-command=>sub { $txt -> delete(\'10\',\'end\');} );
$file -> checkbutton(-label =>"Open", -underline => 0,
-command => [\&menuClicked, "Open"]);
$file -> command(-label =>"Save", -underline => 0,
-command => [\&menuClicked, "Save"]);
$file -> separator();
$file -> command(-label =>"Exit", -underline => 1,
-command => sub { exit } );
## Others Menu ##
my $insert = $others -> cascade(-label =>"Insert", -underline => 0, -tearoff => 0);
$insert -> command(-label =>"Name",
-command => sub { $txt->insert(\'end\',"Name : Binny V A\n");});
$insert -> command(-label =>"Website", -command=>sub {
$txt->insert(\'end\',"Website : http://wwwgeocitiescom/binnyva/\n");});
$insert -> command(-label =>"Email",
-command=> sub {$txt->insert(\'end\',"E-Mail : binnyva\@hotmailcom\n");});
$others -> command(-label =>"Insert All", -underline => 7,
-command => sub { $txt->insert(\'end\',"Name : Binny V A
Website : http://wwwgeocitiescom/binnyva/
E-Mail : binnyva\@hotmailcom");
});
## Help ##
$help -> command(-label =>"About", -command => sub {
$txt->delete(\'10\',\'end\');
$txt->insert(\'end\',
"About
----------
This script was created to make a menu for a\nPerl/Tk tutorial
Made by Binny V A
Website : http://wwwgeocitiescom/binnyva/code
E-Mail : binnyva\@hotmailcom"); });
sub menuClicked {
my ($opt) = @_;
$mw->messageBox(-message=>"You have clicked $opt
This function is not implanted yet");
}
#################################################菜单结束#######################
$code_font = $mw->fontCreate(-family => \'黑体\',-size => 12);
##定义下拉菜单
my %section = (
"1-system info" => ["VIEW CPU","VIEW MEMORY","VIEW DISK"],
"2-midware info" => [4,5,6],
"3-database info" => [7,8,9],
"4-餐桌登记" => [10],
"5-结账登记" => [11],
);
my (@frames,@button);
my %sub_of = (
"VIEW CPU" =>\&push_button1,
"VIEW MEMORY" => sub{ print "program 2" },
"VIEW DISK" => sub{ print "program 3" },
4 => sub{ print "program 4" },
5 => sub{ print "program 5" },
6 => sub{ print "program 6" },
7 => sub{ print "program 7" },
8 => sub{ print "program 8" },
9 => sub{ print "program 9" },
);
##############push_button1开始#######################
sub push_button1 {
my $mw = new MainWindow; # Main Window
my $frm_name1 = $mw -> Frame()->pack(-side=>"top",-fill => \'x\');
my $lab1 = $frm_name1 -> Label(-text=>"Host Ip",-width=>10) -> pack(-side=>"left",-ipadx=>20,-ipady=>20);
my $ent1 = $frm_name1 -> Entry() -> pack(-side=>"left",-ipadx=>20);
my $lab2 = $frm_name1 -> Label(-text=>"Start date",-width=>10) -> pack(-side=>"left",-ipadx=>20,-ipady=>20);
my $ent2 = $frm_name1 -> Entry() -> pack(-side=>"left",-ipadx=>20);
my $lab3= $frm_name1 -> Label(-text=>"Stop date",-width=>10) -> pack(-side=>"left",-ipadx=>20,-ipady=>20);
my $ent3 = $frm_name1 -> Entry() -> pack(-side=>"left",-ipadx=>20);
my $but1 = $frm_name1 -> Button(-text => "ok",-command =>\&sub_fun1)-> pack(-side=>"left",-ipadx=>20,-padx=>30);
my $but2 = $frm_name1 -> Button(-text => "clear table",-command =>\&sub_clear1)-> pack(-side=>"left",-ipadx=>20,-padx=>30);
###############定义表格开始
$mw->geometry("475x122");
#禁止窗口缩放
#$mw->resizable(0,0);
my $table_frame = $mw->Frame()->pack(-expand => 1,-fill => \'both\');
my $table = $table_frame->Table(-columns => 10,
-rows => 26,
-fixedrows => 1,
-scrollbars => \'oe\',
-relief => \'raised\');
#@arr1 = qw/HOST FILESYSTEM TYPE SIZE# USED AVAIL USE MOUNTED SYSDATE/;
##使用hash数组
my %hash=("1","HOST",
"2","FILESYSTEM",
"3","TYPE",
"4","SIZE#",
"5","USED",
"6","AVAIL",
"7","USE",
"8","MOUNTED",
"9","SYSDATE");
foreach $key (sort keys %hash)
{ my $var = $hash{$key};
print "\$var is $var\n";
my $tmp_label = $table->Label(-text => $var, -width => 22, -relief =>\'raised\');
##放到第0行 第N列
$table->put(0, $key, $tmp_label);
}
##创建100行
my $tmp_label="";
foreach my $row (1 .. 100)
{
foreach my $col (1 .. 10)
{
my $tmp_label = $table->Label(-text => "",
-padx => 0,
-anchor => \'w\',
-background => \'white\',
-relief => "groove");
$table->put($row, $col, $tmp_label);
}
}
$table->pack(-expand => 1,-fill => \'both\');
##borderwidth 边框属性
my $button_frame = $mw->Frame( -borderwidth => 4 )->pack();
$button_frame->Button(-text => "Exit", -command => sub {exit})->pack();
#my $frm4 = $mw -> Frame() ->pack(-side=>"top",-fill => \'x\');
#Text Area
#my $txt = $frm4 -> Text(-width=>108,-height=>40) -> pack(-fill => \'both\');
#
#定义表格结束
sub sub_clear1{
my $tmp_label="";
foreach my $row (1 .. 90)
{
foreach my $col (1 .. 10)
{
my $tmp_label = $table->Label(-text => "",
-padx => 0,
-anchor => \'w\',
-background => \'white\',
-relief => "groove");
$table->put($row, $col, $tmp_label);
}
}
$table->pack(-expand => 1,-fill => \'both\');
}
sub sub_fun1{
my $dbName = \'june\';
my $dbUser = \'test\';
my $dbUserPass = \'test\';
my $name1 = $ent1 -> get();
my $name2 = $ent2 -> get();
my $name3 = $ent3 -> get();
my $dbh = DBI->connect("dbi:Oracle:$dbName", $dbUser, $dbUserPass) or die "can\'t connect to database " ;
my $hostSql = qq{select trim(HOST),trim(FILESYSTEM),trim(TYPE),trim(SIZE#),trim(USED),trim(AVAIL),trim(USE),trim(MOUNTED),to_char(SYSDATE\,\'yyyy-mm-dd:Hh24:Mm:Ss\') from cpu_info where host=\'$name1\'};
@arr2="";
$var2="";
$tmp_label="";
$var3="";
$i=0;
my ($a1, $a2, $a3,$a4,$a5,$a6,$a7,$a8,$a9);
my $selStmt = $dbh->prepare($hostSql);
$selStmt->bind_columns(undef, \$a1, \$a2, \$a3,\$a4,\$a5,\$a6,\$a7,\$a8,\$a9);
$selStmt->execute();
while( $selStmt->fetch() ){
push (@arr2, "$a1\t$a2\t$a3\t$a4\t$a5\t$a6\t$a7\t$a8\t$a9\n" );
#循环取数组元素个数
$var2=@arr2 -1 ;
$i=0;
foreach $var3 ("$a1","$a2","$a3","$a4","$a5","$a6","$a7","$a8","$a9"){
$i++;
print "\$i is $i\n";
print "\$var3 is $var3\n";
my $tmp_label = $table->Label(-text => "$var3",
-padx => 0,
-anchor => \'w\',
-background => \'white\',
-relief => "groove");
$table->put($var2, $i, $tmp_label);
}
}
print "\$var2 is $var2\n";
print "1---\@arr2 is @arr2\n";
print "\$arr2[1] is $arr2[1]\n";
print "\$arr2[2] is $arr2[2]\n";
$selStmt->finish;
$dbh->disconnect;
}
}
##############push_button1结束#######################
for my $sect_name (sort keys %section) {
##按键排序,$sect_name表示键名
my $b;
##$WIDGET_F = $FRAME_L->Labelframe()->pack(qw/-side top -fill both -expand 1/); 标签框上布局
##$f 框体
my $f = $WIDGET_F->Frame(
##background 按钮处于正常状态时候的背景颜色 -bg = -background
-background => \'white\',
##指定按钮的3D效果
-relief => \'raised\',
-borderwidth => 1
);
###Radiobutton 单选按钮 $sect_name键名
$b = $WIDGET_F->Radiobutton(
-text => $sect_name,
-font => $code_font,
-indicatoron => 0,
-value => $sect_name,
-width => 25,
# -bg => \'#af1a3c6a6872\',
-bg =>\'green\',
##-foreground => color
-fg => \'black\',
-command => sub {
$_->packForget for @frames;
$f->pack(
-after => $b,
qw/-side top -fill both -expand 1 -padx 1 -pady 1/
);
}
)->pack(qw/-fill x -side top -padx 1 -pady 1/);
## $section{$sect_name} 将值付给数组,这里的$par_tmp就是1 2 3 4 5 6 7 8 9
#
## 访问hash数组元素 元素形式: $hash{\'a\'}
for my $par_tmp (@{ $section{$sect_name} }) {
$fun=\'$sub_of{$par_tmp}\';
$f->Button(
-text => "$par_tmp",
-relief => \'ridge\',
-bg => \'#8189ce14cf5b\',
##字体颜色
-fg => \'blue\',
##>$sub_of{$par_tmp} 就是引用
-command =>$sub_of{$par_tmp}
)->pack(qw/-side top -fill x -padx 4 /);
}
push @frames,$f;
push @button,$b;
}
$FRAME_L->Button(
-text => "CLOSE",
-relief => \'sunken\',
-borderwidth => 1,
-bg => "white",
-fg => "black",
-command => sub { exit; },
)->pack(qw/-side bottom -fill x -padx 1 -pady 2 /);
;
MainLoop;
