gyn

Win32下的Perl,无用的select,停滞的Tk,结束吧....

华为Q3526E交换机日志导出脚本

package require Expect
set params [open params.txt r]
array set params_arr [list ]
while {![eof $params]} {
 set line [gets $params]
 if [regexp {\[(.*)\](.*)} $line full name value] { set params_arr([string trim $name]) [string trim $value] }
}
close $params
proc q3526e {arr} {
 upvar $arr params
 set buffer [list ]
 if [catch {spawn telnet $params(hostname)} result] { puts $result; exit 1 }
 expect -re {Password} { exp_send "$params(password)\r" } eof { exit 1 }
 expect -re $params(prompt) { exp_send "sup\r" }
 expect -re {Password} { exp_send "$params(password)\r" } eof { exit 1 }
 expect -re $params(prompt) { exp_send "dis log\r" }
 expect -re {More ----} {
  foreach ele [split $expect_out(buffer) "\n"] { lappend buffer $ele }
  exp_send "\r"
  while { [regexp {More ----} $expect_out(buffer)] } {
   expect -re {More ----} {
    foreach ele [split $expect_out(buffer) "\n"] { lappend buffer $ele }
    exp_send "\r"
   } -re "$params(prompt)" {
    foreach ele [split $expect_out(buffer) "\n"] { lappend buffer $ele }
    writelog buffer
    exp_send "\r"
   } eof { exit 1 }
  }
 } -re $params(prompt) {
  foreach ele [split $expect_out(buffer) "\n"] { lappend buffer $ele }
  writelog buffer
  exp_send "\r"
 } eof { exit 1 }
}
proc writelog {buf} {
 upvar $buf buffer
 set curr [clock format [clock seconds] -format %D]
 regexp {([0-9]{2})/([0-9]{2})/([0-9]{2})} $curr match month day year
 set curr "20$year$month$day"
 set log [open [format "%s_%s%s" {c:/3526log} $curr {.txt}] w]
 foreach ele $buffer { puts $log $ele }
 flush $log
 close $log
}
if [catch {eval [string trim $params_arr(act)]} result] {puts $result; exit}

参数文件:
[hostname]网关ip地址
[password]交换机密码
[prompt]<Q3526E>
[act]q3526e params_arr

posted @ 2007-01-01 09:46 gyn_tadao 阅读(1511) | 评论 (0)编辑 收藏

sqlite无记录操作

Sqlite 中借鉴了 oracle db2 以及 postgresql 中得 null 操作方法,也就是借由 coalesce 的方法来处理 null 类型的数据。当遇到返回 null 数据时, coalesce 将第二个参数代替 null 。举例如下:

有表 phones
create table phones(name text, number integer);
insert into phones values(‘josh’, 86123413); 
insert into phones values(‘mariah’, 89804517);
insert into phones values(‘samantha’, NULL);

很不幸, samantha 的办公室还没有装电话,所以在表里虽然有她的名字但只能用 NULL 来做填充。如果有人希望在该数据库中查询她的电话时,将得到一个 NULL 的数据。当然首先是要设置 null 的表示字符串,通常情况下我们使用 ’NULL’ 来表示。为了更清楚地表达这种不存在的状况就需要使用 coalesce
Select coalesce(number, ‘no phone number for ’||name) as number from phones where name = ‘samantha’;

这样的查询可以得到合适的结果。至此似乎一切顺利,可事实上却忽视了一种最基本的情况。

Select coalesce(number, ‘no phone number for ’||name) as number from phones where name = ‘tata’;

公司里大概是没有一个叫 tata 的人,也许我们甚至难以确定他的性别。可是即便使用了 coalesce 也将一无所获。 Sqlite 里就是这样的,相关的文档里没有作出很好的解释。但它的确是返回了一个 NULL 值的,这个可以使用 nullif 来得到证实。
Select nullif((Select number from phones where name = ‘tata’), NULL) as result;

还好可以确定它返回了一个 NULL ,只要将 nullif 嵌到 coalesce 中便可以得到希望的结果了。
Select coalesce(nullif((Select number from phones where name = ‘tata’), NULL) , ‘no such person’) as result;

posted @ 2006-12-17 14:46 gyn_tadao 阅读(508) | 评论 (1)编辑 收藏

sqlite远程连接示例

