zj-小型的查询界面

<pre name="code" class="sql">#!/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,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 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\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 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-系统信息查询"        => ["日志查询"],
"2-综合查询"         => [1],
"3-收起菜单"         =>undef,

);

my (@frames,@button);
my %sub_of = (
"日志查询" => \&push_button2 ,
"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=>"Sdate",-width=>10) -> pack(-side=>"left",-ipadx=>20,-ipady=>20);

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

$but1 = $frm_name1 -> Button(-text => "查询",-command =>\&sub_fun2)-> 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","USER_ID",
"2","HOST_IP",
"3","SDATE",
"4","ERR_INFO");

foreach  $key (sort keys %hash)

{     $var = $hash{$key};
#	print "\$var is  $var\n";

$tmp_label = $table->Label(-text =>  $var, -width => 60, -relief =>'raised');

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

##创建100行
$tmp_label="";
foreach my $row (1 .. 100)
{
foreach my $col (1 .. 4)
{
$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结束#######################

eval {
sub sub_fun2{
use Tk;
my $dbName = 'oadb';
my $dbUser = 'query';
my $dbUserPass = 'query';
$date = $ent1 -> get();

$tmp_label="";

foreach my $row (1 .. 100)
{
foreach my $col (1 .. 4)
{
$tmp_label = $table->Label(-text => "",
-padx => 0,
-anchor => 'w',
-background => 'white',
-relief => "groove");
$table->put($row, $col, $tmp_label);
}
}
$table->pack(-expand => 1,-side=>"right");

my $dbh = DBI->connect("dbi:Oracle:$dbName", $dbUser, $dbUserPass) or die "can't connect to database " ;
my $hostSql = qq{select  * from  err_info where sdate=to_date('$date','yyyy-mm-dd') order by err_info desc};
@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);
$selStmt->execute();
while( $selStmt->fetch() ){
push (@arr2, "$a1\t$a2\t$a3\t$a4\n" );
#循环取数组元素个数
$var2=@arr2 -1 ;
$i=0;
foreach $var3 ("$a1","$a2","$a3","$a4"){
$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 => 45, -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 => 5,
-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 = 'oadb';
my $dbUser = 'query';
my $dbUserPass = 'query';
$name1 = $ent1 -> get();
$name2 = $ent2 -> 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 => '请输入用户ID?', -type => 'YesNo', -icon => 'question', -default => 'yes');
undef $name1;
}else{

my $dbName = 'oadb';
my $dbUser = 'query';
my $dbUserPass = 'query';
my $dbh = DBI->connect("dbi:Oracle:$dbName", $dbUser, $dbUserPass) or die "can't connect to database ";
#my $table_name= "$ARGV[0]";
$table_name="err_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  ";  #数据导出的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 = 'oadb';
my $dbUser = 'query';
my $dbUserPass = 'query';
$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;