Perl Pack写的一个数据报表程序

use Tk; use DBI; # Main Window##my $mw = new MainWindow;my $mw = MainWindow->new(-title => 'system monitor');#my $frm1 = $mw -> Frame() ->pack(-side=>"top",-fill => 'x');my $but1 =$frm1  -> Button(-text => "view cpu",-width=>30,-background=>'green',-command =>\&push_button);$but1 -> pack(-side=>"left",-fill => 'x',-expand => 1 );my $but2 = $frm1 -> Button(-text => "view memory",-width=>30,-background=>'green');$but2 -> pack(-side=>"left",-fill => 'x',-expand => 1 );my $but3 = $frm1 -> Button(-text => "view disk",-width=>30,-background=>'green');$but3 -> pack(-side=>"left",-fill => 'x',-expand => 1);my $but4 = $frm1 -> Button(-text => "view Event",-width=>30,-background=>'green');$but4 -> pack(-side=>"left",-fill => 'x',-expand => 1);my $frm2 = $mw -> Frame() ->pack(-side=>"top",-fill => 'x');my $lab1 = $frm2 -> Label(-text=>"Start date:")->pack;my $frm3 = $mw -> Frame() ->pack(-side=>"top",-fill => 'x');my $but5 =$frm3  -> Button(-text => "Oracle",-width=>30,-background=>'green',-command =>\&push_button);$but5 -> pack(-side=>"left",-expand => 1,-fill => 'x');my $but6 = $frm3 -> Button(-text => "Mysql",-width=>30,-background=>'green');$but6 -> pack(-side=>"left",-expand => 1,-fill => 'x');my $but7 = $frm3 -> Button(-text => "db2",-width=>30,-background=>'green');$but7 -> pack(-side=>"left",-expand => 1,-fill => 'x');my $but8 = $frm3 -> Button(-text => "Sqlserver",-width=>30,-background=>'green');$but8 -> pack(-side=>"left",-expand => 1,-fill => 'x');#表格$mw->geometry("475x125");#禁止窗口缩放#$mw->resizable(0,0);$mw->title("Table Example");my $table_frame = $mw->Frame()->pack(-expand => 1,-fill => 'both');my $table = $table_frame->Table(-columns => 10,                                -rows => 30,                                -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 => 25, -relief =>'raised'); ##放到第0行 第N列  $table->put(0, $key, $tmp_label);}##创建100行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');MainLoop;#This is executed when the button is pressedsub push_button {# system("cls");my $dbName = 'june';  my $dbUser = 'test';  my $dbUserPass = 'test';  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};  my @arr2="";my $var2="";my  $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; }sub clear_button {system("cls");}