第十章：其他控制结构 (1) unless控制结构 如果你让代码块在条件为假时才执行，请把if改为unless： unless ($fred =~ /\A[A-Z_]\w*\z/i) #除非条件为真，否则就执行里面的代码 {     print "The value of \$fred doesn't look like a Perl identifier name.\n"; } 等价于： if ( ! ($fred =~ /\A[A-Z_]\w*\z/i)) #除非条件为真，否则就执行里面的代码 {     print "The value of \$fred doesn't look like a Perl identifier name.\n"; } 伴随unless的else子句 虽然语法支持，但却有潜在的语义混淆。 unless ($mon =~ /\AFeb/) {     print "This month has at least thirty days.\n"; } else {     print  "Do you see what's going on here?\n"; } 可以改写为： if ($mon =~ /\AFeb/) {     print  "Do you see what's going on here?\n"; } else {     print "This month has at least thirty days.\n";     } (2) until控制结构 如果想颠倒while循环的条件表达式，可以使用until until ($j >$i) {      $j *= 2; } 这个循环一直执行，直到条件为真。 (3) 表达式修饰符 表达式后面可以接一个用于控制它行为的修饰符 print "$n is a negative number.\n" if $n < 0; 等价于： if ($n < 0) {      print "$n is a negative number.\n" } 其他几个修饰符： &error("Invalid input") unless &valid($input); $i *= 2 until $i > $j; &greet($_) foreach @person; #这里使用foreach的修饰符时无法自选控制变量，必须得使用$_ (4) 裸块控制结构 裸块只执行一次，并不循环 使用裸块为临时词法变量限定作用域 {     print "Please enter a number: ";     chomp(my $n = <STDIN>);     my $root = sqrt $n;     print "The square root of $n is $root.\n"; } (5) elsif子句 if ( ! defind $dino) {     print "The value is undef.\n";     } elsif ($dino =~ /^-?\d+\.?$/) {     print "The value is an integer.\n"; } elsif () {     ... } else {     ... } (6) 自增和自减 my $bedrock = 42; $bedrock++; print "\$bedrock value is $bedrock\n"; $bedrock--; print "\$bedrock value is $bedrock\n"; 这类操作符的一个常见的用法就是配合哈希计数判断之前已经见过的条目： my @people = qw{ fred barney bamm-bamm wilma dino barney betty pebbles }; my %seen; foreach (@people) {     print "I've seen you somwhere before,$_\n" if $seen{$_}++; #如果将++放在前面，则每个都会输出。 } 说明：当barney第一次出现的时候，$seen{$_}++的值为假，因为$seen{"barney"}的值为undef。 不过由于这个表达式具体将$seen{"barney"}递增的副作用，所以当再次遇到barney时，$seen{"barney"}的值就为真。 (7) for控制结构 for (初始化; 测试; 递增) {     程序主体; } for ($i = -150; $i < 1000; $i += 3) {     print "$i\n"; } (8) foreach和for之间的秘密关系 for (1..10) #实际上就是一个从1到10的foreach循环 组号写成foreach {     print "I can count to $_!\n"; } 在Perl里面，foreach是一个更好的选择 (9) 循环控制 Perl有三种循环控制操作符： 1. last操作符: last操作符能立即中止循环的执行，类似于break #打印输入中所有提到fred的行，直到碰到_END_记号为止 while (<STDIN>) {     if (/_END_/)     {         last;     }     elsif (/fred/)     {         print;     } } Perl中有五种循环块,for foreach while until以及裸块(都可以使用last退出) 2. next操作符 next操作符会退出本次循环，执行下次循环，类似continue while (<STDIN>) {     foreach (split)     {         $total++;         next if /\W/; #如果不是单词，则下面代码不执行，开始执行下一次循环         $valid++;         $count{$_}++;              }    } print "total things = $total,valid words = $valid\n"; foreach my $word (sort keys %count) {     print "$word was seen $count{$word} times.\n"; } next也可以用在Perl的五种循环块for foreach while until以及裸块中 3. redo操作符 它将控制返回到当前循环块的顶端，而不经过任何条件测试。 next和redo两者最大的区别在于：next会正常继续下一次迭代，而redo则会重新执行这次的迭代。 my @words = qw{ fred barney pebbles dino wilma betty }; my $errors = 0; foreach (@words) {     #redo指令会跳到这里#     print "Type the word $_: ";     chomp(my $try = <STDIN>);     if ($try ne $_)     {         print"Sorry - That's not right.\n\n";         $errors++;         redo;     }      } print "You've completed the test,with $errors errors.\n" (10) 带标签的块 当需要从内层对外层循环块进行控制时，请使用标签 LINE: while (<>) {     foreach (split)     {         last LINE if /_END_/;     } } (11) 条件操作符 expression ? if_true_expr : if_false_expr my $location = &is_weekend($day) ? "home" : "work"; 如下一个干净利落的多路分支： my $width = 45; my $size =      ($width < 10) ? "small" :     ($width < 20) ? "medium" :     ($width < 50) ? "large" :                     "extra-large"; #默认值                      print "$size\n"; (12) 逻辑操作符 逻辑AND操作符&& 逻辑OR操作符|| (13) 短路操作符的值 我们常常利用逻辑或操作符提供变量的默认取值： my $last_name = $last_name{$someone} || '(No last name)'; 如果$last_name{$someone}的值为不存在，则为undef，即为假，则会将右侧的值赋值给左侧变量的默认值。##下面的//提供更好的方法 等价于： my $last_name = defined $last_name{$someone} ? $last_name{$someone} : '(No last name)'; #太麻烦了 (14) 定义或操作符 前一节提到||操作符可以用来提供默认变量的默认值，但是没有考虑到特殊情况，就是已经定义的假值也可能会被意外地替换为默认值。 %last_name = (Name => "Tom",Age => 0); my $last_name = $last_name{Age} || '(No last name)'; print "$last_name\n"; 输出结果： (No last name) 可以看到上面测试会有问题的，如果用||操作符的话。 Perl 5.10引入了定义或操作符(//)，在发现左边的值属于已经定义时进行短路操作，而不管该值属于逻辑真还是逻辑假。 use 5.010; %last_name = (Name => "Tom",Age => 0); my $last_name = $last_name{Age} // '(No last name)'; print "$last_name\n"; 测试结果为： 0 实例1： #测试看在哪种情况下面返回default use 5.010; foreach my $try (0,undef,'0',1,25) {     print "Trying [$try] ---> ";     my $value = $try // 'default';     say "\tgot [$value]";     } Result: Trying [0] ---> got [0] Trying [] ---> got [default] Trying [0] ---> got [0] Trying [1] ---> got [1] Trying [25] ---> got [25] 实例2： use 5.010; use warnings; my $name; printf "%s",$name // ''; #如果没有// '',则会报Use of uninitialized value $name in printf类似的错误 (15) 使用部分求值操作符的控制结构 open my $fh,'<',$filename or die "Can't open '$filename': $!"; 测试1： 猜猜1-100之间的数： use strict; my $secret = int(1 + rand 100); print "Don't tell anyone,but the secret number is $secret.\n"; while (1) {     print "Please enter a guess from 1 to 100: ";     chomp(my $guess = <STDIN>);     if ($guess =~ /quit|exit|\A\s*\z/i)     {         print "Sorry you gave up. The number was $secret.\n";         last;     }     elsif ($guess < $secret)     {         print "Too small,try again!\n";     }     elsif ($guess > $secret)     {         print "Too large,try again!\n";     }     else     {         print "That was it!\n";         last     } } 第十一章：Perl模块 (1) 寻找模块 查看模块CGI.pm是否存在： perldoc CGI Perl自带的cpan命令可以创建autobundle文件，它会列出所有你已经安装了模块，包括版本号： cpan -a (2) 安装模块 如果模块使用MakeMaker封装，可以使用下面的流程安装： perl Makefile.pl [ INSTALL_BASE=当前用户可以访问的目录 ] #[]内容可选 make install 有些Perl模块开发者用的是另外一个辅助模块Module::Build来编译并安装它们的产品 perl Build.pl [--install_base=...] ./Build install                          // 但是有些模块之间是有依赖性的，利用使用perl自带的perl脚本来安装，解决依赖性关系 cpan Module::CoreList LWP CGI::Prototype 另外还有一个非常轻巧的工具cpanm 轻量级的CPAN客户端(非Perl自带，自行下载) cpanm DBI WWW::Mechanize #后面直接跟模块名称 (3) File::Basename模块 use strict; use File::Basename; my $name = "/usr/local/bin/perl"; my $basename = basename $name; my $dirname = dirname $name; print "$basename\n"; print "$dirname\n"; Result: perl /usr/local/bin (4) 仅选用模块中的部分函数 只需要在File::Basename的use声明中加上导入列表来指明要导入的函数清单，就不会自动导入所有的函数了。 use File::Basename qw/ basename /; #只导入basename函数 use File::Basename qw/ /; 或use File::Basename (); #只加载模块，而不导入任何函数，如果使用函数时请使用全路径 实例： use File::Basename ();  my $selfpath = &basename $kitty; my $name = "/usr/local/bin/perl"; my $basename = File::Basename::basename $name; (5) File::Spec模块 File::Spec是面向对象的(Object Oriented,OO)模块，而File::Basename不同 use File::Spec; my $new_name = File::Spec->catfile($dirname,$basename); rename($old_name,$new_name) or warn "Can't rename '$old_name' to '$new_name'"; (6) Path::Class模块 Perl自带 use Path::Class; my $dir = dir(qw(users fred lib)); #Users/fred/lib/perl5 my $subdir = $dir -> subdir('perl5); #Users/fred my $parent = $dir -> parent; my $window = $dir -> as_foreign('Win32'); #Users\fred\lib (7) 数据库和DBI模块 DBI(Database Interface,数据库接口)模块并未随附于Perl标准发行版本中，但它却是最热门的模块之一。 在安装完DBI之后，你还必须安装DBD(Database Driver,数据库驱动程序) 步骤一：使用use加载DBI模块并调用它的connect方法： use DBI; $dbh = DBI->connect($data_source,$username,$password); $data_source包含你要使用的DBD的特定信息，从DBD取得。 #创建数据库连接 #my $conn = DBI->connect("dbi:ODBC:$dbname",$dbuser,$password,{AutoCommit => 0,RaiseError => 1,PrintError => 0,}); 步骤二：连接数据库后，就可以进行准备查询，执行查询和读取查询结果等： my $sth = $dbh->prepare("select * from student"); $sth->execute(); my @row_ary = $sth->fetchrow_array; $sth->finish; 步骤三：断开数据库连接 $dbh->disconnect(); (8) 处理日期和时间的模块 最常见的是把系统中以秒数表示的当前时间(epoch纪元时间)转换为DateTime对象： my $dt = DateTime->from_epoch(epoch=> time); printf '%4d%02d%02d',$dt->year,$dt->month,$dt->day; print $dt->ymd;      #2011-04-23 print $dt->ymd('/'); #2011/04/23 print $dt->ymd('');  #20110423 如果只是用到DateTime提供的一小部分功能，则可以使用Time::Piece模块中的localtime函数。 use Time::Piece; my $t = localtime; print "The month is " . $t->month . "\n"; Result: The month is Nov 从Perl 5.10起，Time::Piece模块就是Perl自带的。 实例：计算指定时间与当前时间的间隔  use DateTime; my $t = localtime; my $now = DateTime->new (     year => $t[5] + 1900,    month => $t[4] + 1,    day => $t[3],    );      my $then = DateTime->new (     year => $ARGV[0],    month => $ARGV[1],    day => $ARGV[2],    ); my $duration = $now - $then; my @units = $duration->in_units(qw(years months days));     printf "%d years,%d month,and %d days\n",@units; 如果使用Time::Piece模块，就不必对照字段位置选取字段了，localtime返回的是时间对象。 use Time::Piece; my $t = localtime; my $now = DateTime->new (     year => $t->year,    month => $t->month,    day => $t->mday,    );      第十二章：文件测试 (1) 文件测试操作符  die "OOPS! A file called $filename' already exist.\n" if -e $filename; #-e判断文件或目录是否存在 warn "Config file is looking pretty old!\n" if -M CONFIG > 28; #-M文件测试操作符返回的是文件最后一次修改时间到当前程序启动时刻                                                                #之间的天数，即文件多久没有更新了。                                                                 #遍历文件列表                                                                my @original_files = qw/ fred barney betty wilma /; my @big_old_files; foreach my $filename (@original_files) {     push @big_old_files,$filename         if -s $filename > 100_000 and -A $filename > 90; #-s(文件或目录存在而且有内容) 文件测试操作符返回的是文件的字节大小 -A表示文件多久没有访问了。         } -M 最后一次被修改至今的天数 -A 最后一次被访问后至今的天数 -C 最后一次文件节点编号被变更后至今的天数 foreach (@lots_of_filenames) {      print "$_ is readable\n" if -r ;如果文件可读。 } (2) 测试同一个文件的多项属性 if (-r $file and -w $file) #耗费资源 { ...   } 请使用虚拟文件句柄_来避免上面重复的劳动。 if (-r $file and -w _) #_告诉Perl用上次查询的文件信息来做当前测试 { ...   } (3) 栈式文件测试操作符 在Perl 5.10之前，如果要测试一个文件多个属性时，只能分开为独立的操作 if (-r $file and -w _) {     print "The file is both readable and writable!\n"; } Perl 5.10开始允许我们使用"栈式"写法将文件测试操作符排成一行 use 5.010; if (-w -r $file) # 靠近文件名的测试会先执行，次序为从右往左 { } 注：对于返回真假值除外的测试来说，栈式写法就会出现问题。 use 5.010; if (-s -d $file < 512) #当-d为假时，Perl将假值同512比较，结果为真，因为假值等效为数字0 { } 修改为： use 5.010; if (-d $file and -s _ < 512) (4) stat和lstat函数 stat执行成功会返回一个13个元素的数字列表 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($filename); $dev,$ino:文件所在设备的编号与文件的inode编号 $mode:文件权限位的集合 $nlink：文件或目录的硬链接数 $uid,$gid：以数值形式表示文件拥有者的用户ID和组ID 测试1： #列出传入文件的属性 foreach my $file (@ARGV) {     my $attribs = attributes($file);     print "'$file' $attribs\n"; } sub attributes {     my $file = shift @_;     return "does not exist!" unless -e $file;          my @attrib;     push @attrib,"readable" if -r $file;     push @attrib,"writable" if -w $file; #$file可以修改为_     push @attrib,"executable" if -x $file; #$file可以修改为_     return "exists" unless @attrib;     'is ' . join " and ",@attrib;   } 测试2： die "No file names supplied!\n" unless @ARGV; my $oldest_name = shift @ARGV; my $oldest_age = -M $oldest_name; for (@ARGV) {     my $age = -M;     ($oldest_name,$oldest_age) = ($_,$age) if $age > $oldest_age; } printf "The oldest file was %s,and it was %.1f days old.\n",$oldest_name,$oldest_age;