存档

文章标签 ‘Perl’

使用perl中函数sysopen的一个弱智问题

2009年12月30日 哈哈 没有评论

闲暇无聊学着写过一个perl程序
用来从网上抓点东西下来
再改吧改吧，存到本地的文件里
最早打开文件用的是open
但后来为了直接在open时就设定打开的文件的权限
就改用sysopen
像这样：

my $save_u = umask();
umask(0);
if (sysopen(FH, $path, O_RDWR|O_CREAT, $fmode)) {
print FH ($data);
close(FH);
} else {
print “Couldn’t open $path for writing:$!
\n”;
return 2;
}
umask($save_u);

但后来发现写入的文件尾巴上老有点问题
最开始老以为是某个替换内容用的正则表达式有问题
但查了半天都没查出来为什么
把每一个正则替换前后的数据都打印出来了没发现问题
最后甚至于把写到文件里去的数据打出来
还是没发现问题
最后就只有落到sysopen这里
认为是写错了
最后把sysopen那一行改成

if (sysopen(FH, $path, O_WRONLY|O_CREAT|O_TRUNC, $fmode)) {

这下终于好了
不过到今天才真正想明白为什么出问题
是因为sysopen时少了个参数O_TRUNC
这样的话打开的文件原来存在的话
没有执行truncate工作
直接从前往后写
也就是覆盖原来的内容
这种情况下
如果新内容比老内容多的话不会出问题
因为原来所有的内容都给覆盖掉了
可万一新内容比旧内容少的时候
就会留下老内容的一段尾巴
所以我们从页面上看老是尾巴上多一点东西
至于O_RDWR改成O_WRONLY则是非必须的
原因是为什么呢
这是因为打开原来存在的文件的时候没有truncate掉原来的内容
所以写到最后一段
如果没内容写了
那么原来文件的最后一部分就留下了
所以呢解决的方法很简单
在sysopen的option参数中加上O_TRUNC即可

分类: Programe, TroubleShooting 标签: , , ,

perl程序出”Unknown encoding: gb18030″错的问题

2009年12月1日 哈哈 没有评论

写了个简单的perl程序
用来转码(gbk->utf8，utf8->gbk)之类
其中涌到了perl包Encode
发现个问题
当调用Encode包中的方法decode的时候，出错了
代码是这么写的
$html = decode($charset, $html);
当执行到这里的时候就报错：

Unknown encoding: gb18030

上面代码里的$charset是通过Encode::Detect::Detector->detect方法检测到的某个文件的编码
这里是gb18030

最后是怎么解决的呢
装了个perl包：Encode::HanExtra
并在程序里加上

use Encode::HanExtra;

问题就解决了

分类: Programe, TroubleShooting 标签: , , , , ,

How do I extract URLs from html?

2009年11月23日 哈哈 没有评论

perl的faq第九节有个简洁的例子

#!/usr/bin/perl -n00
# qxurl – tchrist@perl.com
print “$2\n” while m{
< \s* A \s+ HREF \s* = \s* (["']) (.*?) \1 \s* >
}gsix;

这个正则表达式相当简单实用
但是实际上有点问题
比如
<a href=”xxxxxxx” target=”_blank”>
这样的html代码
就会匹配出xxxxxxx” target=”_blank
这显然不行
于是做了小小的改动：

#!/usr/bin/perl -n00
# qxurl – tchrist@perl.com
print “$2\n” while m{
< \s* A \s+ HREF \s* = \s* (["']) (.*?) \1 \s* [^>]*
\s* >
}gsix;

这样就没问题了

分类: Programe, tips 标签: , , , ,

用Net::SSH::Perl连服务器巨慢……

2009年2月4日 哈哈 1 条评论

工作上需要个脚本连服务器
本想用python的
但是貌似python的那个ssh模块儿只支持ssh2
而我们有好多还是跑的ssh1
故而使用了perl
perl的模块儿Net::SSH::Perl倒是ssh1、ssh2大小通吃
但是也有个问题
连ssh2的时候
速度巨慢
google了一下
网上有人说是因为少装了个模块儿：Math::BigInt::GMP
导致和sshd服务器端交换key的时候计算非常慢
同时，还提到2个perl模块儿：YAML和Math::BigInt
说也需要
于是我就装上了
再一跑程序
果然是快了不少

分类: Open Source, Operation System, Programe 标签: , , , , , ,

用snmp抓服务器tcp_connection信息的程序lvm_netstat_tcp.pl的bug

2009年1月4日 哈哈 没有评论

主要是两个地方
第一：执行命令的命令行字符串赋值的位置不对，应该在执行命令之前赋值即可，而不要老早就赋值，因为后面还有对影响其最终值得中间值的改动；
第二：传给snmpnetstat的参数不对
具体如下：

[@monitor snmp]# diff /opt/cacti/scripts/lvm_netstat_tcp.pl /opt/software/lvm_netstat_tcp.pl
15a16,17
> my $_cmd = “snmpnetstat -v $in_version -c $in_community -t $in_timeout -n -P tcp $in_hostname:$in_port”;
>
34,35d35
< my $_cmd = "snmpnetstat -v $in_version -c $in_community -Cw $in_timeout -Cn -Cp tcp $in_hostname:$in_port";
<

分类: Operation System 标签: , , , ,

使用perl包Net::SSH::Perl时的小问题

2008年12月1日 哈哈 没有评论

工作需要
用perl写了个程序ssh到一些机器上去做一些操作
于是就用了Net::SSH::Perl这个perl模块儿
感觉这个东西还挺好用的
但有一个需要注意的
就是redhat系列的系统
自带的ssh client的全局配置文件是/etc/ssh/ssh_config
而Net::SSH::Perl认的是/etc/ssh_config
因为这样
所以有台机器我用ssh命令直接连没有问题
但是通过Net::SSH::Perl就连不上
后来通过把/etc/ssh/ssh_config拷一份为/etc/ssh_config
这才搞定

分类: Open Source, Programe 标签: , , , ,

执行perl程序时load某个.so文件出错的问题

2007年6月11日 哈哈 没有评论

某天，碰到个perl的问题
执行某个perl程序的时候(这个程序通过DBD::Mysql连mysql数据库)
出错，具体出错提示忘了
大意思是：
load动态模块mysql.so的时候load其依赖的模块儿libssl.so.5失败(因为没有libssl.so.5这个文件)
我找了下
有/lib/libssl.so.4和/lib/libssl.so.6就是没有/lib/libssl.so.5
libssl.so.4和libssl.so.6其实是openssl的版本0.97a和0.98的东西
我在别的机器上翻了一下，发现/lib/libssl.so.5是openssl版本0.97f的东东
而我现在的系统(fc5, Fedora Core 5)下没有0.97f的openssl
这下好像陷入困境了
再仔细想想：
不对呀，我的DBD::Mysql也是yum装上的呀，如果它依赖于某个东西的话，yum怎么会没自动装上呢
就算某种原因没装上的话装DBD::Mysql的时候也应该会报错才对呀
再仔细看
发现了load的动态模块儿mysql.so是/usr/lib/perl5/site_perl/5.8.6/i386-linux-thread-multi/auto/DBD/mysql/目录下的
而load进这个mysql.so的却是/usr/lib/perl5/5.8.8/i386-linux-thread-multi/DynaLoader.pm这个文件
因为我的系统升过级
perl也由5.8.6升到5.8.8
但现在看来新perl(5.8.8) load的还是原来5.8.6下装的mysql模块儿
不对！
于是rpm -ql perl-DBD-MySQL一下
发现原来新的DBD::MySQL装的mysql.so是装在目录/usr/lib/perl5/vendor_perl/5.8.8/i386-linux-thread-multi/auto/DBD/mysql/下的！！
但是加载DBD::MySQL的时候又怎么会跑去/usr/lib/perl5/site_perl/5.8.6/i386-linux-thread-multi/auto/DBD/mysql/mysql.so这里呢？

看了下/etc/ld.so.conf
发现有目录/usr/lib/
猜想：
会不会因为site_perl比vendor_perl优先被查找(字母’s’比’v'排在前面)
而以前perl 5.8.6的时候也手工安装过DBD::MySQL包
而且装在了site_perl下
所以load的时候就先找到了/usr/lib/perl5/site_perl/5.8.6/i386-linux-thread-multi/auto/DBD/mysql/mysql.so
而那会儿的mysql.so是依赖于libssl.so.5的
而现在系统没有/lib/libssl.so.5，所以出错
解决方法：
把/usr/lib/perl5/site_perl/5.8.6/i386-linux-thread-multi/auto/DBD/mysql/mysql.so删掉
于是问题解决

分类: 未分类 标签: ,

用CPAN安装perl包HTTP::Proxy的问题及解决

2007年4月1日 哈哈 没有评论

系统fedora core 4 + perl 5.8.6
用cpan模块儿(perl -MCPAN -e shell)安装perl包HTTP::Proxy的时候报错：

t/90diveintomark….ok 7/22# Failed test (t/90diveintomark.t at line 75)
# got: ‘500′
# expected: ‘302′
t/90diveintomark….ok 21/22 make: *** wait: No child processes. Stop.
make: *** Waiting for unfinished jobs….
make: *** wait: No child processes. Stop.
/usr/bin/make test — NOT OK
Running make install
make test had returned bad status, won’t install without force

到”t/90diveintomark….ok 21/22“这一步会停留很长时间
google了一把
发现HTTP::Proxy需要

HTTP::Daemon 1.36
LWP::UserAgent 2.033
Test::More 0.60

所以要求这几种包及其版本
然后我就install HTTP::Daemon
发现HTTP::Daemon is up to date.
然后install LWP::UserAgent
又是up to date.
最后install Test::More
这下开始安装了
OK后
再重新install HTTP::Proxy就没问题了

分类: 未分类 标签: ,

perl包IO::Socket::INET的timeout的问题

2006年12月1日 哈哈 1 条评论

最近接触到个perl程序
其中用到了IO::Socket::INET这个包
看他的文档perldoc IO::Socket::INET
发现有Timeout这个参数
而且在程序里也设置了
但实际情况是
如果用这个包连上一个服务器之后
发命令
但服务器没有反应
也没有断开
这样的话好像程序也不断开

按照我的需求
应该是如果一段时间没有反应的话
程序应该主动断开才是呀
如果不能实现这个的话
那Timeout参数是做什么用的呢

大概看了一些网上的讨论
好像说这个Timeout是连服务器时的Timeout
如果一段时间没连上就超时
也不知道是不是真是这样
不过好像也只有这样才能解释我碰到的情况了

分类: 未分类 标签:

第一个用到多线程的perl程序

2006年5月17日 哈哈 没有评论

用来检查库里的代理列表是否依旧可用

多线程是用上了，但是不知道缺省是起几个线程

:(

#!/usr/bin/perl

use strict;

use DBI();

use HTTP::ProxyCheck;

use threads;

my $DEBUG = 1;

# Connect to the database.

my $TimeToLive = 5;     # 3 days

my $dbh = DBI->connect("DBI:mysql:database=proxyservers;host=localhost;mysql_socket=/var/lib/mysql/mysql.sock",

                        "root", "", {‘RaiseError’ => 1});

my $sql = "select id, ipn, port from proxy where now() – INTERVAL 1 day > t_checked order by t_checked";

print $sql if ($DEBUG);

my $sth = $dbh->prepare("$sql");

$sth->execute();

while (my $ref=$sth->fetchrow_hashref()) {

        my $thr = threads->new(\&CheckHTTPProxy, "$ref->{‘ipn’}", "$ref->{‘port’}");

        if ($thr->join) {

#       if (CheckHTTPProxy($ref->{‘ipn’}, $ref->{‘port’})) {

                $sql = "update proxy set t_checked = now() where id = $ref->{‘id’}";

                print $sql if ($DEBUG);

                $dbh->do("$sql");

        }

}

$sql = "delete from proxy where now() – INTERVAL $TimeToLive day > t_checked";

print $sql if ($DEBUG);

$dbh->do("$sql");

$dbh->disconnect();

sub CheckHTTPProxy

{

        my ($ipn, $port) = @_;

        my $ip = num2str($ipn);

        my $proxy = "$ip:$port";

        my $url = ‘http://search.cpan.org/’;

        my $proxy_check = new HTTP::ProxyCheck(

                proxy           => $proxy,

                url             => $url,

                answer_size     => ‘header’,

                print_error     => 0,

        ) or return 0;

        print "Trying to connect to ‘$proxy’ and retrieve ‘$url’\n" if ($DEBUG);

        if ( $proxy_check->check() ) {

                print "’$proxy’ returns:\n\n", $proxy_check->get_answer(), "\n\n" if ($DEBUG);

                return 1;

        } else {

                print "Error: ", $proxy_check->get_error(), "\n" if ($DEBUG);

                return 0;

        }

}

sub num2str

{

        my ($ipn) = @_;

        my $z = $ipn % 256;

        $ipn >>= 8;

        my $y = $ipn % 256;

        $ipn >>= 8;

        my $x = $ipn % 256;

        $ipn >>= 8;

        my $w = $ipn % 256;

        return "$w.$x.$y.$z";

}

分类: 未分类 标签: