Perl 学习

逃离我推掉我的手 2022-03-28 17:52 248阅读 0赞

1、块注释，You can read more about POD in **perldoc perlpod**.

第一个“=”和“=cut”之间为注释部分。

2、使用\_\_END\_\_(2个\_),\_\_END\_\_下面的部分都会被perl忽略，一般用于在perl代码中添加大量的文档。

**20100223**

1、<>被用来处理所有的输入

**尖括号操作(<>)是一种特殊的行输入操作。其输入可由用户选择，可能是从键盘，或者不是。**

**举个例子，最简单的，打印输入(其实和cat是一样的功能）**

**我们可以在命令行中直接输入：**

**./print.pl read.txt **

**而不需要 cat read.txt|print.pl**

一个程序的调用参数（invocation arguments）,通常是命令行中程序名字后面的一些“字符串”。下例中，它们是要被顺序处理的文件的名字：

./print.pl read.txt read2.txt read3.txt

将运行 print.pl（在当前目录下），它将处理文件 read.txt,再处理文件 read2.txt，最后是文件read3.txt。

如果没有命令行参数，程序将处理标准输入流.

技术上讲，<>从数组@ARGV中得到调用参数。这个数组是Perl 中的一个特殊数组，其包含调用参数的列表。

另：

由于 print 需要一些输出的字符串列表，则其参数是作为列表 context 来求值的。由于<>操作返回的是列表，则它们可很好 的一起工作：

print <>; \# ‘cat’ 的源程序

print sort <>; \#‘sort’ 的源程序

**20100302**

1、特殊变量$^I

变量$^I。默认时为 undef，此时没有什么特殊的地方。但给它设置某些串时，它使尖括号操作(<>)变得有些特殊。

我们知道尖括号(<>)的神奇特点：如果没有指定文件名，则其从标准输入流中自动打开和关闭一系列文件进行读入。但如果$^I中有字符串，这个字符串则会成为备份文件的扩展名。

假 设此时尖括号(<>)打开的文件是 fred03.dat。它像以前那样打开它，但进行了重名名，把它叫做fred03.dat.bak。这很好，因为不在使用之前的名字。现在<>将这个新的文件作为默认的输出，因此任何内容将输出到那个文件中。while循环会从旧的文件中读入一行，更新它，再把它输出到新文件中。

$^I 另一个可能值是空串，这会修改文件，但不会将原来的文件进行备份。

**20100304：**

1、对 \_ 这个文件句柄（此操作数为单个下划线）进行文件检测(file test)，stat，

或lstat操作时，将要求Perl对前一个文件检测(file test), stat,或lstat函数的操作数进行操作，而非再一次的进行系统调用。

第一次检测时使用了默认的变量$\_。这也更加有效率（可能除了对程序员之外），他从操作系统中得到数据。第二次检测使用了 \_ 这个文件句柄。这次检测中，使用第一次检测的文件的大小信息，这是我们所需要的。

对文件句柄 \_ 进行检测不同于对$\_进行检测。使用$\_，可能每一次的值均不同，其为当前$\_中得值，使用 \_ 是为了解决重复调用系统的问题。

**20100429:**

这个例子中的find 命令查找所有在最近90天没有访问。（它们是被备份的好对象）当find 查询时，Perl等待。每当找到时，Perl会将其名字，以及一些其它信息显示出来以供进一步的分析。 如果用反引号来做，我们在find命令执行完之前是得不到任何输出的。通常在没有结束前就看见它在工作是很舒服的。

**20100506：**

给进程组发信号：

进程是组织成进程组的，一起对应一个完整的任务。比如，如果你运行了单个 shell 命令，这条命令是有一系列过滤器命令组成，相互之间用管道传递数据，这些进程（以及它们的子进程）都属于同一个进程组。（即子进程和父进程）

如果你给一个正数的进程号发送信号，该信号只发送给该进程，而如果你给一个负数进程号发送信号，那么该信号将发送给对应的进程组的所有进程，该进程组的进程组号就是这个负数的绝对值。

如：停止所有以941为父进程的进程：

**20100525:**

关于时间格式

time2str 由Date::Format提供，+86400表示1天以后的时间，更多的格式查看perldoc  Date::Format

str2time 由Date::Parse提供

**20100602**

将perl用于shell数字的循环

shell 实现同样功能（详细查看man seq）

<table style="font-size:14px; border-collapse:collapse"> 
 <tbody> 
 <tr> 
 <td style="font-family:宋体,Verdana,Arial,Helvetica,sans-serif; line-height:1.5"> for i in `seq -s ' ' 01 31`;do printf "d " $i;done do&nbsp; echo $i ..... done </td> 
 </tr> 
 </tbody> 
</table>

20100802

打印当前时间

1.  use Date::Format;  
    
2.  print time2str("%Y%m%d-%T",time);

20100831

打印某个时间段的时间，可以设定输出的格式

1.  use Date::Format;  
    
2.  use Date::Parse;  
    
3.  use strict;  
    
4.    
    
5.    
    
6.  my $start=shift;  
    
7.  my $end=shift;  
    
8.  my $add\_seconds;  
    
9.  my $output\_format;  
    
10.   
    
11. my $time\_length=length $start;  
    
12. if ($time\_length eq 13 )\{   
    
13.     \#loop hour  
    
14.     $add\_seconds=3600;  
    
15.     $output\_format="%Y-%m-%d %H";  
    
16. \}elsif($time\_length eq 10)\{   
    
17.     \#loop day  
    
18.     $add\_seconds=3600 \* 24;  
    
19.     $output\_format="%Y-%m-%d";  
    
20. \}else\{   
    
21.     die "Wrong input format:\\nloop day: YYYY-mm-dd\\nloop hour: YYYY-mm-dd-HH";  
    
22. \}  
    
23.   
    
24. my $start\_in\_UTC=str2time($start);  
    
25. my $end\_in\_UTC=str2time($end);  
    
26. die "Wrong,$start later than $end" if $start\_in\_UTC gt $end\_in\_UTC;  
    
27.   
    
28. my @all;  
    
29.   
    
30. while ($start\_in\_UTC le $end\_in\_UTC)\{   
    
31.     my $this\_time=time2str("$output\_format",$start\_in\_UTC);  
    
32.     push @all,$this\_time;  
    
33.     $start\_in\_UTC=$start\_in\_UTC \+ $add\_seconds;  
    
34. \}  
    
35.   
    
36. map \{ print "\\"$\_\\" "\} @all;

shell版本查看： [http://blog.chinaunix.net/space.php?uid=1838361&do=blog&id=3079565][http_blog.chinaunix.net_space.php_uid_1838361_do_blog_id_3079565]

**20101103**

perl正则表达式中的\\1 \\2 \\3

使用捕获的buffers

例如：

/(\\w)\\1/;

匹配包含两个word的字符串。 \\1 表示第一个（）所捕获的\\w

/(\\w)\\1+/; 匹配包含两个或两个以上的字符串。

嵌套捕获时，需要注意要重复的捕获的（）

/((\\w)\\2)\{2,\}/;  注意：捕获变量的顺序按照“开括号（”的顺序指派，不管嵌套与否。

**20101112：**

perl 调用shell内置命令：

通常可以使用system函数或者\`\`来执行系统命令，但是对于shell的内建命令（如alias，ulimit等，详细查看 man -k bash），这样执行时会直接报错，错误内容为无法找到文件或目录，可以通过 bash -c来执行这样的命令。而对于cd、umask等命令，应该使用PERL函数chdir、umask等来实现

**20101115：**

1、修改配置文件：

Normally, modifying a Tie::File array writes to the underlying file immediately. Every assignment like $a\[3\] = ... rewrites as much of the file as is necessary; typically, everything from line 3 through the end will need to be rewritten. This is the simplest and most transparent behavior. Performance even for large files is reasonably good.

However, under some circumstances, this behavior may be excessively slow.

autodefer =>0

Tie::File tries to guess when deferred writing might be helpful, and to turn it on and off automatically.

或：

Open the file in update mode ("+<"), read the whole file into an array of lines, change the array, then rewrite the file and truncate it to its current seek pointer.

<table style="font-size:14px; border-collapse:collapse"> 
 <tbody> 
 <tr style="font-size:10pt"> 
 <td style="font-family:宋体,Verdana,Arial,Helvetica,sans-serif; line-height:1.5; font-size:10pt"> open(F,&nbsp;"+&lt;",&nbsp;$infile)&nbsp;or&nbsp;die&nbsp;"can't read $infile: $!"; $out&nbsp;=&nbsp;""; while&nbsp;(&lt;&lt;/SPAN&gt;F&gt;)&nbsp;{ &nbsp;&nbsp;&nbsp;&nbsp;s/DATE/localtime/eg; &nbsp;&nbsp;&nbsp;&nbsp;$out&nbsp;.=&nbsp;$_; } seek(F,&nbsp;0,&nbsp;0)&nbsp;or&nbsp;die&nbsp;"can't seek to start of $infile: $!"; print F $out&nbsp;or&nbsp;die&nbsp;"can't print to $infile: $!"; truncate(F,&nbsp;tell(F))&nbsp;or&nbsp;die&nbsp;"can't truncate $infile: $!"; close(F)&nbsp;or&nbsp;die&nbsp;"can't close $infile: $!" 
 <div style="line-height:1.5"> 
 
 </div> </td> 
 </tr> 
 </tbody> 
</table>

2、包含递归调用

<table style="font-size:14px; border-collapse:collapse"> 
 <tbody> 
 <tr> 
 <td style="font-family:宋体,Verdana,Arial,Helvetica,sans-serif; line-height:1.5"> #3.disable selinux sub&nbsp;selinux_config { &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print&nbsp;"\nDo you want to disable SELINUX [y/n]:"; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;given&nbsp;(chomp($answer=&lt;&lt;/SPAN&gt;&gt;)){ &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;when&nbsp;($answer ~~ /^y(?:$|es$)/i){ &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$selinux_file="/etc/selinux/config"; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;tie(@content,Tie::File,$selinux_file,autodefer&nbsp;=&gt;&nbsp;0)&nbsp;or&nbsp;die $!; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;foreach&nbsp;(@content)&nbsp;{ &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;s/enforcing/disabled/g&nbsp;if&nbsp;grep {/SELINUX=/}&nbsp;$_; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;} &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;system("/usr/sbin/setenforce 0 "); &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print&nbsp;"SELINUX is disabled,you didn't need to reboot.\n"; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;} &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;when&nbsp;($answer ~~ /^n(?:$|o$)/i){ print&nbsp;"SELINUX still on\n"} &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;default { &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print&nbsp;"UNKNOW RESPONSE\n"; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&amp;selinux_config ; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}; } &amp;selinux_config </td> 
 </tr> 
 </tbody> 
</table>

**20101116：**

**1、Use map  when you need to transform one list into another.**

**Use grep  to ﬁlter a list.**

**Use foreach  when you want to modify the variable in-place.**

**20101118：**

Use Perl::Tidy  to beautify code

echo "install Perl::Tidy"|perl -MCPAN -eshell

使用，例如：ugly.pl

执行： perltidy ugly.pl

结果为：ugly.pl.tdy

配置Perl::Tidy,例如，更改缩进为4，更改输出为stdout，而不是.tdy

perltidy -st -i=4  ugly.pl

bracing style

perltidy -st -bl -bli ugly.pl

<table style="font-size:14px; border-collapse:collapse"> 
 <tbody> 
 <tr> 
 <td style="font-family:宋体,Verdana,Arial,Helvetica,sans-serif; line-height:1.5"> &nbsp; use warnings;&nbsp; use strict;&nbsp; while (&lt;&gt;) &nbsp;&nbsp;{ &nbsp;&nbsp; &nbsp; &nbsp;if &nbsp; (/\d/) { print "contains number\n"; }&nbsp; &nbsp;&nbsp; &nbsp; &nbsp;else &nbsp; &nbsp; &nbsp; &nbsp;{ print "number-free\n" } &nbsp;&nbsp;} </td> 
 </tr> 
 </tbody> 
</table>

By default, Test::PerlTidy  uses the standard options. If you want your

code formatted with different options, ensure that you have a  .perltidyrc

ﬁle in the root of your distribution or in your home directory.

**20101220**

**scp、ssh 可以使用密码来验证的模块：**

**[Net::OpenSSH][Net_OpenSSH]**

<table style="font-size:12px; border-collapse:collapse"> 
 <tbody> 
 <tr style="font-size:10pt"> 
 <td style="font-family:宋体,Verdana,Arial,Helvetica,sans-serif; line-height:1.5; font-size:10pt"> #3、scp files my $ssh&nbsp;=&nbsp;Net::OpenSSH-&gt;new( &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$host, &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;user&nbsp;=&gt;&nbsp;$user, &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;password&nbsp;=&gt;&nbsp;$password, &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;); die&nbsp;"Can't ssh to $host: "&nbsp;.&nbsp;$ssh-&gt;error if $ssh-&gt;error; $ssh-&gt;scp_put({ quiet&nbsp;=&gt;&nbsp;0,recursive&nbsp;=&gt;&nbsp;1},"$backup_file","$remote_dir"); #4、rm remote host old files $ssh-&gt;system("find $remote_dir -mtime +20 -name project*|xargs rm") 
 <div style="line-height:1.5"> 
 
 </div> </td> 
 </tr> 
 </tbody> 
</table>

另外两个模块也可以实现：

scp 可以使用密码来验证的模块：

[Net::SCP::Expect][Net_SCP_Expect]

ssh，使用密码来验证

[Net::SSH::Expect][Net_SSH_Expect]

或

[ Net::SSH::Perl][Net_SSH_Perl]

<table style="font-size:14px; border-collapse:collapse"> 
 <tbody> 
 <tr> 
 <td style="font-family:宋体,Verdana,Arial,Helvetica,sans-serif; line-height:1.5"> #3¡;￠scp files if&nbsp;(-e $backup_file){ &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print&nbsp;"tar file ok\n"; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $scpe&nbsp;=&nbsp;Net::SCP::Expect-&gt;new(host=&gt;"$host",&nbsp;user=&gt;"$user",password=&gt;"$password"); &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$scpe-&gt;scp("$backup_file","$remote_dir"); }else{ &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print&nbsp;"tar file false\n"; } #4¡;￠rm remote host old files my $ssh&nbsp;=&nbsp;Net::SSH::Expect-&gt;new&nbsp;( &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;host&nbsp;=&gt;&nbsp;"$host", &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;user&nbsp;=&gt;&nbsp;"$user", &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;password&nbsp;=&gt;&nbsp;"$password", &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;raw_pty&nbsp;=&gt;&nbsp;1 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;); my $login_output&nbsp;=&nbsp;$ssh-&gt;login(); die&nbsp;"Login has failed. Login output was: $login_output"&nbsp;if&nbsp;$login_output&nbsp;!~&nbsp;/Last login:/; my $find_rm&nbsp;=&nbsp;$ssh-&gt;exec("find $remote_dir -mtime +20 -name project*"); #print&nbsp;"$find_rm\n"; $ssh-&gt;close() </td> 
 </tr> 
 </tbody> 
</table>

20101221

使用匿名函数打印当前时间

创建匿名函数

1.  use Date::Format；
2.  my $current\_time=sub \{   
    
3.          time2str("%Y%m%d-%T",(time))  
    
4.  \};  
    
5.    
    
6.  print &$current\_time."\\n"

**20101228**

对于while阻塞perl，可以将改while放到一个异步程序中，由调用程序来kill掉调用程序。

或者使用fork子进程来解决，查看：

[http://blog168.chinaunix.net/space.php?uid=1838361&do=blog&id=66643][http_blog168.chinaunix.net_space.php_uid_1838361_do_blog_id_66643]

**20110105**

改变终端输出的颜色

Use the CPAN module Term::ANSIColor to send the ANSI color-change sequences to the user's terminal:

1.  use Term::ANSIColor qw(:constants);
2.  print RED, "Danger, Will Robinson!\\n", RESET;

**20110111**

File::Copy

The File::Copy module provides two basic functions, copy and move , which are useful for getting the contents of a file from one place to another.

**20110130**

关于在perl的system（）中echo “@”

1.  system ("echo @")

这样写的话@会被当做数组的@符号，达不到目的，应该用下面两种方法来写：

1.  @args=("echo","@");
2.  system(@args);

1.  $a='@';
2.  system("echo $a");

20110302

数据库连接的模块

1.  \#@ \_MODULE\_INITIAL\_
2.  package Cookbook;
3.  \# Cookbook.pm - library file with utility method for connecting to MySQL
4.  \# via Perl DBI module
5.  use strict;
6.  use warnings;
7.  use DBI;
8.  my $db\_name = "cookbook";
9.  my $host\_name = "localhost";
10. my $user\_name = "cbuser";
11. my $password = "cbpass";
12. my $port\_num = undef;
13. my $socket\_file = undef;
14. \# Establish a connection to the cookbook database, returning a database
15. \# handle. Raise an exception if the connection cannot be established.
16. sub connect
17. \{
18. my $dsn = "DBI:mysql:host=$host\_name";
19. my %conn\_attrs = (PrintError => 0, RaiseError => 1, AutoCommit => 1);
20. $dsn .= ";database=$db\_name" if defined $db\_name;
21. $dsn .= ";mysql\_socket=$socket\_file" if defined $socket\_file;
22. $dsn .= ";port=$port\_num" if defined $port\_num;
23. return (DBI->connect ($dsn, $user\_name, $password, \\%conn\_attrs));
24. \}
25. \#@ \_MODULE\_INITIAL\_
26. \#@ \_MODULE\_END\_
27. 1; \# return true
28. \#@ \_MODULE\_END\_

注：模块文件最后一行总是返回true的语句，这是必须的。因为如果模块没有返回一个true值，perl会假设模块出现了错误，并在读取它之后退出。

将改文件放到/opt下，添加到环境变量中

export PERL5LIB=/opt

使用

1.  \#!/usr/bin/perl -w
2.  use strict;
3.  use Cookbook;
4.  my $dbh;
5.  eval
6.  \{
7.  $dbh=Cookbook::connect();
8.  print "Connect!\\n";
9.  \};
10. die "$@" if $@;
11. $dbh->disconnect();

**20110315**

摘自《perl最佳实践》

1.  if(/^(\\d\+) (\\D\+)$/)  
    
2.  改为  
    
3.  if(m\{ ^(\\d\+) \#匹配数字  
    
4.         (\\D\+)$   \#匹配非数字  
    
5.     \}xms)

其中：/x模式可以让正则表达式以较具可维护性的方式进行部署及说明。在/x模式下，正则表达式里的空白会被忽略掉，所以你可以人随意使用空白和换行字符以缩排和部署

需要注意的是，这样的话，数据里的空白就要用\\s来匹配，而不能使用“ ”来匹配

/m，在sed，awk，grep等重，^,$指“匹配任何行的开头及末尾”，但在perl中，指的是“匹配整个字符串的开头和结尾”，使用/m，可以使perl中的行为与上面的程序的行为一致。

/s,点号元字符（.）在perl中兵不是“匹配任何字符”，因为点号元字符并不匹配换行字符，使用/s可以视其也匹配换行符。

下面是一个access log日志的例子

1.  if (m\{ ^((?:\\d\{ 1,3\})\\.(?:\\d\{ 1,3\})\\.(?:\\d\{ 1,3\})\\.(?:\\d\{ 1,3\})) \#ip  
    
2.          \\s\* \- \\s \- \#nothing  
    
3.          \\s\* \\\[(.\*?)\\\] \#time  
    
4.          \\s\* "GET\\s /(?:\\w)+/www/delivery/ta\\.php\\?trackerid=(\\d+)(\\D\*\[\\d\\D\]\*) \#url  
    
5.          \\s\* HTTP\\/1\\.\[01\]" \#proto  
    
6.          \\s\* \\d\+ \\s \\d\+ \#status byte  
    
7.          \\s\* "(?:.\*?)" \#refer  
    
8.          \\s\* "(?:.\*?)" \#agent  
    
9.          \\s\* "(\[A-Z0-9\]\{16,21\})"$ \#guid  
    
10.      \}xms)\{

一个例子，取出url中的域名的域

1.  if ($url=~m\{ http://  
    
2.                            (  
    
3.                            \[^.\\s\]\+  
    
4.                            \\.(?:com|net|org|gov|cc|biz|info|cn|tv)  
    
5.                            (?:\\.cn|\\.hk)  
    
6.                            )  
    
7.                      \}xms) \{   
    
8.                          print "$1\\n";  
    
9.                  \}  
    
10.   elsif($url=~m\{ http://  
    
11.                           (?:\[^.\\s\]\+\\.)?  
    
12.                           (  
    
13.                           \[\\S\\.\]\+  
    
14.                           \\.(?:com|net|org|gov|cc|biz|info|cn|tv)  
    
15.                           (?:\\.cn|\\.hk)?  
    
16.                           )  
    
17.                     \}xms) \{   
    
18.                         print "$1\\n";  
    
19.                 \}

上面的第一个if专门用来匹配类似jzol.com.cn这种url的域名

用于测试域名：

http://e.baidu.com

http://www.etnet.com.cn

http://www.ynet.com

http://www.zol.com.cn

http://www.isoshu.com

http://www.online.sh.cn/

http://www.forex.com.cn/

http://www.17you.com/

http://www.boosj.com/

http://abcde.com

http://jzol.com.cn

[http_blog.chinaunix.net_space.php_uid_1838361_do_blog_id_3079565]: http://blog.chinaunix.net/space.php?uid=1838361&do=blog&id=3079565
[Net_OpenSSH]: http://search.cpan.org/~salva/Net-OpenSSH-0.50/lib/Net/OpenSSH.pm#Net::OpenSSH_methods
[Net_SCP_Expect]: http://search.cpan.org/~djberg/Net-SCP-Expect-0.12/Expect.pm
[Net_SSH_Expect]: http://search.cpan.org/~bnegrao/Net-SSH-Expect-1.09/lib/Net/SSH/Expect.pod
[Net_SSH_Perl]: http://search.cpan.org/~turnstep/Net-SSH-Perl-1.34/lib/Net/SSH/Perl.pm
[http_blog168.chinaunix.net_space.php_uid_1838361_do_blog_id_66643]: http://blog168.chinaunix.net/space.php?uid=1838361&do=blog&id=66643