Perl技巧

ezeke

　　项目里面一直用的是Perl，Perl里有各种小技巧就分享在这吧。
　　
　　push(@a, $b)
　　把b元素压入a数组中，
　　还可以有
　　push(@a, [@b]);
　　那a就成了二维数组了
　　
　　scalar(@a);
　　my $b = @a;
　　a的长度
　　
　　=~的正则匹配时
　　=~s///g全局替换
　　=//i匹配，$1,$2对应第一个，第二个捕获组
　　
　　opendir
　　readdir
　　遍历目录
　　
　　my($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst)=localtime(time());
　　时间
　　



use Encode;
sub gbk2utf8()
{
　　return encode('utf-8', decode('gbk', $_[0]));
}
　　编码转换
　　
　　Guess
　　猜测编码(用法略)
　　
　　$a=<STDIN>
　　从标准读入读入一行
　　
　　神奇的Tk库，详见
　　http://search.cpan.org/~srezic/Tk-804.033/Tk.pod
　　图形界面，虽然比较挫
　　强推目录选择的小工具
　　chooseDirector



1 use Tk;
2
3 #新建一个窗口
4 my $mw = MainWindow->new;
5 #把主窗口隐藏
6 $mw->iconify;
7 #选择一个目录
8 my $dir = $mw->chooseDirectory(-title => encode('gbk', decode('utf-8', '请选择你要检查的目录')), -initialdir => '.\..\app');
　　
　　Tk窗口控制



$mw->iconify; # Minimize
$mw->deiconify; # Restore
$mw->state('withdrawn'); # Hide
$mw->state('normal'); # Show
　　
　　



use Net::TcpDumpLog;
use NetPacket::Ethernet;
use NetPacket::TCP;
use NetPacket::UDP;
　　解析pcap文件



1 #获取唯一标识一条流的五元组信息：src_ip, dest_ip, src_port, dest_port, l4_protocol
2 sub get_stream_key {
3   my ($raw_pkt) = @_;
4   my ($eth_obj, $ip_obj, $tcp_obj, $udp_obj);
5   my $l4_protocol;
6   my %stream_key = ();
7
8   #解析当前包;
9   $eth_obj = NetPacket::Ethernet->decode($raw_pkt);
10   $ip_obj = NetPacket::IP->decode($eth_obj->{data});
11   $stream_key{"src_ip"}  = $ip_obj->{src_ip};
12   $stream_key{"dest_ip"} = $ip_obj->{dest_ip};
13   $stream_key{"proto"} = $ip_obj->{proto};
14   $l4_protocol = $ip_obj->{proto};
15   if ($l4_protocol eq NetPacket::IP::IP_PROTO_TCP)
16   {
17     $tcp_obj = NetPacket::TCP->decode($ip_obj->{data});
18     $stream_key{"src_port"}  = $tcp_obj->{src_port};
19     $stream_key{"dest_port"}  = $tcp_obj->{dest_port};
20     $stream_key{"data"} = $tcp_obj->{data};
21   }
22   elsif ($l4_protocol eq NetPacket::IP::IP_PROTO_UDP)
23   {
24     $udp_obj = NetPacket::UDP->decode($ip_obj->{data});
25     $stream_key{"src_port"}  = $udp_obj->{src_port};
26     $stream_key{"dest_port"}  = $udp_obj->{dest_port};
27     $stream_key{"data"} = $udp_obj->{data};
28   }
29   
30   return %stream_key;
31 }
　　
　　YAML::Syck
　　解析YAML文件
　　
　　foreach 哈希数组 排序



foreach my $key (sort {$a cmp $b} keys %$data)
　　
　　



use Spreadsheet::XLSX;
　　解析xlsx
　　初始化



  my $converter = Text::Iconv->new ("utf-8", "GBK");
my $excel = Spreadsheet::XLSX->new ($filename, $converter);
　　遍历表（那个逻辑或实在是没有看懂）



  foreach my $sheet (@{$excel->{Worksheet}})
{
$sheet->{MaxRow} ||= $sheet->{MinRow};
foreach my $row ($sheet->{MinRow} .. $sheet->{MaxRow})
{     
$sheet->{MaxCol} ||= $sheet->{MinCol};
foreach my $col ($sheet->{MinCol} ..  $sheet->{MaxCol})
{
my $cell = $sheet->{Cells} [$row] [$col];
if ($cell)
{
my $val = $cell->{Val};
}
}
}
}
　　
　　解析XML



use XML::Simple;
my $xmldata = XMLin($xmlname);
　　
　　SSH协议
　　推荐使用Net::SSH2
　　虽然这个还是很不好使



