perl 代码《2》

Perl 2020-09-18 
#!/usr/bin/perl
use Tk;
use DBI;
use encoding 'euc_cn';
###创建窗体
my $mw = MainWindow->new(-title => "system monitor",-bg=>"blue");

##定义左边菜单框体
$FRAME_L  = $mw->Frame(-bg=>white)->pack(qw/-side left -fill both /);

#定义下拉菜单框
$WIDGET_F = $FRAME_L->Labelframe(-bg=>white)->pack(qw/-side top -fill both -expand 1 /);

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


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


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

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

####设置标签
$code_font = $mw->fontCreate(-family => '黑体',-size => 80);

my $lab =  $mw -> Label(-text=>"浙江稠州商业银行\n运维巡检平台",-font => $code_font,-height=>10,-bg=>"#C6E2FF",-fg=>"black")->pack(qw/-side top -fill both -expand 1 /); 


####定义菜单##########################################################################

#

#'Widget' 可以试任何的部件支持滚动条 比如 Text,ListBox,etc
#
#
my $frm_menu = $mw -> Frame(-bg=>"#C6E2FF") ->pack(-side=>"top",-fill => 'x');
#my $txt = $frm_menu -> Scrolled('Text',-width => 50,-scrollbars=>'e',-bg=>"#C6E2FF") -> 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",-tearoff => 0);

my $tools = $mbar -> cascade(-label =>"tools",-tearoff => 0);

my $help = $mbar -> cascade(-label =>"Help",-tearoff => 0);



## File Menu ##
$file -> command(-label => "New",-command=>sub { $txt -> delete('10','end');} );

$file -> checkbutton(-label =>"Open",-underline => 0,-command => [\&menuClicked,"Open"]);

$file -> command(-label =>"Save","Save"]);
$file -> separator();

$file -> command(-label =>"Exit",-underline => 1,-command => sub { exit } );



