Perl技巧

项目里面一直用的是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

你可能感兴趣的:(perl)