一个简单的Tk界面(可以录入和查询)

#!/usr/local/bin/perl
use Tk;
use dbi;
#Global Variables
my $age = 10;
# Main Window
my $mw = new MainWindow;
#GUI Building Area
use Encode qw/encode decode/;


#Age

my $but1 = $mw -> Button(-text=>"view cpu", -command =>&push_button1); ## 执行函数push_butto
my $but2 = $mw -> Button(-text=>"view memory", -command =>&push_button2); ## 执行函数push_butto
my $but3 = $mw -> Button(-text=>"view disk", -command =>&push_button3); ## 执行函数push_butto
my $but4 = $mw -> Button(-text=>"view err", -command =>&push_button4); ## 执行函数push_butto
my $but5 = $mw -> Button(-text=>"view syslog", -command =>&push_button5); ## 执行函数push_butto
my $but6 = $mw -> Button(-text=>"view event", -command =>&push_button6); ## 执行函数push_butto
my $but7 = $mw -> Button(-text=>"view DB2", -command =>&push_button6); ## 执行函数push_butto
my $but8 = $mw -> Button(-text=>"view Mysql", -command =>&push_button6); ## 执行函数push_butto
my $but9 = $mw -> Button(-text=>"view Sqlserver", -command =>&push_button6); ## 执行函数push_butto
my $but10 = $mw -> Button(-text=>"view infomix", -command =>&push_button6); ## 执行函数push_butto
my $but11 = $mw -> Button(-text=>"view Oracle", -command =>&push_button6); ## 执行函数push_butto
my $but12 = $mw -> Button(-text=>"view Sybase", -command =>&push_button6); ## 执行函数push_butto

my $but13 = $mw -> Button(-text=>"entering", -command =>&push_botton3); ## 执行函数push_event1
my $but14 = $mw -> Button(-text=>"view", -command =>&push_event2); ## 执行函数push_event2

##插入一行空白标签
my $lab =  $mw -> Label();
my $lab1 =  $mw -> Label();

#Text Area
my $textarea = $mw -> Frame();
my $txt = $textarea -> Text(-width=>100, -height=>40);

my $srl_y = $textarea -> Scrollbar(-orient=>'v',-command=>[yview => $txt]);  ##Scrollbar滚动条垂直 

my $srl_x = $textarea -> Scrollbar(-orient=>'h',-command=>[xview => $txt]);

$txt -> configure(-yscrollcommand=>['set', $srl_y], ##yscrollcommand文本部件和滚动条通讯

-xscrollcommand=>['set',$srl_x]);
#Geometry Management
#columnspan=>2 占据的列数

$but1 -> grid(-row=>1,-column=>0,-columnspan=>1,-sticky=>"ew");
$but2 -> grid(-row=>1,-column=>1,-columnspan=>1,-sticky=>"ew");
$but3 -> grid(-row=>1,-column=>2,-columnspan=>1,-sticky=>"ew");
$but4 -> grid(-row=>1,-column=>3,-columnspan=>1,-sticky=>"ew");
$but5 -> grid(-row=>1,-column=>4,-columnspan=>1,-sticky=>"ew");
$but6 -> grid(-row=>1,-column=>5,-columnspan=>1,-sticky=>"ew");

$but7 -> grid(-row=>3,-column=>0,-columnspan=>1,-sticky=>"ew");
$but8 -> grid(-row=>3,-column=>1,-columnspan=>1,-sticky=>"ew");
$but9 -> grid(-row=>3,-column=>2,-columnspan=>1,-sticky=>"ew");
$but10 -> grid(-row=>3,-column=>3,-columnspan=>1,-sticky=>"ew");
$but11 -> grid(-row=>3,-column=>4,-columnspan=>1,-sticky=>"ew");
$but12 -> grid(-row=>3,-column=>5,-columnspan=>1,-sticky=>"ew");

$lab -> grid(-row=>2,-column=>5,-columnspan=>1,-sticky=>"ew");
$lab1 -> grid(-row=>4,-column=>5,-columnspan=>1,-sticky=>"ew");

$but13 -> grid(-row=>5,-column=>0,-columnspan=>1,-sticky=>"ew");
$but14 -> grid(-row=>5,-column=>1,-columnspan=>1,-sticky=>"ew");


$txt -> grid(-row=>1,-column=>1);
$srl_y -> grid(-row=>1,-column=>6,-sticky=>"ns");
$srl_x -> grid(-row=>6,-column=>1,-sticky=>"ew");

#文本区域 从第2行顶格开始长度为6
$textarea -> grid(-row=>6,-column=>0,-columnspan=>6);
MainLoop;



