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
";
    	
	 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 pressed
sub 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	$a2	$a3	$a4	$a5	$a6	$a7	$a8	$a9
" );
	 #数组元素个数
	  $var2=@arr2 -1 ;
	 $i=0;
	  foreach $var3 ("$a1","$a2","$a3","$a4","$a5","$a6","$a7","$a8","$a9"){
		  $i++;
		  print "$i is $i
";
		  print "$var3 is $var3
";
 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
";
	print "1---@arr2 is @arr2
";
 print "$arr2[1] is $arr2[1]
";
 print "$arr2[2] is $arr2[2]
";

$selStmt->finish;  
$dbh->disconnect; 
}

sub clear_button {
system("cls");
}