use Net::SSH2;
#登陆服务器
my $ssh = Net::SSH2->new();
#$ssh->debug(1);
$ssh->connect($host);
if (!($ssh->auth_password($user, $passwd)))
{
print "Login Failed\n";
system('pause');
exit(1);
}
　　执行命令（这个是复制过来的，来源未知）
　　$print不为0时，会直接在屏幕上打印



sub cmd {
my ($ssh, $print, $cmd) = @_;
my $timeout = 250;
my $bufsize = 4096;
#needed for ssh->channel
$ssh->blocking(1);
my $chan=$ssh->channel();
$chan->exec($cmd);
# defin polling context: will poll stdout (in) and stderr (ext)
my $poll = [{ handle => $chan, events => ['in','ext'] }];
# hash of strings. store stdout/stderr results
my %std=();
$ssh->blocking( 0 ); # needed for channel->poll
while(!$chan->eof) {
$ssh->poll($timeout, $poll);
# number of bytes read (n) into buffer (buf)
my( $n, $buf );
foreach my $ev (qw(in ext)) {
next unless $poll->[0]{revents}{$ev};
#there are something to read here, into $std{$ev} hash
#got n byte into buf for stdout ($ev='in') or stderr ($ev='ext')
if( $n = $chan->read($buf, $bufsize, $ev eq 'ext') ) {
$std{$ev} .= $buf;
if ($print & ($ev eq 'in'))
{
print encode("gbk", decode('utf-8', $buf));
}
}
}
}
$chan->wait_closed(); #not really needed but cleaner
my $exit = $chan->exit_status();
$chan->close(); #not really needed but cleaner
$ssh->blocking(1); # set it back for sanity (future calls)
return ($std{in}, $std{ext}, $exit);
}
　　
　　FTP协议



use Net::FTP;
my $ftp = Net::FTP->new('$ip') or die "Cannot connect.\n";
$ftp->login('$user', '$pw') or die "Could not login.\n";
$ftp->binary;
$ftp->put($filename) or die "Upload failed\n";
$ftp->quit;
　　
　　TELNET协议
　　比较蛋疼，写等写等这种模式好像靠谱些



use Net::Telnet;
my $tel = new Net::Telnet (Timeout  => 10);
$tel->open('$ip') or die "Connect NetCore failed\n";
$tel->waitfor('...');
$tel->print('...');
$tel->waitfor('...');
$tel->print('...');
$tel->waitfor('...');
$tel->print('...');
　　
　　当前路径
　　注意C大写



use Cwd;
my $path = getcwd();
　　
　　正则匹配 修饰符
i 完成不区分大小写的搜索
g 查找所有出现(all occurrences，完成全局搜索)
m 将一个字符串视为多行(m就标识多multiple)。默认情况下，^和$字符串匹配字符串中的最开始和最末尾。使用m修饰符将使^和$匹配字符串中每行的开始
s 将一个字符串视为一行，忽略其中的所有换行符；他与m修饰符正好相反
X 忽略正则表达式中的空白和注释
U 第一次匹配后停止，许多量词很"贪婪"，将尽可能的完成匹配。而不是在第一次匹配后停止。利用这个修饰符，可以让它们"不再贪婪"
　　转自 http://www.cnblogs.com/wk0423/archive/2011/04/17/2018957.html
　　
　　if 参数
　　检测选项含义
-r 文件或目录对此（有效的）用户（effective user）或组是可读的
-w 文件或目录对此（有效的）用户或组是可写的
-x 文件或目录对此（有效的）用户或组是可执行的
-o 文件或目录由本（有效的）用户所有
-R 文件或目录对此用户(real user)或组是可读的
-W 文件或目录对此用户或组是可写的
-X 文件或目录对此用户或组是可执行的
-O 文件或目录由本用户所有
-e 文件或目录名存在
-z 文件存在，大小为0（目录恒为false）
-s 文件或目录存在，大小大于0（值为文件的大小，单位：字节）
-f 为普通文本
-d 为目录
-l 为符号链接
-S 为socket
-p 为管道(Entry is a named pipe(a“fifo”))
-b 为block-special 文件（如挂载磁盘）
-c 为character-special 文件（如I/O 设备）
-u setuid 的文件或目录
-g setgid 的文件或目录
-k File or directory has the sticky bit set
-t 文件句柄为TTY(系统函数isatty()的返回结果；不能对文件名使用这个测试)
-T 文件有些像“文本”文件
-B 文件有些像“二进制”文件
-M 修改的时间（单位：天）
-A 访问的时间（单位：天）
-C 索引节点修改时间（单位：天）
　　转自 http://blog.sina.com.cn/s/blog_4a082449010112h8.html