加入收藏 | 设为首页 | 会员中心 | 我要投稿 李大同 (https://www.lidatong.com.cn/)- 科技、建站、经验、云计算、5G、大数据,站长网!
当前位置: 首页 > 大数据 > 正文

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

发布时间:2020-12-15 23:48:04 所属栏目:大数据 来源:网络整理
导读: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',-
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",-background=>'green');

$but2 -> pack(-side=>"left",-expand => 1 );

my $but3 = $frm1 -> Button(-text => "view disk",-background=>'green');

$but3 -> pack(-side=>"left",-expand => 1);

my $but4 = $frm1 -> Button(-text => "view Event",-background=>'green');

$but4 -> pack(-side=>"left",-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",-command =>&;push_button);
$but5 -> pack(-side=>"left",-expand => 1,-fill => 'x');


my $but6 = $frm3 -> Button(-text => "Mysql",-background=>'green');

$but6 -> pack(-side=>"left",-fill => 'x');

my $but7 = $frm3 -> Button(-text => "db2",-background=>'green');

$but7 -> pack(-side=>"left",-fill => 'x');

my $but8 = $frm3 -> Button(-text => "Sqlserver",-background=>'green');

$but8 -> pack(-side=>"left",-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  $varn";
    	
	 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,"$a1t$a2t$a3t$a4t$a5t$a6t$a7t$a8t$a9n" );
	 #数组元素个数
	  $var2=@arr2 -1 ;
	 $i=0;
	  foreach $var3 ("$a1","$a2","$a3","$a4","$a5","$a6","$a7","$a8","$a9"){
		  $i++;
		  print "$i is $in";
		  print "$var3 is $var3n";
 my $tmp_label = $table->Label(-text => "$var3",-relief => "groove");
       $table->put($var2,$i,$tmp_label);

} 
} 
        print "$var2 is $var2n";
	print "1---@arr2 is @arr2n";
 print "$arr2[1] is $arr2[1]n";
 print "$arr2[2] is $arr2[2]n";

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

sub clear_button {
system("cls");
}

(编辑:李大同)

【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!

    推荐文章
      热点阅读