Sqlite 是一个只有几百 k 大小的、 优秀的嵌入式数据库,本身不带有远程连接的功能。由于其身材小,速度快并且为众多的语言支持,所以在单机领域得到了广泛的使用。但由于天然不支持服务 / 客户端的模式,使其在遇到小型规模数据库远程连接的情况时不得不借助于附加的编程。

单位有三百多人,作为网管每天要接到很多电话,有很多一时无法想起对应的名字,翻查通讯录不仅速度慢而且容易漏过。为了方便起见,在 sqlite 上建立了一个通讯录数据表,然后用 perl 编写了一个查询脚本。效果不错的同时,也有同事希望可以得到一份拷贝。但是这时遇到一个问题,如何保证通讯录在不同人手中保持版本的统一性。最好的办法是建立一个服务 / 客户端的模式,在本机上维护一个数据库,而其它人通过连接数据库得到相关的查询结果。

具体的解决方法是这样的:在本机上维护一个到 sqlite 数据库的连接并建立一个来自于客户端的 socket 的监听,接受远程查询条件并回复查询结果;客户端志负责发送和接受这些最简单的任务。

客户端的代码:

use strict;
my $in_buffer = undef;
my $PF_INET = 2;
my $port = 2345;
my $remote_addr = pack('SnC4x8',$PF_INET,$port,192,168,138,228);
my $SOCK_DGRAM = 2;
socket(UDP_CLIENT, $PF_INET, $SOCK_DGRAM, getprotobyname('udp'));
while(1){
       print("
输入名字或号码: ");
       my $out_buffer=<STDIN>;
       chomp($out_buffer);
       if($out_buffer eq "exit"){last;}
       send(UDP_CLIENT, $out_buffer, 0, $remote_addr);
       print("waiting for reply...\n");
       recv(UDP_CLIENT, $in_buffer, 100, 0);
       chomp($in_buffer);
       print("$in_buffer\n");
}
close(UDP_CLIENT);

       服务器端的代码:

BEGIN{
       if( $^O eq 'MSWin32' ){
              require Win32::Console;
              Win32::Console::Free();
       }
}

use strict;
use DBI;

#database parameters
my $db_path = 'd:/src/cc/phones.db';
my $dbh = DBI->connect("dbi:SQLite:$db_path", {PrintError => 0}) or die $DBI::errstr;
my $sth = undef;

#socket server parameters
my $in_buffer = undef;
my $out_buffer = undef;
my $PF_INET = 2;
my $port = 2345;
my $local_addr = pack('SnC4x8',$PF_INET,$port,192,168,138,228);
my $SOCK_DGRAM = 2;
socket(UDP_SERVER, $PF_INET,$SOCK_DGRAM, getprotobyname('udp')) or die("$!");
bind(UDP_SERVER, $local_addr) or die("$!");
listen(UDP_SERVER, 10);

while(1){
       #receive query then send result
       last unless my $remote_addr = recv(UDP_SERVER,$in_buffer,100,0);
       chomp($in_buffer);
       if($in_buffer =~ /^[0-9]{6}$/){
              $sth = $dbh->prepare("select * from phones where number = $in_buffer");
              PROCEDURE:
              $sth->execute();
              my @items = $sth->fetchrow_array();
              if(scalar(@items)){
                     $out_buffer = $items[0].'
的虚拟网号码是 '.$items[1];
              }else{
                     $out_buffer = '
查无此人 ';
              }
       }else{
              $sth = $dbh->prepare("select * from phones where name = '$in_buffer'");
              goto PROCEDURE;
       }
      
send(UDP_SERVER,$out_buffer,0,$remote_addr);
}

#disconnect from sqlite
$dbh->disconnect();  

posted @ 2006-12-14 09:29 gyn_tadao 阅读(6758) | 评论 (5)编辑 收藏

一个直接运行c程序的东东-tiny C

前段时间看见ibm上有人介绍tiny c,就下了一个试试,感觉不错,为了方便起见,又弄了一个bat。
比方说,我把tiny c安装在d盘根目录下,然后我在d盘里建个tiny的文件存放如下内容的名为tiny的bat文件:
@echo off
tcc -run -I d:/tcc/include -L d:/tcc/lib %1
然后在环境变量path中加入d:\tiny,然后就可以运行c脚本了。
写个hello, world,取名为hello.c,存在随便哪里。然后到cmd里,cd到那个文件夹下,再“tiny hello.c”,接着cmd里就会显示“hello, world”鸟。

posted @ 2006-12-12 08:37 gyn_tadao 阅读(2406) | 评论 (8)编辑 收藏

tcl文本操作示例

因为要在windows上使用expect的缘故,所以学习了tcl。还是用我在上一篇随笔中使用的例子来入门。

set seconds [clock seconds]
set timer [clock format $seconds -format %D]

regexp {([0-9]{2})/([0-9]{2})/([0-9]{2})} $timer match month day year
set rep_smp "20$year$month$day"
set rep_full "20$year-$month-$day"

set rpjf [open {shixian.rpjf} r]
set tmp [open {tmp.txt} w]

while {[expr ![eof $rpjf]]} {
    gets $rpjf content
    set content [regsub {([0-9]{4})-([0-9]{2})-([0-9]{2})} $content $rep_full]
    set content [regsub {[0-9]{4}[0-9]{2}[0-9]{2}} $content $rep_smp]
    puts $tmp "$content"
    }

flush $tmp
close $rpjf
close $tmp

tcl语法用一句话概括的话就是:命令加参数。相比perl与python来说,tcl的语法相对简单一些,但是这并不代表就不如以上两者,各有各的特点而已。在tk和expect上tcl不仅仅是先驱而且也是做得最好的。

posted @ 2006-11-27 10:16 gyn_tadao 阅读(851) | 评论 (0)编辑 收藏

分别用vbs、perl、python来操作文本

都是用来更新一个rm视频参数文件的。最早学asp的时候顺便用vbs写了一个,后来学perl就又写了一个,现在学python,凑活也写一个。基本上算是我的一个入门程序。用途就是用简单正则表达式找到时间段,再将它更新为当天日期,更新后的数据存在temp.txt中。perl最短,python比较干净。
vbs:
dim regOR
set regOR=new regexp
regOR.ignorecase=True
regOR.global=True
regOR.pattern="^([0-9]{1})$"
dim mytime
mytime=date
yy=year(mytime)
mm=month(mytime)
dd=day(mytime)
if regOR.test(mm) then
    mm=regOR.replace(mm,"0$1")
end if
if regOR.test(dd) then
    dd=regOR.replace(dd,"0$1")
end if
mytime=yy & "-" & mm & "-" & dd
dest=yy & mm & dd
pattern1="(.*[^0-9])([0-9]{4}\-[0-9]{2}\-[0-9]{2})([^0-9].*)"
pattern2="(.*[^0-9])([0-9]{8})([^0-9].*)"
regOR.pattern=pattern1
dim tempstring
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateTextFile("d:\shixian\temp.txt", True)
Set fr = fso.GetFile("d:\shixian\shixian.rpjf")
Set ts = fr.OpenAsTextStream(1,-2)
do until ts.AtEndOfStream
    tempstring=ts.readline
    if regOR.test(tempstring) then
        tempstring=regOR.replace(tempstring,"$1" & mytime & "$3")
    end if
    regOR.pattern=pattern2
    if regOR.test(tempstring) then
        tempstring=regOR.replace(tempstring,"$1" & dest & "$3")
    end if
    regOR.pattern=pattern1
    f.writeline(tempstring)
loop
ts.close
f.close
set regOR=nothing
set ts=nothing
set fr=nothing
set f=nothing
set fso=nothing

perl:
open(RPJF,"<c:/code/10161.rpjf") or die("can not open because of $!\n");
open(TEMP,">c:/code/temp.txt") or die("can not open because of $!\n");
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime();
$mday = sprintf("%.2d",$mday);
$mon = sprintf("%.2d",$mon+1);
$year += 1900;
$timerF = "$year"."$mon"."$mday";
$timerS = "$year"."-"."$mon"."-"."$mday";
while(<RPJF>){
    chomp();
    $_=~s/(.*)([0-9]{8})(.*)/$1$timerF$3/;
    $_=~s/(.*)([0-9]{4}\-[0-9]{2}\-[0-9]{2})(.*)/$1$timerS$3/;
    print TEMP "$_\n";
}
close(RPJF);
close(TEMP);

python:
import re
import time

pattern_name = re.compile(r'[0-9]{8}')
pattern_info = re.compile(r'[0-9]{4}\-[0-9]{2}\-[0-9]{2}')
(year, month, day) = time.localtime()[:3]
name = '%d%.2d%.2d' % (year, month, day)
info = '%d-%.2d-%.2d' % (year, month, day)

try:
    file_rpjf = open('shixian.rpjf', 'r')
    file_temp = open('temp.txt', 'w')
    try:
        file_data = file_rpjf.readline()
        while file_data != '':
            file_data = pattern_name.sub(name, file_data)
            file_data = pattern_info.sub(info, file_data)
            file_temp.write(file_data)
            file_data = file_rpjf.readline()
    finally:
        file_rpjf.close()
        file_temp.close()
except IOError:
    pass

posted @ 2006-11-15 11:29 gyn_tadao 阅读(1403) | 评论 (0)编辑 收藏

看看python吧

近年来python发展迅猛,无论在gui还是在web开发上渐渐显示出强大的实力。而perl却由于初期错误的开发方向,导致迟迟无法发布perl6。相比与python的蒸蒸日上、优秀的开发平台、活跃的社区,perl给人的感觉就是江河日下。单说wxwidget,perl版的连英文文档都少的可怜,而python早就有boa这样优秀的平台了;而在perl原先引以为傲的web开发领域,现在的perl又有多少发言权,所谓的成功案例永远都是亚马逊在线。难以驾驭大型项目更是perl的顽疾,越来越多的perler转向了python。虽然还是可以用缓慢而迟钝的pugs体验也许永远不会到来的perl6,但是还是会感到一些失落。

posted @ 2006-10-28 14:36 gyn_tadao 阅读(1181) | 评论 (2)编辑 收藏

单位电脑信息采集程序

r_gui.JPG
主要用于收集ip、mac、姓名、房间,后来又加入了维修记录的功能。服务器端接受数据并存入数据库中。
#############################
use strict;
use Tk;
use Encode;

#SOCKE参数
my $PF_INET = 2;
my $port = 2345;
my $remote_addr = pack('SnC4x8',$PF_INET,$port,192,168,138,228);
my $SOCK_DGRAM = 2;

#Frame
my ($label_room, $label_name, $label_ctrl, $label_notice);

#确定、取消
my ($enter, $cancel);

#房间、姓名变量
my ($room, $name);
$room = '';
$name = '';

#主界面
my $mw = MainWindow->new(-title => hanzi('信息收集'));
$mw->minsize(qw/200 100/);
$mw->maxsize(qw/200 100/);

#三个Frame
$label_room = $mw->Frame( qw/-borderwidth 2 -relief groove/ )->pack( qw/-side top -fill both/ );
$label_name = $mw->Frame( qw/-borderwidth 2 -relief groove/ )->pack( qw/-side top -fill both/ );
$label_ctrl = $mw->Frame( qw/-borderwidth 2 -relief groove/ )->pack( qw/-side top -fill both/ );

#房间号码输入
$label_room->Label(-text => hanzi('房间号码'))->pack(qw/-side left -expand 1/);
$label_room->Entry(-textvariable => \$room, -relief => 'groove')->pack(qw/-side right -expand 1/);

#姓名输入
$label_name->Label(-text => hanzi('姓名'))->pack(qw/-side left -expand 1/);
$label_name->Entry(-textvariable => \$name, -relief => 'groove')->pack(qw/-side right -expand 1/);

#确定与重置
$enter = $label_ctrl->Button(-text => hanzi('确定'), -command => \&enter)->pack(qw/-side left -expand 1/);
$cancel = $label_ctrl->Button(-text => hanzi('重置'), -command => \&cancel)->pack(qw/-side right -expand 1/);

#提示
$label_notice = $mw->Label(-text => hanzi('欢迎使用'), -relief => 'groove', -background => '#FFFF99')->pack(qw/-side bottom -fill x/);

MainLoop();

#汉字解码
sub hanzi{
    return decode('gb2312', shift);   
}

#确定函数
sub    enter{
    chomp($room);
    chomp($name);
    $room =~ s/^\s+//;
    $name =~ s/^\s+//;
    if($room eq '' or $name eq ''){
        $label_notice->configure(-text => hanzi('输入不能为空')) ;
        return 0;
    }#if
    else{
        open(IPCF,'-|',"ipconfig -all");
       
        my ($mac_addr, $ip_addr, $out_buffer);
        while(<IPCF>){
            chomp;
            if($_ = ~s/(.*)(00(\-[0-9A-Z]{2}){5})(.*)/$2/){
                $mac_addr = join('', split(/-/,$_));
            }
            if($_ = ~/IP Address/){
                $_ = ~s/(.*)([0-9]{3}(\.[0-9]{1,3}){3})(.*)/$2/;
                $ip_addr = $_;
            }
        }#while
        $out_buffer = $room."\t".$mac_addr."\t".$ip_addr."\t".encode('utf8', $name);
       
        socket(UDP_CLIENT, $PF_INET, $SOCK_DGRAM, getprotobyname('udp'));
        send(UDP_CLIENT, $out_buffer, 0, $remote_addr);
       
        close(UDP_CLIENT);
        close(IPCF);
        $mw->destroy();
    }#else       
}

#重置函数
sub cancel{
    $label_notice->configure(-text => hanzi('重置为空'));
    $room = '';
    $name = '';
}

posted @ 2006-10-20 19:03 gyn_tadao 阅读(482) | 评论 (3)编辑 收藏

源码:用perl写的基于postgresql的考勤数据管理软件


  已停止下载(近一千行代码,用perl写真累.....,不比ms的,纯粹玩票)
大家看着玩玩儿吧~ ,单位在用了。:- ()
主要用到tk和dbi模块,因为喜欢用groove的效果(tk除了方便真没什么),所以比较土。有要学习tk,dbi的可以看看,蛮多代码都好重用的。

posted @ 2006-10-12 08:05 gyn_tadao 阅读(1083) | 评论 (3)编辑 收藏

在perl中操作数据库中文字段

perl 中操作数据库中文字段

Perl 中对程序中的语句是按 utf8 的编码处理的,对英文没有什么影响,但是中文就有一些麻烦。

比方说,在 notepad 中默认是以 gb2312 的编码处理中文。如果在其中编写带有中文的 perl 程序,一般都难令人如意。这种情况下,一般会拜托 encode 模块,它是天然集成在 activeperl5.8.8 中的,如果没有找到可在 ppm search 一下。

通常只要用到一下两个函数即可:

l           encode(‘ 编码 ’, ‘ 文字 ’)

l           decode(‘ 编码 ’, 数据 )

其中 decode 是将其中编码形式的文字转换为 utf8 数据;而 encode 则是将以 utf8 编码的数据转换为编码形式的文字。举一个例子:

$str = decode(‘gb2312’, ‘ 你好 ’);

Print encode(‘gb2312’, $str);

以上是可以正确打印出“你好”二字的。首先是告诉 perl “你好”是一个 gb2312 编码的文字, perl 把它以 utf8 的形式存在 $str 中;在将 $str gb2312 的形式转换为文字并打印出来。

 

再说一下数据库。数据库都有自己的编码方式,比如说 utf8 eu_cn gbk 等等。一定编码方式的数据库只能接受相应编码的数据,一般从兼容性上考虑会使用 utf8 编码的数据库。

postgres8.1 中,向一定编码的数据库中输入数据时,可以用 \encoding client encode 设为与输入数据相同的形式。比方说在 psql 中向 utf8 编码的数据库插入 gbk 编码的汉字,就可以:

\encoding ‘gbk’

不然只会得到一个无法输入的提示。遗憾的是, perl 里没有像 \encoding 这样的命令,于是又要拜托 encode 模块了。

#------------------------------------

use DBI;

use Encode;

use strict;

 

#连接数据库
my $dbh = DBI->connect("dbi:PgPP:dbname=
数据库名 :host= 服务器地址 :port= 服务器端口 ", 登录名 , 登录密码 ,{PrintError => 0})

or die $DBI::errstr;

#准备sql语句 

my $inr = $dbh->prepare("insert into name values('encode('utf8', decode('gb2312',' 你好 '))')")

or die $DBI::errstr;

#执行sql语句 

$inr->execute() or die $DBI::errstr;

#打印成功信号 

print "WELL DONE!";

#---------------------------------------

posted @ 2006-09-17 10:48 gyn_tadao 阅读(1452) | 评论 (1)编辑 收藏

仅列出标题
共11页: First 3 4 5 6 7 8 9 10 11 
<2010年8月>
25262728293031
1234567
891011121314
15161718192021
22232425262728
2930311234

导航

统计

常用链接

留言簿(15)

随笔分类(126)

随笔档案(108)

相册

搜索

最新评论

阅读排行榜

评论排行榜