sub push_button1 {
# 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 $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 ($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() ){  
	#print "$table_name		   $tablespace_name		$status
";  
$txt -> insert("end","$a1	$a2	$a3	$a4	$a5	$a6	$a7	$a8	$a9"."
");
 

}  

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


##push_button2

sub push_button2{
	my $mw = new MainWindow; # Main Window
my $frm_name = $mw -> Frame();
my $lab =  $frm_name -> Label(-text=>"view memory");
my $lab1 = $frm_name -> Label(-text=>"Ip Address");
my $lab2 = $frm_name -> Label(-text=>"Start date:");
my $lab3 = $frm_name -> Label(-text=>"End date:");
my $ent1 = $frm_name -> Entry();  ###输入文本框
my $ent2 = $frm_name -> Entry();  ###输入文本框
my $ent3 = $frm_name -> Entry();  ###输入文本框

my $but = $mw -> Button(-text=>"ok",-width=>10, -command =>&sub_fun2);
my $textarea = $mw -> Frame(); #Creating Another Frame
my $txt = $textarea -> Text(-width=>40, -height=>10);
my $srl_y = $textarea -> Scrollbar(-orient=>'v',-command=>[yview => $txt]);
my $srl_x = $textarea -> Scrollbar(-orient=>'h',-command=>[xview => $txt]);
$txt -> configure(-yscrollcommand=>['set', $srl_y],
-xscrollcommand=>['set',$srl_x]);
$lab -> grid (-row=>0,-column=>0);
$lab1 -> grid(-row=>1,-column=>1);
$lab2 -> grid(-row=>2,-column=>1);
$lab3 -> grid(-row=>3,-column=>1);
$ent1 -> grid(-row=>1,-column=>2);
$ent2 -> grid(-row=>2,-column=>2);
$ent3 -> grid(-row=>3,-column=>2);
$frm_name -> grid(-row=>1,-column=>1,-columnspan=>2);
$but -> grid(-row=>4,-column=>1,-columnspan=>2);
$txt -> grid(-row=>1,-column=>1,-ipadx=>160,-ipady=>100);
$srl_y -> grid(-row=>1,-column=>2,-sticky=>"ns");
$srl_x -> grid(-row=>2,-column=>1,-sticky=>"ew");
$textarea -> grid(-row=>5,-column=>1,-columnspan=>20);
#This function will be executed when the button is pushed

sub sub_fun2 {
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 $name1 = $ent1 -> get();
my $name2 = $ent2 -> get();
my $name3 = $ent3 -> get();
#$txt -> insert('end',"$name1 $name2 $name3");
#
#
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'};  
 

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() ){  
	#print "$table_name		   $tablespace_name		$status
";  
$txt -> insert("end","$a1	$a2	$a3	$a4	$a5	$a6	$a7	$a8	$a9"."
");
 

}  

$selStmt->finish;  
$dbh->disconnect; 
}
}
######push_botton3 函数用于插入数据
 
sub push_botton3{
my $mw = new MainWindow; # Main Window
my $frm_name = $mw -> Frame();
my $lab1 = $frm_name -> Label(-text=>"Id Number:",-width=>10);
my $lab2 = $frm_name -> Label(-text=>"Room Number:");
my $lab3 = $frm_name -> Label(-text=>"Money:");
my $ent1 = $frm_name -> Entry();  ###输入文本框
my $ent2 = $frm_name -> Entry();  ###输入文本框
my $ent3 = $frm_name -> Entry();  ###输入文本框
my $but = $mw -> Button(-text=>"ok",-width=>10, -command =>&sub_fun3);
my $textarea = $mw -> Frame(); #Creating Another Frame
my $txt = $textarea -> Text(-width=>40, -height=>10);
my $srl_y = $textarea -> Scrollbar(-orient=>'v',-command=>[yview => $txt]);
my $srl_x = $textarea -> Scrollbar(-orient=>'h',-command=>[xview => $txt]);
$txt -> configure(-yscrollcommand=>['set', $srl_y],
-xscrollcommand=>['set',$srl_x]);
$lab1 -> grid(-row=>1,-column=>1);
$lab2 -> grid(-row=>2,-column=>1);
$lab3 -> grid(-row=>3,-column=>1);
$ent1 -> grid(-row=>1,-column=>2);
$ent2 -> grid(-row=>2,-column=>2);
$ent3 -> grid(-row=>3,-column=>2);
$frm_name -> grid(-row=>1,-column=>1,-columnspan=>2);
$but -> grid(-row=>4,-column=>1,-columnspan=>2);
$txt -> grid(-row=>1,-column=>1,-ipadx=>160,-ipady=>100);
$srl_y -> grid(-row=>1,-column=>2,-sticky=>"ns");
$srl_x -> grid(-row=>2,-column=>1,-sticky=>"ew");
$textarea -> grid(-row=>5,-column=>1,-columnspan=>20);

sub sub_fun3 {
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 $name1 = $ent1 -> get();
my $name2 = $ent2 -> get();
my $name3 = $ent3 -> get();

$txt -> insert('end',"$name1 $name2 $name3");
$dbh->do("insert into register_info values ('$name1','$name2','$name3')") or die($DBI::errstr);
$dbh->disconnect();
}

}