perl 代码《2》
来源：互联网 发布：外贸大数据搜索软件 编辑：程序博客网 时间：2024/04/29 03:17
#!/usr/bin/perluse 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,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=>"浙江稠州商业银行\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 menumy $mbar = $frm_menu -> Menu();$mw -> configure(-menu => $mbar);#The Main Buttonsmy $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\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,-command => sub { $txt->insert('end',"Name : Binny V AWebsite : 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 tutorialMade by Binny V AWebsite : http://wwwgeocitiescom/binnyva/codeE-Mail : binnyva\@hotmailcom"); });sub menuClicked {my ($opt) = @_;$mw->messageBox(-message=>"You have clicked $optThis 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" => \&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",-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_fun2)-> pack(-side=>"left",-ipadx=>20,-padx=>30); $but2 = $frm_name1 -> Button(-text => "导出数据",-command =>\&sub_clear2)-> 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 =>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 => "", -padx => 0, -anchor => 'w', -background => 'white', -relief => "groove"); $table->put($row, $col, $tmp_label); }}$table->pack(-expand => 1,-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", -padx => 0, -anchor => 'w', -background => 'white', -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",-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 => "导出数据",-command =>\&sub_exp)-> 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 =>1 , -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","DATA_DATE"); foreach $key (sort keys %hash){ $var = $hash{$key};#print "\$var is $var\n"; $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');##定义表格结束#}###############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()),0,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", $dbUser, $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,$dbUser,$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 "; #数据导出的sqlfor (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', -message => '请输入主机名?', -type => 'YesNo', -icon => 'question', -default => 'yes');undef $name1; }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');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(DATA_DATE\,'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\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","$a2","$a3","$a4","$a5","$a6","$a7","$a8","$a9"){ $i++; # print "\$i is $i\n"; #print "\$var3 is $var3\n"; $tmp_label = $table->Label(-text => "$var3", -padx => 0, -anchor => 'w', -background => 'white', -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; }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',#-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,-width => 25,-font => $code_font,-bg => "#8189ce14cf5b", -fg => "black", -command => sub { exit; },)->pack(qw/-side bottom -fill x -padx 1 -pady 1 /);;MainLoop; 0 0
- perl 代码《2》
- Sublime Text 2- 直接测试Perl代码
- perl 发送邮件代码
- perl 代码整理工具
- Perl基础教程：代码调试
- perl滑动匹配代码
- Perl 代码片段记录
- perl 代码搜集
- Perl sap 接口 代码例子
- perl滑动匹配核心代码
- [Perl系列二-实战] 1. Perl 读取代码的行数
- 一段生成随机数的perl代码
- Perl]文字/代码批量替换工具 [转]
- perl 常用函数以及例子代码
- Perl 使用 sort， hash解析文件代码
- 用perl实现守护进程(daemon)代码
- perl实例：简单的代码规范化实例
- perl注释一段代码的方法
- JAVA客户端调用memcached
- 为iPhone 6设计自适应布局
- Cocos2d-X中使用CCHttpClient实现网络通信
- LeetCode Add Two Numbers
- java重载-方法重载中的准确性原则
- perl 代码《2》
- ACM--steps--2.2.7--数字的根
- Struts2之通配符映射（降低配置量）
- 在Windows下搭建Apache服务器
- leetcode_79_Word Search
- WMS仓库管理系统---(6)商品管理模块
- Unity3D-Mesh创建
- jquery动态生成和删除表格一行
- JDK1.6集成的JAX-WS开发webservice
