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