## Others Menu ##
my $insert = $others -> cascade(-label =>"Insert",-tearoff => 0);
$insert -> command(-label =>"Name",-command => sub { $txt->insert('end',"Name : Binny V A\n");});
$insert -> command(-label =>"Website",-command=>sub {
$txt->insert('end',"Website : http://wwwgeocitiescom/binnyva/\n");});
$insert -> command(-label =>"Email",-command=> sub {$txt->insert('end',"E-Mail : binnyva\@hotmailcom\n");});
$others -> command(-label =>"Insert All",-underline => 7,"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\nPerl/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,3],"3-数据库信息查询"        => [1,"4-硬件信息查询"        => [1,"5-软件信息查询"        => [1,"6-登记信息查询"         => [1],"7-综合查询"         => [1],"8-收起菜单"         =>undef,);



my (@frames,@button);
	my %sub_of = (
    "VIEW cpu" => \&push_button1,"VIEW MEMORY" => \&push_button2,"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_button1开始######################
sub push_button1{
	##查看列表框

	my $mw = new MainWindow;
$lb = $mw->ListBox(-selectmode => "single")->pack(-expand => 1,-fill => 'both' ); 
$lb->insert('end',qw/red yellow green blue grey/);
##绑定到左键<Button-1>
$lb->bind('<Button-1>',sub { $lb->configure(-background => $lb->get($lb->curselection( )) ); }); MainLoop
}

##############push_button2开始###########################


sub push_button2 {
	my $mw = MainWindow->new(-title => "Mem monitor");
 $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",-ipady=>20);

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

 $lab3= $frm_name1 -> Label(-text=>"Stop date",-ipady=>20);

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

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

 $but2 = $frm_name1 -> Button(-text => "导出数据",-command =>\&sub_clear2)-> pack(-side=>"left",-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 =>1,-fixedrows => 1,-scrollbars => 'oe',-relief => 'raised');


#@arr1 = qw/HOST FILESYstem TYPE SIZE# USED AVAIL USE MOUNTED SYSDATE/;
##使用hash数组
			my 	%hash=("1","HOST","2","TOTAL","3","USED","4","FREE","5","DATA_DATE"); 

foreach  $key (sort keys %hash)

{     $var = $hash{$key};
#	print "\$var is  $var\n";
    	
	  $tmp_label = $table->Label(-text =>  $var,-width => 40,-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 = $mv->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');
#
#定义表格结束
#

}
###############push_button2结束#######################



sub sub_fun2{
use Tk;
my $dbname = 'dwh5';  
my $dbUser = 'test';  
my $dbUserPass = 'test';
 $name1 = $ent1 -> get();
 $name2 = $ent2 -> get();
 $name3 = $ent3 -> get();

 $tmp_label="";

	foreach my $row (1 .. 100)
{
  foreach my $col (1 .. 10)
  {
      $tmp_label = $table->Label(-text => "",-relief => "groove");
			  $table->put($row,-fill => 'both');

my $dbh = DBI->connect("dbi:Oracle:$dbname",$dbUser,$dbUserPass) or die "can't connect to database " ;
my $hostsql = qq{select hostip,total,used,free,to_char(DATA_DATE\,'yyyy-mm-dd:Hh24:Mm:Ss') from mem_info where hostip='$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);  
$selStmt->execute();  
while( $selStmt->fetch() ){  
	 push (@arr2,"$a1\t$a2\t$a3\t$a4\t$a5\n" );
	 #循环取数组元素个数
	  $var2=@arr2 -1 ;
	 $i=0;
	  foreach $var3 ("$a1","$a2","$a3","$a4","$a5"){
		  $i++;
		  #  print "\$i is $i\n";
		  #print "\$var3 is $var3\n";
  $tmp_label = $table->Label(-text => "$var3",-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; 
}



##############push_button3开始#######################
sub push_button3 {
	my $mw = MainWindow->new(-title => "disk monitor");
 $frm_name1 = $mw -> Frame()->pack(-side=>"top",-command =>\&sub_fun3)-> pack(-side=>"left",-command =>\&sub_exp)-> pack(-side=>"left","FILESYstem","TYPE","SIZE#","6","AVAIL","7","USE","8","MOUNTED","9",-width => 22,-fill => 'both');



##borderwidth 边框属性
$button_frame = $mw->Frame( -borderwidth => 4 )->pack();
$button_frame->Button(-text => "Exit",-height=>40) -> pack(-fill => 'both');
#
#定义表格结束
#

}
###############push_button3结束#############################################

sub sub_exp{

	my $dbname = 'dwh5';  
my $dbUser = 'test';  
my $dbUserPass = 'test';
	 $name1 = $ent1 -> get();
 $name2 = $ent2 -> get();
 $name3 = $ent3 -> get();
 use HTTP::Date qw(time2iso str2time time2iso time2isoz);
   my $CurrTime = substr(time2iso(time()),10);                   # 当前时间
if  ($name1 == ""){
	$answer => $frm_name1->messageBox(-title => 'Please Reply',-message => '请输入主机名?',-type => 'YesNo',-icon => 'question',-default => 'yes');
	undef $name1;
}else{
      	

	my $dbname = 'dwh5';
my $dbUser = 'test';
my $dbUserPass = 'test';
my $dbh = DBI->connect("dbi:Oracle:$dbname",$dbUserPass) or die "can't connect to database ";
#my $table_name= "$ARGV[0]"; 
$table_name="cpu_info";
my $hostsql = qq{select COLUMN_NAME from dba_tab_columns where table_name=upper('$table_name')};
my $UNLOAD_SRC_DBCONN = DBI->connect("DBI:Oracle:".$dbname,$dbUserPass) or die("DB connect error!n");
my $DW_DATA_DT ="";

my $datafile="C:/$table_name${CurrTime}.TXT";
print "\$datfile is $datafile \n";


my @lstRlst1;
my @lstRlst;
my ($COLUMN_NAME);
my $selStmt = $dbh->prepare($hostsql);
$selStmt->bind_columns(undef,\$COLUMN_NAME);
$selStmt->execute();
while( $selStmt->fetch() ){
  print "$COLUMN_NAME\n";
push  (@lstRlst1,$COLUMN_NAME);
  }
  $selStmt->finish;
  $dbh->disconnect;
my @lstRlst = reverse (@lstRlst1);
##########################################
#=================全局变量区==========================#

sub printlog
{
  my ($LogInfo)= @_;

  if(!defined($LogInfo) ){$LogInfo="";}
  my $StrLog="【${CurrTime}】 \t ${LogInfo} \n"; 
  
  print $StrLog;
  #print LOGFILE $StrLog;
  }
  
my $exportOraclesql="SELECT  ";  #数据导出的sql
for (my $m=0;$m<@lstRlst + 0 ;$m++){
 if  ($m != @lstRlst + 0 - 1){
	 ##判断是否是最后一行,最后一行就不需要拼接,$exportOraclesql = "$exportOraclesql trim($lstRlst[$m])".","
}
else{
$exportOraclesql = "$exportOraclesql trim($lstRlst[$m])"}
print "$exportOraclesql\n";
}
my $exportOraclesql="$exportOraclesql from $dbUser.$table_name";

sub Exportdata{
	    
	    printlog "开始导出数据!";
	    my $exportsql=$exportOraclesql;

  my $exportsql="$exportsql where host='$name1' ";
  	     print "\$exportsql is $exportsql\n";
	    if($exportsql eq "error"){
	    	return -1;
	    	}
	    my $format_sql="alter session set nls_date_format='yyyy-mm-dd'";
	    my $stmt=$UNLOAD_SRC_DBCONN->prepare($format_sql);
	    unless ($stmt){
			printlog "\n执行prepare sql语句出错:\n";
			printlog $DBI::errstr; 
			return -1;
			}
			$stmt->execute;
			if ($UNLOAD_SRC_DBCONN->err) {
			printlog "\n执行sql语句出错:\n"; 
			printlog $DBI::errstr;
			return -1;
			}
	     $stmt=$UNLOAD_SRC_DBCONN->prepare($exportsql);
	    unless ($stmt){
			printlog "\n执行prepare sql语句出错:\n";
			printlog $DBI::errstr;
			return -1;
		}
	       $stmt->execute;
		if ($UNLOAD_SRC_DBCONN->err) {
			printlog "\n执行sql语句出错:\n"; 
			printlog $DBI::errstr;
			
			return -1;
		}
	     my $row=0;
	     my $size=0;
	     my $curtime;

	     
	     
	     my $writeflagsql;
	     my $tmpstr="";
	     $row=0;
	     my $m=0;              
 open(DATAFILE,">",$datafile) || die (print "Open DATA file Failed!!!\n");
	     while(my $Rows = $stmt->fetchrow_arrayref){
	     	$m=0;
	     	$tmpstr="";
	     	foreach(@$Rows){
	     		$tmpstr=$tmpstr.$Rows->[$m]."|";
	     		$m++;
	     	}
		#print DATAFILE $tmpstr.$DW_DATA_DT."\n";
		print DATAFILE $tmpstr."\n";
	     	$row++;
	     	if(($row%10000) == 0){
	     		printlog "已导出数据$row条！";
	     	}	     	     	
	    }
     	
        	$stmt->finish;
        #	print FLAGFILE $datafile,"\n";
        #	print FLAGFILE $row,"\n";
        	close(DATAFILE);
        #  close(FLAGFILE);

        	$curtime=time2iso(time());
          printlog "数据已成功导出!";

          printlog "一共导出数据${row}条";
            $answer => $frm_name1->messageBox(-title => 'Please Reply',-message => '数据已成功导出',-type => 'OK',-icon => 'question');
	undef $name1;
      	    
          return 1;	
	
	}
Exportdata}}

sub sub_fun3{
my $dbname = 'dwh5';  
my $dbUser = 'test';  
my $dbUserPass = 'test';
 $name1 = $ent1 -> get();
 $name2 = $ent2 -> get();
 $name3 = $ent3 -> get();
if  ($name1 == ""){
	$answer => $frm_name1->messageBox(-title => 'Please Reply',-default => 'yes');
	undef $name1;
      	
}
	foreach my $row (1 .. 100)
{
  foreach my $col (1 .. 10)
  {
      $tmp_label = $table->Label(-text => "",-fill => 'both');


my $dbh = DBI->connect("dbi:Oracle:$dbname",$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),'yyyy-mm-dd:Hh24:Mm:Ss') from cpu_info where host='$name1'};    
@arr2="";  

$var2="";

$tmp_label="";

$var3="";

$i=0;

my ($a1,\$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","$a5","$a6","$a7","$a8","$a9"){
		  $i++;
		  #  print "\$i is $i\n";
		  #print "\$var3 is $var3\n";
  $tmp_label = $table->Label(-text => "$var3",$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; 
}


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,-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',#-bg      => 'white',##字体颜色
                        -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,-bg          => "#8189ce14cf5b",-fg          => "black",-command     => sub { exit; },)->pack(qw/-side bottom -fill x -padx 1 -pady 1 /);

;



MainLoop;

相关文章

Perl碎碎念
1. 如何去重 #!/usr/bin/perl use strict; my %hash; while(...
如何用perl将表格中不同列的数据进行拼凑，然后将拼凑后的数据用“|”连接在一起
最近写了一个perl脚本，实现的功能是将表格中其中两列的数据...
基于表的数据字典构造MySQL建表语句
表的数据字典格式如下：如果手动写MySQL建表语句，确认麻烦，...
如何用Perl对Excel的数据进行提取并分析
巡检类工作经常会出具日报，最近在原有日报的基础上又新增了...
如何用Perl截取报文
在实际生产环境中，常常需要从后台日志中截取报文，报文的形...
如何通过关键词匹配统计其出现的频率
最近写的一个perl程序，通过关键词匹配统计其出现的频率，让...