代码版本《1》

#!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 /);

##定义图片
#my $cns = $mw -> Canvas(-relief=>"sunken", -background=>"blue");  


#$cns -> create('polygon',5,100,50,5,150,5,200,100,5,100,  
#-joinstyle=>"bevel", -fill=>"red", -outline=>"white", -width=>5);  
#$cns -> create('oval',200,100,300,200, -fill=>"green");  
#
#$cns -> create('oval',200,300,300,100, -fill=>"white", -width=>100); 
#$cns -> create('oval',1000,300,300,100, -fill=>"white", -width=>100); 


#$cns -> create('rectangle',10,150,100,250, -dash=>[6,4,2,4,2,4]);  

#$cns -> pack(qw/-side left -fill both -expand 1 /);

####设置标签
$code_font = $mw->fontCreate(-family => '黑体',-size => 80);
my $lab =  $mw -> Label(-text=>"浙江稠州商业银行
运维巡检平台",-font => $code_font,-height=>10)->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
");});
$insert -> command(-label =>"Website", -command=>sub {
$txt->insert('end',"Website : http://wwwgeocitiescom/binnyva/
");});
$insert -> command(-label =>"Email",
-command=> sub {$txt->insert('end',"E-Mail : binnyva@hotmailcom
");});
$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
Perl/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-系统信息查询"        => ["VIEW CPU","VIEW MEMORY","VIEW DISK"],
        "2-中间件信息查询"        => [1,2,3],
        "3-数据库信息查询"        => [1,2,3],
        "4-硬件信息查询"        => [1,2,3],
        "5-软件信息查询"        => [1,2,3],
	"6-登记信息查询"         => [1],
	"7-综合查询"         => [1],
	"8-收起菜单"         =>undef,
    
);



my (@frames,@button);
	my %sub_of = (
    "VIEW CPU" =>sub{ print "program 4" },
        "VIEW MEMORY" => sub{ print "program 2" },
        "VIEW DISK" => &push_button3 ,
        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_button3开始#######################
sub push_button3 {
 $mw = new MainWindow; # Main Window
 $frm_name1 = $mw -> Frame()->pack(-side=>"top",-fill => 'x');

 $lab1 = $frm_name1 -> Label(-text=>"Host Ip",-width=>10) -> pack(-side=>"left",-ipadx=>20,-ipady=>20);

 $ent1 = $frm_name1 -> Entry() -> pack(-side=>"left",-ipadx=>20);

 $lab2 = $frm_name1 -> Label(-text=>"Start date",-width=>10) -> pack(-side=>"left",-ipadx=>20,-ipady=>20);

 $ent2 = $frm_name1 -> Entry() -> pack(-side=>"left",-ipadx=>20);

 $lab3= $frm_name1 -> Label(-text=>"Stop date",-width=>10) -> pack(-side=>"left",-ipadx=>20,-ipady=>20);

 $ent3 = $frm_name1 -> Entry() -> pack(-side=>"left",-ipadx=>20);

 $but1 = $frm_name1 -> Button(-text => "ok",-command =>&sub_fun3)-> pack(-side=>"left",-ipadx=>20,-padx=>30);

 $but2 = $frm_name1 -> Button(-text => "clear table",-command =>&sub_clear3)-> pack(-side=>"left",-ipadx=>20,-padx=>30);

###############定义表格开始
$mw->geometry("475x122");

#禁止窗口缩放
#$mw->resizable(0,0);
require Tk::Table;
 $table_frame = $mw->Frame()->pack(-expand => 1,-fill => 'both');
 $table = $table_frame->Table(-columns => 10,
                                -rows =>3 ,
                                -fixedrows => 10,
                                -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)

{     $var = $hash{$key};
	print "$var is  $var
";
    	
	  $tmp_label = $table->Label(-text =>  $var, -width => 22, -relief =>'raised');

	 ##放到第0行 第N列
  $table->put(0, $key, $tmp_label);
}

##创建100行
 $tmp_label="";
foreach my $row (1 .. 100)
{
  foreach my $col (1 .. 10)
  {
     $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 边框属性
$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_clear3{
	 $tmp_label="";

	foreach my $row (1 .. 100)
{
  foreach my $col (1 .. 10)
  {
      $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_fun3{
use Tk;
my $dbName = 'june';  
my $dbUser = 'test';  
my $dbUserPass = 'test';
 $name1 = $ent1 -> get();
 $name2 = $ent2 -> get();
 $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	$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
";
  $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; 
}

##############push_button3结束#######################
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 =>'#87CEFA',
		##-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} 就是引用,子entry调用

			-command =>$sub_of{$par_tmp}
                )->pack(qw/-side top -fill x -padx 4  /);
        }

	 push @frames,$f;
	push @button,$b;
}

$FRAME_L->Button(
        -text        => "9-退出菜单",
        -relief      => 'sunken',
        -borderwidth => 1,
	-width                 => 25,
	-font => $code_font,
	-bg          => "#87CEFA",
        -fg          => "black",
        -command     => sub { exit; },
)->pack(qw/-side bottom -fill x -padx 1 -pady 1 /);

;



MainLoop;