闲暇无聊学着写过一个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即可
写了个简单的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;
问题就解决了
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;
这样就没问题了
工作上需要个脚本连服务器
本想用python的
但是貌似python的那个ssh模块儿只支持ssh2
而我们有好多还是跑的ssh1
故而使用了perl
perl的模块儿Net::SSH::Perl倒是ssh1、ssh2大小通吃
但是也有个问题
连ssh2的时候
速度巨慢
google了一下
网上有人说是因为少装了个模块儿:Math::BigInt::GMP
导致和sshd服务器端交换key的时候计算非常慢
同时,还提到2个perl模块儿:YAML和Math::BigInt
说也需要
于是我就装上了
再一跑程序
果然是快了不少
主要是两个地方
第一:执行命令的命令行字符串赋值的位置不对,应该在执行命令之前赋值即可,而不要老早就赋值,因为后面还有对影响其最终值得中间值的改动;
第二:传给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";
<
工作需要
用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
这才搞定
某天,碰到个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删掉
于是问题解决
系统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这个包
看他的文档perldoc IO::Socket::INET
发现有Timeout这个参数
而且在程序里也设置了
但实际情况是
如果用这个包连上一个服务器之后
发命令
但服务器没有反应
也没有断开
这样的话好像程序也不断开
按照我的需求
应该是如果一段时间没有反应的话
程序应该主动断开才是呀
如果不能实现这个的话
那Timeout参数是做什么用的呢
大概看了一些网上的讨论
好像说这个Timeout是连服务器时的Timeout
如果一段时间没连上就超时
也不知道是不是真是这样
不过好像也只有这样才能解释我碰到的情况了
用来检查库里的代理列表是否依旧可用
多线程是用上了,但是不知道缺省是起几个线程
#!/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";
}
最近评论