0%

Perl-Basics

阅读更多

1 前言

我们已经有shell,有python了,有什么必要再学一门脚本语言么?

  • shell杂交非常亲和,shell脚本里用Perl可替换sed,awk,grep
  • 字符串处理。q/qq/qx/qw/qr
  • 正则是Perl语法的一部分,功能非常强大,且方言顺手

2 基础语法

  1. Perl程序有声明与语句组成,程序自上而下执行,包含了循环,条件控制,每个语句以分号;结束

  2. Perl语言没有严格的格式规范,你可以根据自己喜欢的风格来缩进

  3. #开头的是注释

  4. =pdo且以=cut结尾的是多行注释

  5. 单引号或双引号都表示字符串

  6. Here文档

    • 必须后接分号
    • 可以自定义开始标识(结束标识与开始标识必须相同)
    • 结束字符必须独占一行,无任何其他多余字符(包括空白)
    • 开始标识可以不带引号,或者带单双引号
      • 不带引号/带双引号,会解释内嵌的变量和转义字符
      • 带单引号,不会解释内嵌的变量和转义字符
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    use strict;
    use warnings;
    use Modern::Perl;

    my $a = 10;
    my $var = <<"EOF";
    这是一个 Here 文档实例,使用双引号。
    可以在这输如字符串和变量。
    例如:a = $a
    EOF
    say "$var";

    $var = <<'EOF';
    这是一个 Here 文档实例,使用单引号。
    例如:a = $a
    EOF
    say "$var";
  7. 标识符格式为[_a-zA-Z][_a-zA-Z0-9]*,对大小写敏感

3 数据类型

  1. Perl是一种弱类型语言,所以变量不需要指定类型,Perl解释器会根据上下文自动选择匹配类型
  2. Perl为每个变量类型设置了独立的命令空间,所以不同类型的变量可以使用相同的名称,你不用担心会发生冲突。例如$foo@foo是两个不同的变量
  3. 变量使用等号=来赋值

3.1 标量

  1. 标量是一个单一的数据单元
  2. 标量可能是:
    • 字符串
    • 整数
    • 浮点数
    • 文件句柄
    • 引用
  3. 使用时在变量前面加上$符号,用于表示标量
1
2
3
4
5
6
7
8
9
10
11
use strict;
use warnings;
use Modern::Perl;

my $age = 25;
my $name = "youj";
my $salary = 1445.50;

say "Age = $age";
say "Name = $name";
say "Salary = $salary";

3.1.1 字面量

  1. Perl实际上把整数存在你的计算机中的浮点寄存器中,所以实际上被当作浮点数看待
  2. 浮点寄存器通常不能精确地存贮浮点数,从而产生误差,在运算和比较中要特别注意。指数的范围通常为-309+308
  3. Perl中的字符串使用一个标量来表示,定义方式和C很像,但是在Perl里面字符串不是用0来表示结束的。
  4. Perl双引号和单引号的区别:双引号可以正常解析一些转义字符与变量,而单引号无法解析会原样输出
  5. 但是用单引号定义可以使用多行文本

3.1.1.1 设置浮点数精度

1
2
3
4
5
6
7
8
9
10
use strict;
use warnings;
use Modern::Perl;

my $number = 1.6852517985;

# 保留两位小数,四舍五入
my $rounded = sprintf( "%.2f", $number );

say $rounded;

3.1.2 特殊字符

  1. __FILE__:当前脚本文件名
  2. __LINE__:当前脚本行号
  3. __PACKAGE__:当前脚本包名
  4. 特殊字符是单独的标记,不能写到字符串中
1
2
3
4
5
6
7
8
9
10
use strict;
use warnings;
use Modern::Perl;

say "filename: ". __FILE__;
say "linenum: " . __LINE__;
say "packagename: " . __PACKAGE__;

# output literal content
say "__FILE__ __LINE__ __PACKAGE__";

3.1.3 undef

  1. undef表示变量的值已被声明但是尚未赋值
  2. 可以用defined来检查一个变量是否定义
1
2
3
4
5
6
7
8
9
use strict;
use warnings;
use Modern::Perl;

my $num_def = 1;
my $num_undef;

say defined $num_def;
say defined $num_undef;

3.2 数组

  1. 数组是用于存储一个有序的标量值的变量
  2. 数组变量以字符@开头,索引从0开始
  3. 要访问数组的某个成员,可以使用$变量名[索引值]格式来访问
1
2
3
4
5
6
7
8
9
10
11
12
13
use strict;
use warnings;
use Modern::Perl;

my @ages = ( 25, 30, 40 );
my @names = ( "google", "youj", "taobao" );

say "\$ages[0] = $ages[0]";
say "\$ages[1] = $ages[1]";
say "\$ages[2] = $ages[2]";
say "\$names[0] = $names[0]";
say "\$names[1] = $names[1]";
say "\$names[2] = $names[2]";

3.2.1 数组和列表

数组:具名
列表:不具名,例如字面值,grep/sort/map的返回值

3.2.2 创建数组

3.2.2.1 操作符:,

强调:我们通过,操作符来创建数组,而不是()()仅为了改变运算符的优先级

  • 对于@array1 = (1, 2, 'Hello');,如果不加括号,即@array1 = 1, 2, 'Hello';,那么根据优先级关系,赋值运算符=的优先级大于逗号运算符,,因此数组@array1的大小是1,首元素是1
1
2
3
4
5
use strict;
use warnings;
use Modern::Perl;

my @array1 = ( 1, 2, 'Hello' );

此外,数组的创建是贪婪的

1
2
3
4
5
6
7
8
9
10
use strict;
use warnings;
use Modern::Perl;

my ( @array1, @array2 ) = ( 1, 2, 3, 4, 5 );
my @array3;

say "array1's size: $#array1";
say "array2's size: $#array2";
say "array3's size: $#array3";

数组的元素是以逗号来分割,我们也可以使用逗号来合并数组

1
2
3
4
5
6
7
8
9
10
11
use strict;
use warnings;
use Modern::Perl;

my @numbers1 = ( 1, 3, ( 4, 5, 6 ) );
say "numbers1: @numbers1";

my @odd = ( 1, 3, 5 );
my @even = ( 2, 4, 6 );
my @numbers2 = ( @odd, @even );
say "numbers2: @numbers2";

3.2.2.2 操作符:qw

操作符qs用于将字符串转为数组,分隔符为空白

1
2
3
4
5
6
7
8
9
10
11
use strict;
use warnings;
use Modern::Perl;
my @array2 = qw/this is an array/;
my @array3 = qw/google
taobao
alibaba
youj/;

say "@array2";
say "@array3";

3.2.3 数组切片:..

Perl提供了可以按序列输出的数组形式,格式为:起始值 + .. + 结束值

1
2
3
4
5
6
7
8
9
use strict;
use warnings;
use Modern::Perl;

my @array = ( 1 .. 10 );
say "array = @array";

my @subarray = @array[ 3 .. 6 ];
say "subarray = @subarray";

3.2.4 数组大小:$#

1
2
3
4
5
6
7
8
9
10
11
12
use strict;
use warnings;
use Modern::Perl;

my @array = ( 1, 2, 3 );
$array[50] = 4;

my $size = @array;
my $max_index = $#array;

say "size: $size";
say "max index: $max_index";

若要访问倒数第一个元素,除了通过数组大小之外,还可以通过[-1]

1
2
3
4
5
6
use strict;
use warnings;
use Modern::Perl;

my @array = ( 1, 2, 3 );
say $array[-1];

3.2.5 检测是否包含某个元素:~~

1
2
3
4
5
6
7
8
use strict;
use warnings;
use Modern::Perl;

my @array = ( 'A', 'B', 'C' );
if ( 'A' ~~ @array ) {
say "contains";
}

3.2.6 数组打印

  • 若数组不在双引号中,那么使用say输出后,各元素会紧贴在一起
  • 若数组在双引号中,各个元素之间会插入全局变量$",其默认值为空格,称为数组插值Array Interpolation
1
2
3
4
5
6
7
8
9
10
11
12
use strict;
use warnings;
use Modern::Perl;

my @alphabet = 'a' .. 'z';
say "beyound quote, [", @alphabet, "]";
say "within quote, [@alphabet]";

{
local $" = ')(';
say "winthin quite and local \$\", [@alphabet]";
}

3.2.7 数组起始下标

特殊变量$[表示数组的第一索引值,一般都为0,如果我们将$[设置为1,则数组的第一个索引值即为1,第二个为2,以此类推

该功能在未来版本可能被废弃,不建议使用

1
2
3
4
5
6
7
8
@sites = qw(google taobao youj facebook);
print "网站: @sites\n";

# set array's first index to 1
$[ = 1;

print "\@sites[1]: $sites[1]\n";
print "\@sites[2]: $sites[2]\n";

3.2.8 数组循环

3.2.8.1 for

1
2
3
4
5
6
7
8
9
10
11
use warnings;
use strict;
use Modern::Perl;

my @nums = ( 1 .. 10 );
for (@nums) {
say $_;
}

@nums = ( 11 .. 20 );
say for (@nums);

3.2.8.2 each

Perl 5.12之后,可以用each循环数组

1
2
3
4
5
6
7
8
use strict;
use warnings;
use Modern::Perl;

my @array = ( 'A', 'B', 'C' );
while ( my ( $index, $value ) = each @array ) {
say "$index: $value";
}

3.2.8.3 foreach

1
2
3
4
5
6
7
8
use strict;
use warnings;
use Modern::Perl;

my @array = ( 'A', 'B', 'C' );
foreach my $value (@array) {
say "$value";
}

3.2.9 数组相关的函数

3.2.9.1 push/pop/shift/unshift

push/pop/shift/unshift添加或删除数组元素

  1. push:添加元素到尾部
  2. pop:删除尾部元素
  3. shift:删除头部元素
  4. unshift:添加元素到头部
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
use strict;
use warnings;
use Modern::Perl;

# create a simple array
my @coins = ( "Quarter", "Dime", "Nickel" );
say "1. \@coins = @coins";

# add one element at the end of the array
push( @coins, "Penny" );
say "2. \@coins = @coins";

# add one element at the beginning of the array
unshift( @coins, "Dollar" );
say "3. \@coins = @coins";

# remove one element from the last of the array.
pop @coins;
say "4. \@coins = @coins";

# remove one element from the beginning of the array.
shift @coins;
say "5. \@coins = @coins";

3.2.9.2 splice

splice用于替换数组元素,语法格式如下:

  • splice @ARRAY, OFFSET [ , LENGTH [ , LIST ] ]
  • @ARRAY:要替换的数组
  • OFFSET:起始位置
  • LENGTH:替换的元素个数
  • LIST:替换元素列表
1
2
3
4
5
6
7
8
9
use strict;
use warnings;
use Modern::Perl;

my @nums = ( 1 .. 20 );
say "before: @nums";

splice( @nums, 5, 5, 21 .. 25 );
say "after: @nums";

3.2.9.3 split

split用于切割字符串生成列表,语法格式如下:

  • split [ PATTERN [ , EXPR [ , LIMIT ] ] ]
  • PATTERN:分隔符,默认为空格
  • EXPR:指定字符串数
  • LIMIT:如果指定该参数,则返回该数组的元素个数
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
use strict;
use warnings;
use Modern::Perl;

my $var_test = "youj";
my $var_string = "www-youj-com";
my $var_names = "google,taobao,youj,weibo";

my @test = split( '', $var_test );
my @string = split( '-', $var_string );
my @names = split( ',', $var_names );

say "$test[3]"; # j
say "$string[2]"; # com
say "$names[3]"; # weibo

3.2.9.4 join

join用于将列表拼接成一个字符串,语法格式如下:

  • join EXPR, LIST
  • EXPR:连接符
  • LIST:列表或数组
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
use strict;
use warnings;
use Modern::Perl;

my $var_string = "www-youj-com";
my $var_names = "google,taobao,youj,weibo";

my @string = split( '-', $var_string );
my @names = split( ',', $var_names );

my $string1 = join( '-', @string );
my $string2 = join( ',', @names );

say "$string1";
say "$string2";

3.2.9.5 grep

grep用于过滤列表,返回一个列表,语法格式如下:

  • grep BLOCK LIST
  • BLOCK:代码块,最后一个表达式用于数组过滤
1
2
3
4
5
6
7
8
9
10
11
12
13
use strict;
use warnings;
use Modern::Perl;
use Data::Dumper;

my @strs = qw/num1 num2 str1 str2/;

my @filtered_strs = grep { /num/ } @strs;
say "@filtered_strs";

my @refs = ( [ 'num1', 'num2' ], [ 'str1', 'str2' ] );
my @filtered_refs = grep { $_->[0] =~ /num/ } @refs;
say Dumper @filtered_refs;

3.2.9.6 sort

sort用于排序列表,返回一个列表,语法格式如下:

  • sort [ SUBROUTINE ] LIST
  • SUBROUTINE:指定规则,默认是cmp,会把元素当成字符串处理
  • LIMIT:列表或数组
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
use strict;
use warnings;
use Modern::Perl;

my @sites = qw(google taobao youj facebook);
say "before: @sites";

@sites = sort @sites;
say "after: @sites";

my @numbers = ( 9, 10, 11, 12 );
@numbers = sort @numbers;
say "numbers(order by cmp): @numbers";

@numbers = sort { $a <=> $b } @numbers;
say "numbers(order by <=>): @numbers";

更复杂的场景是,数组的元素是另一个复杂类型的引用,需要用多个字段进行排序,此时我们可以通过||来连接多个排序规则,示例如下:

1
2
3
4
5
6
7
8
9
10
11
use strict;
use warnings;
use Modern::Perl;

my @pairs = ( [ 1, 2 ], [ 5, 6 ], [ 5, 2 ], [ 2, 3 ], [ 1, 5 ] );

my @ordered_pairs = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @pairs;

foreach my $pair (@ordered_pairs) {
say "@{$pair}";
}

3.2.9.7 map

map用于数组映射转换,返回一个列表,语法格式如下:

  • map BLOCK LIST
  • BLOCK:代码块,最后一个表达式作为新List的元素
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
use strict;
use warnings;
use Modern::Perl;

my @nums = ( 1 .. 10 );
my @evens = map { $_ * 2 } @nums;
my @odds = map { $_ + 1 } map { $_ * 2 } @nums;

say "@evens";
say "@odds";

my @strs = ( [ 'Tom', 'Engineer' ], [ 'Jeff', 'Doctor' ] );
my %users = map { $_->[0] => $_->[1] } @strs;

say $users{'Tom'};
say $users{'Jeff'};
3.2.9.7.1 用下标为奇数/偶数的元素构成一个数组
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
use warnings;
use strict;
use Modern::Perl;

for ( 1 .. 20 ) {
my @array = ( 0 .. $_ );
my @odd =
@array[ map { $_ * 2 + 1 } ( 0 .. ( @array - 2 ) / 2 ) ];
my @even = @array[ map { $_ * 2 } ( 0 .. ( @array - 1 ) / 2 ) ];

die if ( @array != @odd + @even );

say "odd = @odd";
say "even = @even";
say "";
}

3.3 哈希

  1. 哈希是一个key/value对的集合
  2. 哈希的key只能是字符串。显然我们能将整数作为哈希键值,这是因为做了隐式转换
  3. 哈希的value只能是scalar,如果我们想存储更复杂的类型,可以使用引用
  4. 哈希变量以字符%开头
  5. 果要访问哈希值,可以使用$变量名{键值}格式来访问
1
2
3
4
5
6
7
8
9
use strict;
use warnings;
use Modern::Perl;

my %data = ( 'google', 45, 'youj', 30, 'taobao', 40 );

say "\$data{'google'} = $data{'google'}";
say "\$data{'youj'} = $data{'youj'}";
say "\$data{'taobao'} = $data{'taobao'}";

3.3.1 创建哈希

创建哈希可以通过以下两种方式:

  1. 为每个key设置value
  2. 通过列表设置
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
use strict;
use warnings;
use Modern::Perl;

my %data1;
$data1{'google'} = 'google.com';
$data1{'w3cschool'} = 'w3cschool.cn';
$data1{'taobao'} = 'taobao.com';

my %data2 = (
'google', 'google.com', 'w3cschool', 'w3cschool.cn',
'taobao', 'taobao.com'
);
my %data3 =
( 'baidu' => 'baidu.com', 'aliyun' => 'aliyun.cn', 'douyu' => 'douyu.com' );

say "\$data1{'taobao'} = $data1{'taobao'}";
say "\$data2{'google'} = $data2{'google'}";
say "\$data3{'baidu'} = $data3{'baidu'}";

访问哈希的格式:$ + hash_name + { + key + },其中key如果是bareword,那么可以不加引号,Perl会自动加引号

  • %data{name}Perl会自动给name加引号
  • %data{'name-1'}name-1不是bareword,必须手动加引号
  • %data{func()}:若通过函数获取key,若函数不需要参数,也必须加上(),消除歧义

3.3.2 读取哈希的key和value

我们可以使用keys函数读取哈希所有的键,语法格式如下:

  • keys %HASH
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
use strict;
use warnings;
use Modern::Perl;

my %data = (
'google' => 'google.com',
'w3cschool' => 'w3cschool.cn',
'taobao' => 'taobao.com'
);

my @names = keys %data;

say "$names[0]";
say "$names[1]";
say "$names[2]";

类似的我么可以使用values函数来读取哈希所有的值,语法格式如下:

  • values %HASH
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
use strict;
use warnings;
use Modern::Perl;

my %data = (
'google' => 'google.com',
'w3cschool' => 'w3cschool.cn',
'taobao' => 'taobao.com'
);

my @urls = values %data;

say "$urls[0]";
say "$urls[1]";
say "$urls[2]";

3.3.3 检测元素是否存在

如果你在哈希中读取不存在的key/value对 ,会返回undefined值,且在执行时会有警告提醒。为了避免这种情况,我们可以使用exists函数来判断key是否存在,存在的时候读取。此外,key存在的情况下,value也可能是undef,我们可以使用defined来判断value是否赋值过

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
use strict;
use warnings;
use Modern::Perl;

my %data = (
'google' => 'google.com',
'w3cschool' => 'w3cschool.cn',
'taobao' => 'taobao.com',
'wtf' => undef
);

say "google exist" if exists $data{'google'};
say "google defined" if defined $data{'google'};
say "amazon not exist" if not exists $data{'amazon'};
say "amazon not defined" if not defined $data{'amazon'};
if ( exists $data{'wtf'} ) {
say "wtf exist";
}
if ( not defined $data{'wtf'} ) {
say "wtf not defined";
}

3.3.4 获取哈希大小

哈希大小为元素的个数,我们可以通过先获取keyvalue的所有元素数组,再计算数组元素多少来获取哈希的大小

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
use strict;
use warnings;
use Modern::Perl;

my %data = (
'google' => 'google.com',
'w3cschool' => 'w3cschool.cn',
'taobao' => 'taobao.com'
);

my @keys = keys %data;
my $key_size = @keys;
say "key size: $key_size";

my @values = values %data;
my $value_size = @values;
say "value size: $value_size";

3.3.5 哈希中添加或删除元素

添加key/value对可以通过简单的赋值来完成。但是删除哈希元素你需要使用delete函数

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
use strict;
use warnings;
use Modern::Perl;

my %data = (
'google' => 'google.com',
'w3cschool' => 'w3cschool.cn',
'taobao' => 'taobao.com'
);
my @keys = keys %data;
my $size = @keys;
say "key size: $size";

# add
$data{'facebook'} = 'facebook.com';
@keys = keys %data;
$size = @keys;
say "key size: $size";

# delete
delete $data{'taobao'};
@keys = keys %data;
$size = @keys;
say "key size: $size";

3.3.6 用each循环哈希

Perl 5.12之后,可以用each循环哈希

1
2
3
4
5
6
7
8
9
10
11
12
13
use strict;
use warnings;
use Modern::Perl;

my %data = (
'google' => 'google.com',
'w3cschool' => 'w3cschool.cn',
'taobao' => 'taobao.com'
);

while ( my ( $key, $value ) = each %data ) {
say "$key: $value";
}

3.3.7 迭代顺序

由于不同版本的Perl实现哈希的方式不同,因此哈希的遍历顺序是不固定的。但是对于同一个哈希的keysvalueseach,它们的顺序是一致的

3.3.8 锁定

  1. lock_hash/unlock_hash:锁定/解锁整个hash。锁定时,不能新增或删除key,不能修改已有的value
  2. lock_keys/unlock_keys:锁定key。锁定时,不能新增或删除key
  3. lock_value/unlock_value:锁定value。锁定时,不能修改value
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
use strict;
use warnings;
use Modern::Perl;
use Hash::Util qw[lock_hash lock_keys unlock_keys];

my %data = (
'google' => 'google.com',
'w3cschool' => 'w3cschool.cn',
'taobao' => 'taobao.com'
);
lock_keys(%data);

# compile error
# $data{'wtf'} = 'wtf.com';

unlock_keys(%data);
$data{'wtf'} = 'wtf.com';

foreach my $key ( keys %data ) {
my $value = $data{$key};
say "$key : $value";
}

3.3.9 哈希间接排序

sort仅能排序数组,而无法直接排序hashhash的顺序是由其内部的具体实现确定的),我们可以通过如下方式进行排序

  1. hash映射成一个数组,数组的元素是一个数组引用,分别存放keyvalue
  2. 对这个数组进行排序
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
use strict;
use warnings;
use Modern::Perl;

my %extensions = (
4 => 'Jerryd',
5 => 'Rudy',
6 => 'Juwan',
7 => 'Brandon',
10 => 'Joel',
21 => 'Marcus',
24 => 'Andre',
23 => 'Martell',
52 => 'Greg',
88 => 'Nic',
);

# [] here to create anonymous array
my @pairs = map { [ $_, $extensions{$_} ] } keys %extensions;

# sort by the second element of the array ref
my @sorted_pairs = sort { $a->[1] cmp $b->[1] } @pairs;

# map array ref to readable string
my @formatted_exts = map { "$_->[1]: $_->[0]" } @sorted_pairs;

say for (@formatted_exts);

更神奇的是,还能将这些操作组合在一起

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
use strict;
use warnings;
use Modern::Perl;

my %extensions = (
4 => 'Jerryd',
5 => 'Rudy',
6 => 'Juwan',
7 => 'Brandon',
10 => 'Joel',
21 => 'Marcus',
24 => 'Andre',
23 => 'Martell',
52 => 'Greg',
88 => 'Nic',
);

say
for (
map { "$_->[1]: $_->[0]" }
sort { $a->[1] cmp $b->[1] }
map { [ $_, $extensions{$_} ] } keys %extensions
);

3.4 引用

引用就是指针,Perl引用是一个标量类型,可以指向变量、数组、哈希表(也叫关联数组)甚至函数,可以应用在程序的任何地方

3.4.1 创建引用

定义变量的时候,在变量名前面加个\,就得到了这个变量的一个引用

1
2
3
4
5
$scalarref = \$foo;
$arrayref = \@ARGV;
$hashref = \%ENV;
$coderef = \&handler;
$globref = \*foo;

此外,还可以创建匿名数组的引用([]运算符)、匿名哈希的引用({}运算符)、匿名函数的引用

1
2
3
4
5
6
7
8
9
10
use strict;
use warnings;
use Modern::Perl;

my $aref1 = [ 1, "foo", undef, 13 ];
my $aref2 = [ [ 1, 2, 3 ], [ 4, 5, 6 ], [ 7, 8, 9 ], ];

my $href = { APR => 4, AUG => 8 };

my $coderef = sub { say "W3CSchool!" };

3.4.2 解引用

解引用可以根据不同的类型使用$@%以及->,必要时可以用{}辅助(${}@{}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
use strict;
use warnings;
use Modern::Perl;

# scarlar
my $var = 10;
my $r = \$var;
say '$$r: ', $$r;

# array
my @var = ( 1, 2, 3 );
$r = \@var;
say '@$r: ', @$r;
say '$$r[0]: ', $$r[0];
say '$r->[0]: ', $r->[0];
say '@{ $r }[0, 1, 2]: ', @{$r}[ 0, 1, 2 ];

# hash
my %var = ( 'key1' => 10, 'key2' => 20 );
$r = \%var;
say '%$r: ', %$r;
say '$r->{\'key1\'}: ', $r->{'key1'};

# hash stores array
my %var = ( 'key1' => [ 1, 2, 3 ], 'key2' => [ 4, 5, 6 ] );
say '@{$var{key1}}: ', @{ $var{key2} };

如果你不能确定变量类型,你可以使用ref来判断,返回值列表如下,如果没有以下的值返回false

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
use strict;
use warnings;
use Modern::Perl;

my $var = 10;
my $r = \$var;
say "r's ref type: ", ref($r);

my @var = ( 1, 2, 3 );
$r = \@var;
say "r's ref type: ", ref($r);

my %var = ( 'key1' => 10, 'key2' => 20 );
$r = \%var;
say "r's ref type: ", ref($r);

3.4.3 循环引用

循环引用在两个引用相互包含时出现。你需要小心使用,不然会导致内存泄露

1
2
3
4
5
6
7
8
9
10
11
12
13
14
use strict;
use warnings;
use Modern::Perl;
use Scalar::Util 'weaken';

my $alice = { mother => '', father => '', children => [] };
my $robert = { mother => '', father => '', children => [] };
my $cianne = { mother => $alice, father => $robert, children => [] };

push @{ $alice->{children} }, $cianne;
push @{ $robert->{children} }, $cianne;

weaken( $cianne->{mother} );
weaken( $cianne->{father} );

3.4.4 引用函数

  1. 函数引用格式:\&
  2. 调用引用函数格式:&$func_ref(params)或者$func_ref->(params)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
use strict;
use warnings;
use Modern::Perl;

sub PrintHash {
my (%hash) = @_;

foreach my $item (%hash) {
say "元素 : $item";
}
}
my %hash = ( 'name' => 'youj', 'age' => 3 );

my $cref = \&PrintHash;

# form 1
&$cref(%hash);

# form 2
$cref->(%hash);

3.4.5 级联数据结构

由于数组、哈希都只能存储标量,而引用正好也是标量。因此借助引用,可以创建多级数据结构

1
2
3
4
5
6
7
8
9
10
11
12
13
use strict;
use warnings;
use Modern::Perl;

my @famous_triplets = (
[qw( eenie miney moe )], [qw( huey dewey louie )], [qw( duck duck goose )],
);

my %meals = (
breakfast => { entree => 'eggs', side => 'hash browns' },
lunch => { entree => 'panini', side => 'apple' },
dinner => { entree => 'steak', side => 'avocado salad' },
);

3.4.5.1 访问

我们使用歧义消除块(disambiguation blocks

1
2
3
my $nephew_count   = @{ $famous_triplets[1] };
my $dinner_courses = keys %{ $meals{dinner} };
my ( $entree, $side ) = @{ $meals{breakfast} }{qw( entree side )};

更好更清晰的写法,自然是使用中间变量

1
2
my $breakfast_ref = $meals{breakfast};
my ( $entree, $side ) = @$breakfast_ref{qw( entree side )};

3.4.5.2 Autovivificatio

当我们对一个多级数据结构进行赋值时,无需按层级一层层依次创建,Perl会自动帮我们完成这项工作,这个过程就称为Autovivificatio

1
2
3
4
5
my @aoaoaoa;
$aoaoaoa[0][0][0][0] = 'nested deeply';

my %hohoh;
$hohoh{Robot}{Santa}{Claus} = 'mostly harmful';

3.4.5.3 打印复杂数据结构

Data::Dumper可以帮助我们打印一个复杂的多级数据结构

1
2
3
4
5
6
7
8
9
10
11
12
use strict;
use warnings;
use Modern::Perl;
use Data::Dumper;

my @aoaoaoa;
$aoaoaoa[0][0][0][0] = 'nested deeply';

my %hohoh;
$hohoh{Robot}{Santa}{Claus} = 'mostly harmful';
say Dumper @aoaoaoa;
say Dumper %hohoh;

3.5 变量上下文

  1. 所谓上下文:指的是表达式所在的位置
  2. 上下文是由等号左边的变量类型决定的,等号左边是标量,则是标量上下文,等号左边是列表,则是列表上下文
  3. Perl解释器会根据上下文来决定表达式的类型
  4. 上下文种类
    1. 标量上下文,包括数字、string、布尔
    2. 列表上下文,包括数组和哈希
    3. 布尔上下文
    4. void上下文
    5. 插值上下文,仅发生在引号内
  5. 数组在标量上下文中返回的是数组元素的个数
  6. 哈希在标量上下文中返回的是哈希键值对的个数
  7. 未定义的标量在字符串上下文中返回的是空字符串
  8. 未定义的标量在数字上下文中返回的是0
  9. 不以数字开头的字符串在数字上下文中返回的是0

示例:

1
2
3
4
5
6
7
8
9
10
11
use strict;
use warnings;
use Modern::Perl;

my @names = ( 'google', 'youj', 'taobao' );

my @copy = @names;
my $size = @names;

say "name: @copy";
say "count: $size";

3.5.1 显式标量上下文

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
# numerical context
my $numeric_x = 0 + $x;

# string context
my $stringy_x = '' . $x;

# boolean context
my $boolean_x = !!$x;

# scarlar context
# anonymous hash can contain nested struct
my $results = {
cheap_operation => $cheap_operation_results,
expensive_operation => scalar find_chores(),
};

3.5.2 显式列表上下文

1
2
3
# It’s semantically equivalent to assigning the first item in 
# the list to a scalar and assigning the rest of the list to a temporary array, and then throwing away the array
my ( $single_element ) = find_chores();

3.6 默认变量

3.6.1 默认标量变量

$_又称为默认标量变量(这是Perl标志性的特征)。可以用在非常多的地方,包括许多内建的函数

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
use strict;
use warnings;
use Modern::Perl;

$_ = 'My name is Paquito';

# say working on $_
# matching working on $_
say if /My name is/;

# replacing working on $_
s/Paquito/Paquita/;

# tr working on $_
tr/A-Z/a-z/;

# say working on $_
say;

# for loop working on $_
say "#$_" for 1 .. 10;

3.6.2 默认数组变量

  1. Perl将传给函数的参数都存储在@_变量中
  2. pushpopshiftunshift
    • 在函数上下文中,在缺省参数的情况下,默认对@_进行操作
    • 在非函数上下文中,在缺省参数的情况下,默认对@ARGV进行操作
  3. Perl将命令函参数都存储在@ARGV
  4. @ARGV还有另一个用途,当从空文件句柄<>中读取内容时,Perl默认会将@ARGV中存储的内容作为文件名进行依次读取,如果@ARGV为空,那么会读取标准输入

3.7 特殊全局变量

详细内容,参考perldoc perlvar

  1. $/:行分隔符
  2. $.:最近读取的文件句柄的行号
  3. $|:控制是否自动flush缓存
  4. @ARGV:命令行参数数组
  5. $!:最近一次系统调用的错误码
  6. $":列表分隔符
  7. %+:哈希,用于存储具名捕获的结果
  8. $@:最近一次异常抛出的值
  9. $$:进程id
  10. @INCuse或者require函数查找模块的路径列表
  11. %SIG:哈希,用于存储信号处理的函数引用

4 控制流

4.1 条件语句

4.1.1 if

1
2
3
if (boolean_expression) {
...
}

4.1.2 if else

1
2
3
4
5
if (boolean_expression) {
...
} else {
...
}

4.1.3 if elsif

1
2
3
4
5
6
7
8
9
if (boolean_expression 1) {
...
} elsif (boolean_expression 2) {
...
} elsif (boolean_expression 3) {
...
} else {
...
}

4.1.4 unless

1
2
3
unless (boolean_expression) {
...
}

4.1.5 unless else

1
2
3
4
5
unless (boolean_expression) {
...
} else {
...
}

4.1.6 unless elsif

1
2
3
4
5
6
7
8
9
unless (boolean_expression 1) {
...
} elsif (boolean_expression 2) {
...
} elsif (boolean_expression 3) {
...
} else {
...
}

4.1.7 switch

switch case执行是基于Switch模块,Switch模块使用Filter::Util::CallText::Balanced来执行,这两个模块都需要安装

1
2
3
4
5
6
7
8
9
10
11
12
13
use Switch;

switch(argument){
case 1 { print "数字 1" }
case "a" { print "字符串 a" }
case [1..10,42] { print "数字在列表中" }
case (\@array) { print "数字在数组中" }
case /\w+/ { print "正则匹配模式" }
case qr/\w+/ { print "正则匹配模式" }
case (\%hash) { print "哈希" }
case (\&sub) { print "子进程" }
else { print "不匹配之前的条件" }
}

4.2 循环

4.2.1 while

1
2
3
while (condition) {
statement(s);
}

4.2.2 until

1
2
3
until (condition) {
statement(s);
}

4.2.3 for

1
2
3
for (init; condition; increment) {
statement(s);
}

4.2.4 foreach

1
2
3
foreach var (list) {
statement(s);
}

4.2.5 do while

1
2
3
do {
statement(s);
} while (condition);

4.3 循环控制语句

4.3.1 next

Perl next语句用于停止执行从next语句的下一语句开始到循环体结束标识符之间的语句,转去执行continue语句块,然后再返回到循环体的起始处开始执行下一次循环。语法为:next [ LABEL ];,其中LABEL是可选的

1
2
3
4
5
6
7
8
9
10
11
12
13
use strict;
use warnings;
use Modern::Perl;

my $a = 10;
while ( $a < 20 ) {
if ( $a == 15 ) {
$a = $a + 1;
next;
}
say "a: $a";
$a = $a + 1;
}

4.3.2 last

Perl last语句用于退出循环语句块,从而结束循环,last语句之后的语句不再执行,continue语句块也不再执行。语法为:last [LABEL];,其中LABEL`是可选的

1
2
3
4
5
6
7
8
9
10
11
12
13
use strict;
use warnings;
use Modern::Perl;

my $a = 10;
while ( $a < 20 ) {
if ( $a == 15 ) {
$a = $a + 1;
last;
}
say "a: $a";
$a = $a + 1;
}

4.3.3 continue

Perl continue块通常在条件语句再次判断前执行。continue语句可用在whileforeach循环中,语法如下:

1
2
3
4
5
6
7
8
9
10
11
while (condition) {
statement(s);
} continue {
statement(s);
}

foreach my $a (@listA) {
statement(s);
} continue {
statement(s);
}
1
2
3
4
5
6
7
8
9
10
use strict;
use warnings;
use Modern::Perl;

my $a = 0;
while ( $a < 3 ) {
say "a: $a";
} continue {
$a = $a + 1;
}
1
2
3
4
5
6
7
8
9
10
use strict;
use warnings;
use Modern::Perl;

my @list = ( 1, 2, 3, 4, 5 );
foreach $a (@list) {
say "a: $a";
} continue {
last if $a == 4;
}

4.3.4 redo

Perl redo语句直接转到循环体的第一行开始重复执行本次循环,redo语句之后的语句不再执行,continue语句块也不再执行。语法为:redo [LABEL];,其中LABEL是可选的

1
2
3
4
5
6
7
8
9
10
11
12
13
14
use strict;
use warnings;
use Modern::Perl;

my $a = 0;
while ( $a < 10 ) {
if ( $a == 5 ) {
$a = $a + 1;
redo;
}
say "a: $a";
} continue {
$a = $a + 1;
}

4.3.5 godo

Perl有三种goto形式:

  1. got LABLE:找出标记为LABEL的语句并且从那里重新执行
  2. goto EXPRgoto EXPR形式只是goto LABEL的一般形式。它期待表达式生成一个标记名称,并跳到该标记处执行
  3. goto &NAME:它把正在运行着的子进程替换为一个已命名子进程的调用
1
2
3
4
5
6
7
8
9
10
11
12
13
use strict;
use warnings;
use Modern::Perl;

my $a = 10;
LOOP: do {
if ( $a == 15 ) {
$a = $a + 1;
goto LOOP;
}
say "a = $a";
$a = $a + 1;
} while ( $a < 20 );
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
use strict;
use warnings;
use Modern::Perl;

my $a = 10;
my $str1 = "LO";
my $str2 = "OP";

LOOP: do {
if ( $a == 15 ) {
$a = $a + 1;

# equal with goto LOOP;
goto $str1 . $str2;
}
say "a = $a";
$a = $a + 1;
} while ( $a < 20 );

4.4 指令

4.4.1 分支指令

1
2
say 'Hello, Bob!' if $name eq 'Bob';
say "You're no Bob!" unless $name eq 'Bob';

4.4.2 循环指令

1
2
3
4
5
6
7
8
use strict;
use warnings;
use Modern::Perl;

say "$_ * $_ = ", $_ * $_ for 1 .. 10;

my @letters = 'a' .. 'z';
say for (@letters);

5 运算符

5.1 算数运算符

  1. +:加
  2. -:减
  3. *:乘
  4. /:除
  5. %:求余
  6. **:幂乘
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
use strict;
use warnings;
use Modern::Perl;

my $a = 10;
my $b = 20;

say "\$a = $a , \$b = $b";

my $c = $a + $b;
say '$a + $b = ' . $c;

$c = $a - $b;
say '$a - $b = ' . $c;

$c = $a * $b;
say '$a * $b = ' . $c;

$c = $a / $b;
say '$a / $b = ' . $c;

$c = $a % $b;
say '$a % $b = ' . $c;

$a = 2;
$b = 4;
$c = $a**$b;
say '$a ** $b = ' . $c;

5.2 比较运算符

  1. ==
  2. !=
  3. <=>:比较两个操作数是否相等
    • 左边小于右边,返回-1
    • 相等,返回0
    • 左边大于右边,返回1
  4. >
  5. <
  6. >=
  7. <=
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
use strict;
use warnings;
use Modern::Perl;

my $a = 10;
my $b = 20;

say "\$a = $a , \$b = $b";

if ( $a == $b ) {
say "$a == \$b => true";
} else {
say "\$a == \$b => false";
}

if ( $a != $b ) {
say "\$a != \$b => true";
} else {
say "\$a != \$b => false";
}

my $c = $a <=> $b;
say "\$a <=> \$b => $c";

if ( $a > $b ) {
say "\$a > \$b => true";
} else {
say "\$a > \$b => false";
}

if ( $a >= $b ) {
say "\$a >= \$b => true";
} else {
say "\$a >= \$b => false";
}

if ( $a < $b ) {
say "\$a < \$b => true";
} else {
say "\$a < \$b => false";
}

if ( $a <= $b ) {
say "\$a <= \$b => true";
} else {
say "\$a <= \$b => false";
}

5.3 字符串比较运算符

  1. lt
  2. gt
  3. le
  4. ge
  5. eq
  6. ne
  7. cmp:比较两个字符串是否相等
    • 左边小于右边,返回-1
    • 相等,返回0
    • 左边大于右边,返回1
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
use strict;
use warnings;
use Modern::Perl;

my $a = "abc";
my $b = "xyz";

say "\$a = $a ,\$b = $b";

if ( $a lt $b ) {
say "\$a lt \$b => true";
} else {
say "\$a lt \$b => false";
}

if ( $a gt $b ) {
say "\$a gt \$b => true";
} else {
say "\$a gt \$b => false";
}

if ( $a le $b ) {
say "\$a le \$b => true";
} else {
say "\$a le \$b => false";
}

if ( $a ge $b ) {
say "\$a ge \$b => true";
} else {
say "\$a ge \$b => false";
}

if ( $a ne $b ) {
say "\$a ne \$b => true";
} else {
say "\$a ne \$b => false";
}

my $c = $a cmp $b;
say "\$a cmp \$b => $c";

5.4 赋值运算符

  1. =
  2. +=
  3. -=
  4. *=
  5. /=
  6. %=
  7. %=
  8. **=
  9. //=:定义或赋值
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
use strict;
use warnings;
use Modern::Perl;

my $a = 10;
my $b = 20;
my $c = $a + $b;

say "\$a: $a, \$b: $b, \$c: $c";

$c += $a;
say "\$c: $c, st: '\$c += \$a'";

$c -= $a;
say "\$c: $c, st: '\$c -= \$a'";

$c *= $a;
say "\$c: $c, st: '\$c *= \$a'";

$c /= $a;
say "\$c: $c, st: '\$c /= \$a'";

$c %= $a;
say "\$c: $c, st: '\$c %= \$a'";

$c = 2;
$a = 4;
say "\$a: $a, \$c = $c";
$c**= $a;
say "\$c: $c, st: '\$c **= \$a'";

my %data;
$data{'first'} = $a;
$data{'first'} //= $b;
say "\$data{'first'}: $data{'first'}, st: '\$data{'first'} //= \$b'";

5.5 位运算

  1. &
  2. |
  3. ^
  4. ~
  5. <<
  6. >>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
use integer;
use strict;
use warnings;
use Modern::Perl;

my $a = 60;
my $b = 13;

say "\$a = $a , \$b = $b";

my $c = $a & $b;
say "\$a & \$b = $c";

$c = $a | $b;
say "\$a | \$b = $c";

$c = $a ^ $b;
say "\$a ^ \$b = $c";

$c = ~$a;
say "~\$a = $c";

$c = $a << 2;
say "\$a << 2 = $c";

$c = $a >> 2;
say "\$a >> 2 = $c";

5.6 逻辑运算

  1. and
  2. &&
  3. or
  4. ||
  5. not
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
use strict;
use warnings;
use Modern::Perl;

my $a = 1;
my $b = 0;

say "\$a = $a , \$b = $b";

my $c = ( $a and $b );
say "\$a and \$b = $c";

$c = ( $a && $b );
say "\$a && \$b = $c";

$c = ( $a or $b );
say "\$a or \$b = $c";

$c = ( $a || $b );
say "\$a || \$b = $c";

$a = 0;
$c = not($a);
say "not(\$a) = $c";

5.7 引号运算:q/qq/qx

有时候,需要在程序中定义一些复杂的字符串,比如包含引号本身,普通的写法会比较麻烦,例如$name = "\"hello\"";。可以使用引号运算来处理

  1. q{}/q():为字符串添加单引号,q{abcd}结果为'abcd'
  2. qq{}/qq():为字符串添加双引号,qq{abcd}结果为"abcd"
  3. qx{}/qx():为字符串添加反引号,qx{abcd}结果为`abcd`
  • 其中,起始分隔符和结束分隔符可以成对,比如{}()[];起始分隔符和结束分隔符也可以相同,比如^^
1
2
3
4
5
6
7
8
9
10
11
12
13
14
use strict;
use warnings;
use Modern::Perl;

my $a = 10;

my $b = q{a = $a};
say "q{a = \$a} = $b";

$b = qq{a = $a};
say "qq{a = \$a} = $b";

my $t = qx{date};
say "qx{date} = $t";

5.8 操作符:qw

将字符串以空白作为分隔符进行拆分,并返回一个数组

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
use strict;
use warnings;
use Modern::Perl;

my @str = qw/Ram is a boy/;
say "@str";
@str = qw{Geeks for Geeks};
say "@str";
@str = qw[Geeks for Geeks];
say "@str";
@str = qw'Geeks for Geeks';
say "@str";
@str = qw"Geeks for Geeks";
say "@str";
@str = qw!Geeks for Geeks!;
say "@str";
@str = qw@Geeks for Geeks@;
say "@str";

5.9 其他运算符

  1. .:用于连接两个字符串
  2. x:将给定字符串重复给定次数
  3. ..:范围运算符
  4. ++:自增
  5. --:自减
  6. ->:用于指定一个类的方法
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
use strict;
use warnings;
use Modern::Perl;

my $a = "run";
my $b = "oob";

say "\$a = $a , \$b = $b";

my $c = $a . $b;
say "\$a . \$b = $c";

$c = "-" x 3;
say "\"-\" x 3 = $c";

my @c = ( 2 .. 5 );
say "(2..5) = @c";

$a = 10;
$b = 15;
say "\$a = $a , \$b = $b";

$a++;
$c = $a;
say "\$a 执行 \$a++ = $c";

$b--;
$c = $b;
say "\$b 执行 \$b-- = $c";

6 函数

  1. Perl函数也就是用户定义的函数
  2. Perl函数即执行一个特殊任务的一段分离的代码,它可以使减少重复代码且使程序易读。
  3. Perl函数可以出现在程序的任何地方,语法格式如下
1
2
3
sub subroutine {
statements;
}

6.1 向函数传递参数

  1. Perl函数可以和其他编程一样接受多个参数,函数参数使用特殊数组@_标明
  2. 因此函数第一个参数为$_[0],第二个参数为$_[1],以此类推
  3. 不论参数是标量型还是数组型的,用户把参数传给函数时,Perl默认按引用的方式调用它们
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
use strict;
use warnings;
use Modern::Perl;

sub Average {
my $n = scalar(@_);
my $sum = 0;

foreach my $item (@_) {
$sum += $item;
}
my $average = $sum / $n;
say 'params : ', "@_";
say "first param : $_[0]";
say "average : $average";
}

Average( 10, 20, 30 );

6.1.1 向函数传递列表

  1. 由于@_变量是一个数组,所以它可以向函数中传递列表
  2. 但如果我们需要传入标量和数组参数时,需要把列表放在最后一个参数上
1
2
3
4
5
6
7
8
9
10
11
12
use strict;
use warnings;
use Modern::Perl;

sub PrintList {
my @list = @_;
say "列表为 : @list";
}
my $a = 10;
my @b = ( 1, 2, 3, 4 );

PrintList( $a, @b );

6.1.2 向函数传递哈希

当向函数传递哈希表时,它将复制到@_中,哈希表将被展开为键/值组合的列表

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
use strict;
use warnings;
use Modern::Perl;

sub PrintHash {
my (%hash) = @_;

foreach my $key ( keys %hash ) {
my $value = $hash{$key};
say "$key : $value";
}
}
my %hash = ( 'name' => 'youj', 'age' => 3 );

PrintHash(%hash);

6.1.3 设置参数默认值

方式一:使用//=运算符,只有在变量未定义的时候才会赋值

1
2
3
4
5
6
sub make_sundae {
my %parameters = @_;
$parameters{flavor} //= 'Vanilla';
$parameters{topping} //= 'fudge';
$parameters{sprinkles} //= 100;
}

方式二:

1
2
3
4
5
6
7
8
sub make_sundae {
my %parameters = (
flavor => 'Vanilla',
topping => 'fudge',
sprinkles => 100,
@_,
);
}

6.1.4 限制参数类型

我们可以将函数接受的参数类型写在函数名后面

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
use strict;
use warnings;
use Modern::Perl;

sub add($$) {
my ( $arg1, $arg2 ) = @_;
return $arg1 + $arg2;
}

sub append(\@$) {
my ( $list, $element ) = @_;
push( @$list, $element );
say @$list;
}

say add( 1, 2 );

my @list = ( 1, 2, 3 );
append( @list, 4 );

6.2 匿名函数

匿名函数与普通函数的唯一差别就是匿名函数没有名字,且仅能通过引用对其进行操作。格式如下:

1
my $anon_sub = sub { ... };
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
use strict;
use warnings;
use Modern::Perl;

my %dispatch = (
plus => sub { $_[0] + $_[1] },
minus => sub { $_[0] - $_[1] },
times => sub { $_[0] * $_[1] },
goesinto => sub { $_[0] / $_[1] },
raisedto => sub { $_[0]**$_[1] },
);

sub dispatch {
my ( $left, $op, $right ) = @_;
die "Unknown operation!" unless exists $dispatch{$op};
return $dispatch{$op}->( $left, $right );
}

say dispatch( 2, "times", 4 );

6.3 函数返回值

  1. 函数可以向其他编程语言一样使用return语句来返回函数值
  2. 如果没有使用return语句,则函数的最后一行语句将作为返回值
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
use strict;
use warnings;
use Modern::Perl;

sub add_a_b_1 {

# 不使用 return
$_[0] + $_[1];
}

sub add_a_b_2 {

# 使用 return
return $_[0] + $_[1];
}

say add_a_b_1( 1, 2 );
say add_a_b_2( 1, 2 );

6.4 函数的私有变量

  1. 默认情况下,Perl中所有的变量都是全局变量,这就是说变量在程序的任何地方都可以调用
  2. 如果我们需要设置私有变量,可以使用my操作符来设置
  3. my操作符用于创建词法作用域变量,通过my创建的变量,存活于声明开始的地方,直到闭合作用域的结尾
  4. 闭合作用域指的可以是一对花括号中的区域,可以是一个文件,也可以是一个ifwhileforforeacheval字符串
1
2
3
4
5
6
7
8
9
10
11
12
13
14
use strict;
use warnings;
use Modern::Perl;

my $string = "Hello, World!";

sub PrintHello {
my $string;
$string = "Hello, W3Cschool!";
say "inside: $string";
}

PrintHello();
say "outside: $string";

6.5 变量的临时赋值

  1. 我们可以使用local为全局变量提供临时的值,在退出作用域后将原来的值还回去
  2. local定义的变量不存在于主程序中,但存在于该函数和该函数调用的函数中。定义时可以给其赋值
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
use strict;
use warnings;
use Modern::Perl;

our $string = "Hello, World!";

sub PrintW3CSchool {
local $string;
$string = "Hello, W3Cschool!";

PrintMe();
say "within PrintW3CSchool: $string";
}

sub PrintMe {
say "within PrintMe: $string";
}

sub PrintHello {
say "within PrintHello: $string";
}

PrintW3CSchool();
PrintHello();
say "outside: $string";

6.6 静态变量

  1. state操作符功能类似于C里面的static修饰符,state关键字将局部变量变得持久
  2. state也是词法变量,所以只在定义该变量的词法作用域中有效
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
use strict;
use warnings;
use Modern::Perl;
use feature 'state';

sub PrintCount {
state $count = 0;

say "counter 值为:$count";
$count++;
}

for ( 1 .. 5 ) {
PrintCount();
}

6.7 函数调用上下文

函数调用过程中,会根据上下文来返回不同类型的值,比如以下localtime()函数,在标量上下文返回字符串,在列表上下文返回列表

1
2
3
4
5
6
7
8
9
10
use strict;
use warnings;
use Modern::Perl;

my $datestring = localtime(time);
say $datestring;

my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
localtime(time);
printf( "%d-%d-%d %d:%d:%d", $year + 1990, $mon + 1, $mday, $hour, $min, $sec );

6.7.1 上下文感知

wantarray用于判断上下文信息

  • 处于void上下文时,返回undef
  • 处于标量上下文时,返回false
  • 处于列表上下文时,返回true
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
use strict;
use warnings;
use Modern::Perl;

sub context {
my $context = wantarray();
say defined $context
? $context
? 'list'
: 'scalar'
: 'void';
return 0;
}
my @list_slice = ( 1, 2, 3 )[ context() ];
my @array_slice = @list_slice[ context() ];
my $array_index = $array_slice[ context() ];

# say imposes list context
say context();

# void context is obvious
context();

6.8 函数与命名空间

命名空间(namespace)即包(package)。默认情况下,函数定义在main包中,我们可以显式指定包。同一个命名空间中,某个函数名只能定义一次,重复定义会覆盖前一个定义。编译器会发出警告,可以通过no warnings 'redefine';禁止警告

1
2
3
sub Extensions::Math::add {
...
}

函数对内部、外部均可见,在同一个命名空间中,可以通过函数名来直接访问;在外部的命名空间中,必须通过全限定名来访问,除非将函数导入(importing)到当前命名空间中

6.9 报告错误

在函数中,我们可以通过caller获取调用者的相关信息

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
use strict;
use warnings;
use Modern::Perl;

package main;
main();

sub main {
show_call_information();
}

sub show_call_information {
my ( $package, $file, $line ) = caller();
say "Called from $package in $file at $line";
}

此外,我们可以向caller传递一个参数,用于表示沿着当前调用栈往前追溯的深度,且会额外返回调用者的信息

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
use strict;
use warnings;
use Modern::Perl;

package main;
main();

sub main {
show_call_information();
}

sub show_call_information {
my ( $package, $file, $line, $func ) = caller(0);
say "Called $func from $package in $file at $line";
}

此外,我们还可以使用Carp模块来方便地报告错误

1
2
3
4
5
6
7
8
9
10
use strict;
use warnings;
use Modern::Perl;
use Carp 'croak';

sub add_two_numbers {
croak 'add_two_numbers() takes two and only two arguments' unless @_ == 2;
}

add_two_numbers();

Params::Validate模块还可以进行参数类型的校验,这里不再赘述

6.10 原型

原型(prototype)用于给函数增加一些额外的元信息,用于提示编译器参数的类型。具体参考perldoc perlsub

  • $:标量
  • @:数组
  • %:哈希
  • &:代码块
  • \$:标量引用
  • \@:数组引用
  • \%:哈希引用
1
2
3
4
sub mypush (\@@) {
my ($array, @rest) = @_;
push @$array, @rest;
}

6.11 闭包

6.11.1 创建闭包

什么是闭包(Closure),闭包是包含了一个外部环境的函数。看下面这个例子,当make_iterator函数结束调用时,return语句返回的函数仍然指向@items$count这两个变量,因此这两个变量的生命周期延长了(与$cousins的生命周期相同)。同时由于@items$count这两个变量是拷贝出来的,因此,在make_iterator函数结束后,除了闭包本身,没有其他方式访问到这两个变量

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
use strict;
use warnings;
use Modern::Perl;

sub make_iterator {
my @items = @_;
my $count = 0;
return sub {
return if $count == @items;
return $items[ $count++ ];
}
}
my $cousins = make_iterator(qw( Rick Alex Kaycee Eric Corey ));

say $cousins->() for 1 .. 5;

6.11.2 何时使用闭包

闭包可以在固定大小的列表上生成有效的迭代器。当迭代一个过于昂贵而无法直接引用的项目列表时,它们表现出更大的优势,要么是因为它代表的数据一次计算的成本很高,要么它太大而无法直接进入载入内存

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
use strict;
use warnings;
use Modern::Perl;

sub gen_fib {
my @fibs = ( 0, 1, 1 );
return sub {
my $item = shift;
if ( $item >= @fibs ) {
for my $calc ( ( @fibs - 1 ) .. $item ) {
$fibs[$calc] = $fibs[ $calc - 2 ] + $fibs[ $calc - 1 ];
}
}
return $fibs[$item];
}
}

my $fiber = gen_fib();
say $fiber->(3);
say $fiber->(10);

上面这个例子可以进一步抽象(用于生成一些其他数列):

  1. 一个数组来存储计算后的值
  2. 一个用于计算的方法
  3. 返回计算或者缓存的结果
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
use strict;
use warnings;
use Modern::Perl;

sub gen_caching_closure {
my ( $calc_element, @cache ) = @_;
return sub {
my $item = shift;
$calc_element->( $item, \@cache ) unless $item < @cache;
return $cache[$item];
};
}

sub gen_fib {
my @fibs = ( 0, 1, 1 );
return gen_caching_closure(
sub {
my ( $item, $fibs ) = @_;
for my $calc ( ( @$fibs - 1 ) .. $item ) {
$fibs->[$calc] = $fibs->[ $calc - 2 ] + $fibs->[ $calc - 1 ];
}
},
@fibs
);
}

my $fiber = gen_fib();
say $fiber->(3);
say $fiber->(10);

6.11.3 参数绑定

通过闭包,我们能够固定函数的部分参数

1
2
3
4
5
6
7
8
9
10
11
12
13
14
sub make_sundae {
my %args = @_;
my $ice_cream = get_ice_cream( $args{ice_cream} );
my $banana = get_banana( $args{banana} );
my $syrup = get_syrup( $args{syrup} );
}

my $make_cart_sundae = sub {
return make_sundae(
@_,
ice_cream => 'French Vanilla',
banana => 'Cavendish',
);
};

6.11.4 闭包与state

闭包是一种能够在函数调用中持久化数据(不用全局变量)的简单、高效且安全的方式。如果我们想在普通函数中共享某些变量,我们需要引入额外的作用域

1
2
3
4
5
6
7
8
9
{
my $safety = 0;
sub enable_safety { $safety = 1 }
sub disable_safety { $safety = 0 }
sub do_something_awesome {
return if $safety;
...
}
}

7 正则表达式

正则表达式(regular expression)描述了一种字符串匹配的模式,可以用来检查一个串是否含有某种子串、将匹配的子串做替换或者从某个串中取出符合某个条件的子串等

Perl语言的正则表达式功能非常强大,基本上是常用语言中最强大的,很多语言设计正则式支持的时候都参考Perl的正则表达式,详情参考:

  • perldoc perlretut
  • perldoc perlre
  • perldoc perlreref

Perl的正则表达式的三种形式,分别是匹配,替换和转化:

  • 匹配:m//(还可以简写为//,略去m
  • 替换:s///
  • 转化:tr///

这三种形式一般都和=~!~搭配使用,=~表示相匹配,!~表示不匹配。当不使用运算符时,默认对$_生效,例如:

1
2
3
4
5
6
7
8
9
use warnings;
use strict;
use Modern::Perl;

$_ = "hi world";

s/hi/hello/;

say;

7.1 匹配操作符:m//

匹配操作符m//(还可以简写为//,略去m)用于匹配一个字符串语句或者一个正则表达式

1
m/PATTERN/QUALIFIER;

常用的修饰符,如下:

  • i:如果在修饰符中加上i,则正则将会取消大小写敏感性,即aA是一样的
  • m:多行模式。默认情况下,开始^和结束$只是对于正则字符串。如果在修饰符中加上m,那么开始和结束将会指字符串的每一行:每一行的开头就是^,结尾就是$
  • o:仅赋值一次
  • s:单行模式,.匹配\n(默认不匹配)
  • x:忽略模式中的空白以及#符号及其后面的字符,通常用于写出更易读的正则表达式
  • g:允许记住字符串的位置,这样就可以多次且连续地处理同一个字符串,通常与\G一起使用
  • cg:全局匹配失败后,允许再次查找匹配串

Perl处理完后会给匹配到的值存在三个特殊变量名:

  • $` :匹配部分的前一部分字符串
  • $&:匹配的字符串
  • $':还没有匹配的剩余字符串
  • 如果将这三个变量放在一起,将得到原始字符串
1
2
3
4
5
6
7
8
9
use strict;
use warnings;
use Modern::Perl;

my $string = "welcome to w3cschool site.";
$string =~ m/w3c/;
say "before matched: $`";
say "matched: $&";
say "after matched: $'";

7.2 替换操作符:s///

替换操作符s///是匹配操作符的扩展,使用新的字符串替换指定的字符串。基本格式如下:

1
s/PATTERN/REPLACEMENT/QUALIFIER;
1
2
3
4
5
6
7
8
use strict;
use warnings;
use Modern::Perl;

my $string = "welcome to google site.";
$string =~ s/google/w3cschool/;

say "$string";

常用的修饰符,如下:

  • i:如果在修饰符中加上i,则正则将会取消大小写敏感性,即aA是一样的
  • m:多行模式。默认情况下,开始^和结束$只是对于正则字符串。如果在修饰符中加上m,那么开始和结束将会指字符串的每一行:每一行的开头就是^,结尾就是$
  • o:表达式只执行一次
  • s:单行模式,.匹配\n(默认不匹配)
  • x:忽略模式中的空白以及#符号及其后面的字符,通常用于写出更易读的正则表达式
  • g:替换所有匹配的字符串
  • e:替换字符串作为表达式

7.3 转化操作符:tr///

转化操作符tr///逐字符地扫描一个字符串,然后把每个在SEARCHLIST(不是正则表达式)里出现的字符替换成对应的来自REPLACEMENTLIST(也不是替换字符串)的字符

1
tr/SEARCHLIST/REPLACEMENTLIST/QUALIFIER;
1
2
3
4
5
6
7
8
use strict;
use warnings;
use Modern::Perl;

my $string = 'welcome to w3cschool site.';
$string =~ tr/a-z/A-Z/;

say "$string";

常用的修饰符,如下:

  • c:转化所有未指定字符
  • d:删除所有指定字符
  • s:把多个相同的输出字符缩成一个

7.4 操作符:qr

qr用于创建正则表达式。相比于普通变量,qr还可以额外存储修饰符

1
2
3
4
5
6
7
8
9
10
11
use strict;
use warnings;
use Modern::Perl;

my $hat = qr/hat/;
my $name = "I have a hat!";
say 'Found a hat!' if $name =~ /$hat/;

my $hat_i = qr/hat/i;
$name = "I have a Hat!";
say 'Found a hat!' if $name =~ /$hat_i/;

7.5 具名捕获

具名捕获格式如下:

1
(?<name> ... )

其中,?<name>是正则表达式的名称,其右边是常规的正则表达式,整个部分用()包围起来。当字符串匹配时,匹配部分会被存储在$+中($+是一个哈希),其中,key是正则表达式的名称

1
2
3
4
5
6
7
8
9
10
use strict;
use warnings;
use Modern::Perl;

my $phone_number = qr/[0-9]{8}/;
my $contact_info = 'CN-88888888';

if ( $contact_info =~ /(?<phone>$phone_number)/ ) {
say "Found a number $+{phone}";
}

7.6 非具名捕获

非具名捕获的格式如下:

1
(...)

我们可以通过数字来引用被捕获的部分,比如$1$2等。编号由什么决定?由(出现的顺序决定,即第一个(出现的分区用$1,第二个用$2,以此类推

1
2
3
4
5
6
7
8
9
10
use strict;
use warnings;
use Modern::Perl;

my $phone_number = qr/[0-9]{8}/;
my $contact_info = 'CN-88888888';

if ( $contact_info =~ /($phone_number)/ ) {
say "Found a number $1";
}

此外,在列表上下文中,Perl会按照捕获组的顺序,依次给列表中的变量赋值

1
2
3
4
5
6
7
8
9
10
11
use strict;
use warnings;
use Modern::Perl;

my $country = qr/[a-zA-Z]+/;
my $phone_number = qr/[0-9]{8}/;
my $contact_info = 'CN-88888888';

if ( my ( $c, $p ) = $contact_info =~ /($country)-($phone_number)/ ) {
say "$c: $p";
}

7.7 交替

交替元字符(Alternation Metacharacter|,表示前面的任何一个片段都可能匹配

1
2
3
4
5
6
7
8
9
10
use strict;
use warnings;
use Modern::Perl;
use Test::More tests => 3;

my $r = qr/^rice|beans$/;

like( 'rice', $r, 'Match rice' );
like( 'beans', $r, 'Match beans' );
like( 'ricbeans', $r, 'Match weird hybrid' );

注意到,rice|beans也可以表示ric + e|b + eans。为了避免混淆,可以加上括号

1
2
3
4
5
6
7
8
9
10
use strict;
use warnings;
use Modern::Perl;
use Test::More tests => 3;

my $r = qr/^(rice|beans)$/;

like( 'rice', $r, 'Match rice' );
like( 'beans', $r, 'Match beans' );
unlike( 'ricbeans', $r, 'Unmatch weird hybrid' );

或者,使用(?:...),如下:

1
2
3
4
5
6
7
8
9
10
use strict;
use warnings;
use Modern::Perl;
use Test::More tests => 3;

my $r = qr/^(?:rice|beans)$/;

like( 'rice', $r, 'Match rice' );
like( 'beans', $r, 'Match beans' );
unlike( 'ricbeans', $r, 'Unmatch weird hybrid' );

7.8 断言

断言都是零长度的,它不消耗匹配字符串中的字符,仅表示一些位置信息

  • \A:整个匹配串的起始位置
  • \Z:整个匹配串的结束位置
  • ^:行的起始位置
  • $:行的结束位置
  • \b:它的前一个字符和后一个字符不全是(一个是,一个不是或不存在)\w
  • \B:它的前一个字符和后一个字符不全是(一个是,一个不是或不存在)\W
  • (?!...):表示前面的模式后面不能紧跟...表示的模式。zero-width negative look-ahead assertion
  • (?=...):表示前面的模式后面必须紧跟...表示的模式。zero-width positive look-ahead assertion
  • (?<!...):表示后面的模式,其前面不能紧跟...表示的模式。zero-width negative look-behind assertion
  • (?<=...):表示后面的模式,其前面必须紧跟...表示的模式。zero-width positive look-behind assertion
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
use strict;
use warnings;
use Modern::Perl;
use Test::More tests => 6;

my $r1 = qr/\Aabcd\Z/;
my $r2 = qr/some(?!thing)/;
my $r3 = qr/some(?=thing)/;
my $r4 = qr/(?<!some)thing/;
my $r5 = qr/(?<=some)thing/;

like( 'abcd', $r1, 'exactly abcd' );
unlike( 'abcde', $r1, 'not exactly abcd' );
unlike( 'something', $r2, 'some is immediately followed by thing' );
like( 'something', $r3, 'some is immediately followed by thing' );
unlike( 'something', $r4, 'some is immediately before thing' );
like( 'something', $r5, 'some is immediately before thing' );

7.9 循环匹配

\G用于表示最近一次匹配的位置,一般用于循环处理一个长文本,每次处理一小块(下面这个例子,不加\G效果也一样)

  • g表示记录本次匹配后,字符串的位置
  • \G表示从上次匹配后记录的字符串的位置开始
1
2
3
4
5
6
7
8
9
10
11
12
13
use strict;
use warnings;
use Modern::Perl;

my $contents = '
010-99991111
0571-88888888
021-11117789
';

while ( $contents =~ /\G.*?(\d{3, 4})-(\d{8}).*?/gs ) {
say "area num: $1, number: $2";
}

8 作用域

Perl中的所有符号都存在作用域(Scope

8.1 词法作用域

什么是词法作用域(Lexical Scope),由大括号{}包围的范围就是一个词法作用域。可以是一个普通的{};可以是一个循环语句;可以是函数定义;given语句;可以是其他语法构成的{}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
# outer lexical scope
{
package My::Class;
my $outer;
sub awesome_method {
my $inner;
do {
my $do_scope;
...
} while (@_);
# sibling inner lexical scope
for (@_) {
my $for_scope;
...
}
}
}

8.2 包作用域

每个包都有一个符号表,该符号表中包含了所有包作用域下的变量。我们可以检查和修改该符号表,这就是导入(importing)的工作原理,也是只有全局变量或者包全局变量能够本地化(local)的原因

8.3 动态作用域

我们可以通过local来调整全局变量(或者包全局变量)的作用域,在当前作用域内修改该全局变量的值,不会影响在当前作用域之外的该全局变量的值。通常在处理一些特殊变量时,比较有用

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
use strict;
use warnings;
use Modern::Perl;

{
our $scope;

sub inner {
say $scope;
}

sub main {
say $scope;
local $scope = 'main() scope';
middle();
}

sub middle {
say $scope;
inner();
}
$scope = 'outer scope';
main();
say $scope;
}

8.4 静态作用域

我们可以通过state来创建具有静态作用域的变量,该变量的生命周期延长至整个程序,但是该变量的可见性依然没有变

1
2
3
4
5
6
7
8
9
10
11
12
use strict;
use warnings;
use Modern::Perl;

sub counter {
state $count = 1;
return $count++;
}

say counter();
say counter();
say counter();

9 包和模块

9.1 包

Perl中每个包(Package)有一个单独的符号表,定义语法为:

1
package mypack;

此语句定义一个名为mypack的包,在此后定义的所有变量和函数的名字都存贮在该包关联的符号表中,直到遇到另一个package语句为止

每个符号表有其自己的一组变量、函数名,各组名字是不相关的,因此可以在不同的包中使用相同的变量名,而代表的是不同的变量。

从一个包中访问另外一个包的变量,可通过package_name::variable_name的方式指定

存贮变量和函数的名字的默认符号表是与名为main的包相关联的。如果在程序里定义了其它的包,当你想切换回去使用默认的符号表,可以重新指定main

每个包包含三个默认的函数:

  1. VERSION()
  2. import()
  3. unimport()

9.1.1 UNIVERSAL

Perl提供了一个特殊的包,叫做UNIVERSAL,它是所有包的祖先,提供了一些方法,包括

  • isa():类方法,用于判断是否继承自某个类
  • can():类方法,用于判断是否包含某个方法
  • VERSION():类方法,返回包的版本。该方法还能传入一个版本参数,若版本小于该参数,则会抛异常
  • DOES():类方法,用于判断是否扮演了某个角色

9.2 模块

Perl5中用Perl包来创建模块。

Perl模块是一个可重复使用的包,模块的名字与包名相同,定义的文件后缀为.pm

Perl中关于模块需要注意以下几点:

  • 函数requireuse将载入一个模块
  • @INCPerl内置的一个特殊数组,它包含指向库例程所在位置的目录路径。
  • requireuse函数调用eval函数来执行代码
  • 末尾1;执行返回TRUE,这是必须的,否则返回错误

userequire的区别:

  1. require用于载入moduleperl程序(.pm后缀可以省略,但.pl必须有)
  2. use语句是编译时引入,require是运行时引入
  3. use引入模块的同时,也引入了模块的子模块。而require则不能引入子模块
  4. use是在当前默认的@INC里面去寻找,一旦模块不在@INC中的话,用use是不可以引入的,但是require可以指定路径
  5. use引用模块时,如果模块名称中包含::双冒号,该双冒号将作为路径分隔符,相当于Unix下的/或者Windows下的\

9.2.1 导入

当使用use加载模块时,Perl会自动调用该模块的import()函数,模块中的接口可以提供自己的import()方法来向外部导出符号

模块后跟的名字都会作为import()方法的参数,例如

1
2
use strict 'refs';
use strict qw( subs vars );

上面这两句等价于

1
2
3
4
5
BEGIN {
require strict;
strict->import('refs');
strict->import(qw( subs vars ));
}

no函数会调用模块的unimport方法

10 面向对象

Perl 5中用package来为类提供命名空间。(Moose模块可以用cpan Moose来安装)

1
2
3
4
5
6
7
8
9
10
11
use strict;
use warnings;
use Modern::Perl;

{
package Cat;
use Moose;
}

my $brad = Cat->new();
my $jack = Cat->new();

这里,箭头运算符->用于调用类或对象的方法

10.1 方法

  1. 方法的调用总是有一个invocant,该方法在该invocant上运行。方法调用者可以是类名,也可以是类的一个实例
  2. invocant会作为方法的第一个参数。这里存在一个普遍的约定,就是会将该参数保存到$self变量中
  3. 方法调用会涉及到分发策略,就是决定调用方法的哪一个具体的实现(多态)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
use strict;
use warnings;
use Modern::Perl;

{

package Cat;
use Moose;

sub meow {
my $self = shift;
say 'Meow!';
}
}

my $alarm = Cat->new();
$alarm->meow();
$alarm->meow();
$alarm->meow();

Cat->meow() for 1 .. 3;

10.2 属性

我们通过has来定义属性(perldoc Moose),其中

  • is:声明属性的读写属性,即是否可读,是否可写
    • ro:表示只读
    • rw:表示读写
  • isa:声明属性的类型
  • writer:提供私有的,类内部使用的写入器
  • 特别地,该行定义会根据读写属性创建相应的访问属性的方法和修改属性的方法。比如下面这个例子,就会创建一个访问属性的方法name(),且允许在构造函数里传入一个name参数用于初始化该属性
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
use strict;
use warnings;
use Modern::Perl;

{

package Cat;
use Moose;
has 'name' => ( is => 'ro', isa => 'Str' );
}

for my $name (qw( Tuxie Petunia Daisy )) {
my $cat = Cat->new( name => $name );
say "Created a cat for ", $cat->name();
}

此外,has还可以有多种不同的书写方式:

1
2
3
4
5
6
7
8
9
10
has 'name', is => 'ro', isa => 'Str';
has( 'name', 'is', 'ro', 'isa', 'Str' );
has( qw( name is ro isa Str ) );
has 'name' => (
is => 'ro',
isa => 'Str',
# advanced Moose options; perldoc Moose
init_arg => undef,
lazy_build => 1,
);

10.2.1 属性默认值

通过default关键词,可以将一个函数引用关联到属性上,当构造函数未提供该属性的初始值时,会通过该函数应用来创建初始值

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
use strict;
use warnings;
use Modern::Perl;

{

package Cat;
use Moose;
has 'name' => ( is => 'ro', isa => 'Str' );
has 'diet' => ( is => 'rw', isa => 'Str' );
has 'birth_year' =>
( is => 'ro', isa => 'Int', default => sub { (localtime)[5] + 1900 } );
}

my $cat = Cat->new( name => "Tuxie", diet => "Junk Food" );
say $cat->birth_year();

10.3 多态

多态(polymorphism)是OOP中的一个重要属性。在Perl中,只要两个对象提供了相同的外部接口,就可以将一个类的对象替换为另一个类的对象。某些语言(比如Java/C++)可能会要求额外的信息,比如类的继承关系,接口的实现关系等等,然后才允许多态发生

10.4 角色

角色(Role)是一组行为和状态的具名集合。一个类就是一个角色,类和角色之间的重要区别就是,类可以实例化成对象,而角色不行(感觉,角色这个概念,就类似于其他语言中的接口)

  • requires关键词声明角色需要包含哪些方法
  • with关键词声明类扮演了哪些角色。通常with会写在属性定义后面,这样Moose为属性生成的访问方法或者修改方法也可以作为扮演角色所必须实现的方法
  • DOES用于检查实例是否扮演了某个角色
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
use strict;
use warnings;
use Modern::Perl;

{

package LivingBeing;
use Moose::Role;
requires qw( name age diet );
}

{

package Cat;
use Moose;
has 'name' => ( is => 'ro', isa => 'Str' );
has 'diet' => ( is => 'rw', isa => 'Str' );
has 'birth_year' =>
( is => 'ro', isa => 'Int', default => (localtime)[5] + 1900 );

with 'LivingBeing';

sub age {
my $self = shift;
my $year = (localtime)[5] + 1900;
return $year - $self->birth_year();
}
}

my $fluffy = Cat->new( name => "Fluffy", diet => "Junk Food" );
my $cheese = Cat->new( name => "Cheese", diet => "Junk Food" );

say 'Alive!' if $fluffy->DOES('LivingBeing');
say 'Moldy!' if $cheese->DOES('LivingBeing');

此外,我们还可以将公共的部分抽取出来放到一个角色中,进一步复用代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
use strict;
use warnings;
use Modern::Perl;

{

package LivingBeing;
use Moose::Role;
requires qw( name age diet );
}

{

package CalculateAge::From::BirthYear;
use Moose::Role;
has 'birth_year' =>
( is => 'ro', isa => 'Int', default => sub { (localtime)[5] + 1900 } );

sub age {
my $self = shift;
my $year = (localtime)[5] + 1900;
return $year - $self->birth_year();
}
}

{

package Cat;
use Moose;
has 'name' => ( is => 'ro', isa => 'Str' );
has 'diet' => ( is => 'rw', isa => 'Str' );

with 'LivingBeing', 'CalculateAge::From::BirthYear';
}

my $fluffy = Cat->new( name => "Fluffy", diet => "Junk Food" );
my $cheese = Cat->new( name => "Cheese", diet => "Junk Food" );

say 'Alive!' if $fluffy->DOES('LivingBeing');
say 'Moldy!' if $cheese->DOES('LivingBeing');

可以看到,我们将通过birth_year计算age的这部分代码单独移到了角色CalculateAge::From::BirthYear中,且Cat继承了该角色的age方法,且正好满足LivingBeing的要求(提供age方法)。Cat可以选择自己提供age方法或者从其他Role中直接继承,只要有就可以,这就叫做同构(Allomorphism

10.5 继承

Perl 5提供的另一个特性就是继承(Inheritance)。继承在两个类之间建立关联,子类可以继承父类的属性和方法以及角色。事实上,实践表明,我们可以在所有需要继承的地方将其替换为角色,因为角色具有更好的安全性、类型检查、更少的代码耦合

  • extends关键词来声明继承的父类列表
  • has '+candle_power', default => 100;中的+表示显式覆盖父类中的属性
  • override关键词用于显式声明方法重写,并且提供调用父类方法的方式,即super()
  • isa用于检查实例是否继承自某个类
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
use strict;
use warnings;
use Modern::Perl;

{

package LightSource;
use Moose;
has 'candle_power' => ( is => 'ro', isa => 'Int', default => 1 );
has 'enabled' =>
( is => 'ro', isa => 'Bool', default => 0, writer => '_set_enabled' );

sub light {
my $self = shift;
$self->_set_enabled(1);
}

sub extinguish {
my $self = shift;
$self->_set_enabled(0);
}
}

{

package LightSource::SuperCandle;
use Moose;
extends 'LightSource';
has '+candle_power' => ( default => 100 );
}

{

package LightSource::Glowstick;
use Moose;
extends 'LightSource';
sub extinguish { }
}

{

package LightSource::Cranky;
use Carp;
use Moose;
extends 'LightSource';
override light => sub {
my $self = shift;
Carp::carp("Can't light a lit light source!") if $self->enabled;
super();
};
override extinguish => sub {
my $self = shift;
Carp::carp("Can't extinguish an unlit light source!")
unless $self->enabled;
super();
};
}

my $sconce = LightSource::Glowstick->new();
say 'Looks like a LightSource' if $sconce->isa('LightSource');

当有多个父类都提供了同一个方法时,Perl的分派策略(perldoc mro):查找第一个父类(递归查找父类的父类)的方法,再查找第二个父类,直到找到方法

10.6 原生OOP

上面介绍的都是基于MooseOOP,下面再介绍一下Perl 5原生的OOP

Perl中有两种不同地面向对象编程的实现:

  1. 一是基于匿名哈希表的方式,每个对象实例的实质就是一个指向匿名哈希表的引用。在这个匿名哈希表中,存储来所有的实例属性
  2. 二是基于数组的方式,在定义一个类的时候,我们将为每一个实例属性创建一个数组,而每一个对象实例的实质就是一个指向这些数组中某一行索引的引用。在这些数组中,存储着所有的实例属性

10.6.1 基本概念

面向对象有很多基础概念,最核心的就是下面三个:

  • 对象:对象是对类中数据项的引用
  • 类:类是个Perl包,其中含提供对象方法的类(Perl对类和包没有明确的区分)
  • 方法:方法是个Perl子程序,类名是其第一个参数。

Perl提供了bless()函数,bless是用来构造对象的,通过bless把一个引用和这个类名相关联,返回这个引用就构造出一个对象

10.6.2 类的定义

  1. 一个类只是一个简单的包
  2. 可以把一个包当作一个类用,并且把包里的函数当作类的方法来用
  3. Perl的包提供了独立的命名空间,所以不同包的方法与变量名不会冲突
  4. Perl类的文件后缀为.pm

10.6.3 创建和使用对象

  1. 创建一个类的实例 (对象) 我们需要定义一个构造函数,大多数程序使用类名作为构造函数,Perl中可以使用任何名字,通常来说,用new(这个new不是关键词,而是个普通的函数名)
  2. 你可以使用多种Perl的变量作为Perl的对象。大多数情况下我们会使用数组或哈希的引用
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
use strict;
use warnings;
use Modern::Perl;

{

package Person;

sub new {
my $class = shift;
my $self = {
_firstName => shift,
_lastName => shift,
_ssn => shift,
};

say "First name: $self->{_firstName}";
say "Last name: $self->{_lastName}";
say "Num: $self->{_ssn}";
bless $self, $class;
return $self;
}
}

my $object = new Person( "Bruce", "Lee", 23234345 );

10.6.4 定义方法

  1. Perl类的方法只但是是个Perl子程序而已,也即通常所说的成员函数
  2. Perl面向对象中Perl的方法定义不提供任何特别语法,但规定方法的第一个参数为对象或其被引用的包
  3. Perl没有提供私有变量,但我们可以通过辅助的方式来管理对象数据
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
use strict;
use warnings;
use Modern::Perl;

{

package Person;

sub new {
my $class = shift;
my $self = {
_firstName => shift,
_lastName => shift,
_ssn => shift,
};

say "First name: $self->{_firstName}";
say "Last name: $self->{_lastName}";
say "Num: $self->{_ssn}";
bless $self, $class;
return $self;
}

sub setFirstName {
my ( $self, $firstName ) = @_;
$self->{_firstName} = $firstName if defined($firstName);
return $self->{_firstName};
}

sub getFirstName {
my ($self) = @_;
return $self->{_firstName};
}
}

my $object = new Person( "Bruce", "Lee", 23234345 );
my $firstName = $object->getFirstName();
say "firstName: $firstName";

$object->setFirstName("John");

$firstName = $object->getFirstName();
say "firstName: $firstName";

10.6.5 继承

  1. Perl里类方法通过@ISA数组继承,这个数组里面包含其他包(类)的名字,变量的继承必须明确设定
  2. 多继承就是这个@ISA数组包含多个类(包)名字
  3. 通过@ISA能继承方法和数据
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
use strict;
use warnings;
use Modern::Perl;

{

package Person;

sub new {
my $class = shift;
my $self = {
_firstName => shift,
_lastName => shift,
_ssn => shift,
};

say "First name: $self->{_firstName}";
say "Last name: $self->{_lastName}";
say "Num: $self->{_ssn}";
bless $self, $class;
return $self;
}

sub setFirstName {
my ( $self, $firstName ) = @_;
$self->{_firstName} = $firstName if defined($firstName);
return $self->{_firstName};
}

sub getFirstName {
my ($self) = @_;
return $self->{_firstName};
}
}

{

package Employee;
our @ISA = qw(Person);
}

my $object = new Employee( "Bruce", "Lee", 23234345 );
my $firstName = $object->getFirstName();
say "firstName: $firstName";

$object->setFirstName("John");

$firstName = $object->getFirstName();
say "firstName: $firstName";

10.6.6 方法重写

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
use strict;
use warnings;
use Modern::Perl;

{

package Person;

sub new {
my $class = shift;
my $self = {
_firstName => shift,
_lastName => shift,
_ssn => shift,
};

say "First name: $self->{_firstName}";
say "Last name: $self->{_lastName}";
say "Num: $self->{_ssn}";
bless $self, $class;
return $self;
}

sub setFirstName {
my ( $self, $firstName ) = @_;
$self->{_firstName} = $firstName if defined($firstName);
return $self->{_firstName};
}

sub getFirstName {
my ($self) = @_;
return $self->{_firstName};
}
}

{

package Employee;
our @ISA = qw(Person);

sub new {
my ($class) = @_;

my $self = $class->SUPER::new( $_[1], $_[2], $_[3] );

$self->{_id} = undef;
$self->{_title} = undef;
bless $self, $class;
return $self;
}

sub getFirstName {
my ($self) = @_;
say "Employee::getFirstName";
return $self->{_firstName};
}

sub setLastName {
my ( $self, $lastName ) = @_;
$self->{_lastName} = $lastName if defined($lastName);
return $self->{_lastName};
}

sub getLastName {
my ($self) = @_;
return $self->{_lastName};
}
}

my $object = new Employee( "Bruce", "Lee", 23234345 );
my $firstName = $object->getFirstName();
say "firstName: $firstName";

$object->setFirstName("John");

$firstName = $object->getFirstName();
say "firstName: $firstName";

my $lastName = $object->getLastName();
say "lastName: $lastName";

$object->setLastName("Chen");

$lastName = $object->getLastName();
say "lastName: $lastName";

10.6.7 默认载入

  1. 如果在当前类、当前类所有的基类、还有UNIVERSAL类中都找不到请求的方法,这时会再次查找名为AUTOLOAD()的一个方法。如果找到了AUTOLOAD,那么就会调用,同时设定全局变量$AUTOLOAD的值为缺失的方法的全限定名称
  2. 如果还不行,那么Perl就宣告失败并出错

如果你不想继承基类的AUTOLOAD,很简单,只需要一句:

1
sub AUTOLOAD;

10.6.8 析构函数及垃圾回收

  1. 当对象的最后一个引用释放时,对象会自动析构
  2. 如果你想在析构的时候做些什么,那么你可以在类中定义一个名为DESTROY的方法。它将在适合的时机自动调用,并且按照你的意思执行额外的清理动作
  3. Perl会把对象的引用作为 唯一的参数传递给DESTROY。注意这个引用是只读的,也就是说你不能通过访问$_[0]来修改它。但是对象自身(比如${$_[0]或者@{$_[0]}还有%{$_[0]}等等)还是可写的
  4. 如果你在析构器返回之前重新bless了对象引用,那么Perl会在析构器返回之后接着调用你重新bless的那个对象的DESTROY方法
  5. 在当前对象释放后,包含在当前对象中的其它对象会自动释放
1
2
3
4
5
package MyClass;
...
sub DESTROY {
print "MyClass::DESTROY called\n";
}

11 格式化输出

  1. Perl是一个非常强大的文本数据处理语言
  2. Perl中可以使用format来定义一个模板,然后使用write按指定模板输出数据

Perl格式化定义语法格式如下

1
2
3
4
5
6
format FormatName =
fieldline
value_one, value_two, value_three
fieldline
value_one, value_two
.

参数解析:

  • FormatName:格式化名称
  • fieldline:格式行,用来定义一个输出行的格式,类似@^|这样的字符
  • value_onevalue_two... :数据行,用来向前面的格式行中插入值,都是Perl的变量。
  • .:结束符号
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
use strict;
use warnings;
use Modern::Perl;

my $text = "google youj taobao";
format STDOUT =
# left align, length is 6
first: ^<<<<<
$text
# left align, length is 6
second: ^<<<<<
$text
# left align, length is 5
third: ^<<<<
$text
.
write

11.1 格式行

格式行中涉及的符号

  • 普通字符:格式行中也可以包含普通字符,包括空格等
  • @:格式串的起始符号。并不意味着是格式行的起始符号,该符号前也可以有普通字符
  • ^:格式串的起始符号。并不意味着是格式行的起始符号,该符号前也可以有普通字符
  • <:左对齐
  • |:居中对齐
  • >:右对齐
  • #:数字字段中的有效位数
    • 整数部分,不足会在前面补空格
    • 小数部分,不足会在后面补0
  • .:数字字段中的小数点
  • @*:整个多行文本
  • ^*:多行文本的下一行
  • ~:禁止所有字段为空的行
  • ~~:重复行,直到所有字段都用完,放最前最后都可以。放最前面的话,~~同时还起到两个空格的作用,若要顶格输出,那么将~~放到最后即可
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
use strict;
use warnings;
use Modern::Perl;

my $text = "line 1\nline 2\nline 3";

format MUTI_LINE_1 =
Text: @*
$text
.
$~ = "MUTI_LINE_1";
write;

format MUTI_LINE_2 =
Text: ^*
$text
~~ ^*
$text
.
$~ = "MUTI_LINE_2";
write;

# reset text
$text = "line 1\nline 2\nline 3";
format MUTI_LINE_3 =
Text: ^*
$text
^*~~
$text
.
$~ = "MUTI_LINE_3";
write;
1
2
3
4
5
6
7
8
9
10
11
12
13
14
use strict;
use warnings;
use Modern::Perl;

my @nums = ( 1, 123.456, 0.78999 );
format STDOUT =
@##
$nums[0]
@###.####
$nums[1]
@.###
$nums[2]
.
write

11.2 格式变量

  • $~:格式名称,默认是STDOUT
  • $^:每页的页头格式,默认是STDOUT_TOP
  • $%:当前页号
  • $=:当前页中的行号
  • $|:是否自动刷新输出缓冲区存储
  • $^L
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
format EMPLOYEE =
===================================
@<<<<<<<<<<<<<<<<<<<<<< @<<
$name, $age
@#####.##
$salary
===================================
.

# add paging $%
format EMPLOYEE_TOP =
===================================
Name Age Page @<
$%
===================================
.

select(STDOUT);
$~ = EMPLOYEE;
$^ = EMPLOYEE_TOP;

@n = ( "Ali", "W3CSchool", "Jaffer" );
@a = ( 20, 30, 40 );
@s = ( 2000.00, 2500.00, 4000.000 );

$i = 0;
foreach (@n) {
$name = $_;
$age = $a[$i];
$salary = $s[ $i++ ];
write;
}

11.3 输出到其他文件

默认情况下函数write将结果输出到标准输出文件STDOUT,我们也可以使它将结果输出到任意其它的文件中。最简单的方法就是把文件变量作为参数传递给write。例如,write(MYFILE);write就用缺省的名为MYFILE的打印格式输出到文件MYFILE中。但是这样就不能用$~变量来改变所使用的打印格式,因为系统变量$~只对默认文件变量起作用

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
use strict;
use warnings;
use Modern::Perl;

if ( open( MYFILE, ">tmp" ) ) {
$~ = "MYFORMAT";
write MYFILE;

format MYFILE =
=================================
输入到文件中
=================================
.
close MYFILE;
}

我们可以使用select改变默认文件变量时,它返回当前默认文件变量的内部表示,这样我们就可以创建函数,按自己的想法输出,又不影响程序的其它部分

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
use strict;
use warnings;
use Modern::Perl;

if ( open( MYFILE, ">>tmp" ) ) {
select(MYFILE);
$~ = "OTHER";
write;

format OTHER =
=================================
使用定义的格式输入到文件中
=================================
.
close MYFILE;
}

12 文件

Perl 5包含三个标准的文件句柄(文件句柄表示一个用于输入或者输出的通道)

  1. STDIN:标准输入
  2. STDOUT:标准输出
  3. STDERR:标准错误

12.1 读文件

默认情况下,say或者print会将内容输出到STDOUT中,warn会将内容输出到STDERR

我们可以通过open打开一个外部文件

  • 第一个参数:文件描述符
  • 第二个参数:读写方式
    • <:读
    • >:覆盖写
    • >>:追加写
    • +<:读写

从文件中迭代读取内容的经典while循环如下:

1
2
3
4
5
6
use autodie;

open my $fh, '<', $file;
while (<$fh>) {
...
}

Perl在解析上面这段代码时,等效于处理下面这段逻辑。如果没有这个隐式的defined,那么碰到空行就会结束循环了(空行在布尔上下文中会转换成false)。在迭代到文件尾时,会返回undef

1
2
3
while (defined($_ = <$fh>)) {
...
}

特别地,<>表示空文件句柄,Perl默认会将@ARGV中存储的内容作为文件名进行依次读取,如果@ARGV为空,那么会读取标准输入

1
2
3
while (<>) {
...
}

12.1.1 跳过空白行

1
2
3
4
5
6
7
8
9
10
use warnings;
use strict;
use Modern::Perl;

open my $fh, "< /tmp/a.txt" or die "$!";

while (<$fh>) {
next if ( $_ =~ /^\s*$/ );
print $_;
}

12.1.2 一次性读取全部内容

特殊变量$/表示行分隔符。在不同平台中,行分隔符可能是\n\r或者\r\n等等。默认情况下,<filehandler>每次读取一行

我们可以将$/设置为undef,这样一来,我们就能一次性读取到整行内容

1
2
3
4
5
6
7
8
use strict;
use warnings;
use Modern::Perl;

open my $fh, '<', 'data.txt' or die;
undef $/;
my $content = <$fh>;
say $content;

由于$/是全局变量,上述写法可能会造成一些干扰,我们可以采用如下写法

1
2
3
4
5
6
7
use strict;
use warnings;
use Modern::Perl;

open my $fh, '<', 'data.txt' or die;
my $content = do { local $/; <$fh>; };
say $content;

或者下面这种写法。该写法稍具迷惑性,由于localization优先于文件读取,local $/ = <$fh>;这个语句的顺序是:

  1. localization $/
  2. 读取文件内容,由于此时$/undef,因此会读取全部内容
  3. 将文件内容赋值给$/
1
2
3
4
5
6
7
use strict;
use warnings;
use Modern::Perl;

open my $fh, '<', 'data.txt' or die;
my $content = do { local $/ = <$fh>; };
say $content;

12.2 写文件

  1. $out_fh和要输出的内容之间没有逗号
  2. 若指定的文件描述符是个复杂的表达式,要用{}来消除歧义,否则解释器会把$config当成文件描述符
  3. print不带换行符,say会带换行符
1
2
3
4
5
6
7
8
9
10
11
use strict;
use warnings;
use Modern::Perl;

open my $out_fh, '>', 'output_file.txt';
print $out_fh "Here's a line of text\n";
say $out_fh "... and here's another";
my $config = { output => $out_fh };
say { $config->{output} } "... and here's another2";

close $out_fh;

默认情况下,Perl会将内容先缓存起来,直到超过缓存大小时,才会将其真正写入到磁盘。我们可以通过修改$|来实现实时刷新,或者直接调用autoflush方法

1
2
3
4
5
6
7
use strict;
use warnings;
use Modern::Perl;
use FileHandle;

open my $fh, '>', 'pecan.log';
$fh->autoflush(1);

12.3 目录

  1. opendir函数用于获取指定目录的句柄
  2. readdir函数用于读取目录下的文件或者子目录
  3. closedir函数用于关闭目录句柄
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
use strict;
use warnings;
use Modern::Perl;

# iteration
opendir my $dirh, '.';
while ( my $file = readdir $dirh ) {
say "filename: $file";
}
closedir $dirh;

# flattening into a list
opendir my $otherdirh, '.';
my @files = readdir $otherdirh;
say "files: @files";
closedir $otherdirh;

12.4 文件运算符

  1. -e:判断文件或目录是否存在
  2. -f:判断是否为文件
  3. -d:判断是否为目录
  4. -r:判断当前用户对该文件是否有读权限
  5. -w:判断当前用户对该文件是否有写权限
  6. -z:判断是否为空文件
1
2
3
4
5
6
use strict;
use warnings;
use Modern::Perl;

my $filename = "notexist";
say 'Present!' if -e $filename;

12.5 其他文件操作

  1. rename:用于重命名
  2. chdir:用于切换当前工作目录
  3. File::Copy:文件拷贝和移动

13 进程管理

13.1 操作符:`

shell一样,我们可以在`<command>`中执行命令,并获取结果

1
2
3
4
5
6
7
8
9
use strict;
use warnings;
use Modern::Perl;

my @items = `ls -al`;

for (@items) {
print;
}

13.2 system

你也可以使用system函数执行Unix命令, 执行该命令将直接输出结果。默认情况下会送到目前PerlSTDOUT指向的地方,一般是屏幕。你也可以使用重定向运算符>输出到指定文件

1
2
3
4
5
use strict;
use warnings;
use Modern::Perl;

system( "ls", "-al" );

14 常用库

14.1 Data

Data::Dumper提供了将复杂数据类型转换成可读字符串的功能

14.2 Test

Test::More提供了测试相关的能力

  • tests可选参数,用于指定测试的数量
  • ok:断言,布尔上下文
  • is:断言,标量上下文,用eq判断两个参数是否相同
  • isnt:断言,与is含义相反
  • cmp_ok:断言,用于指定操作符来判断两个参数是否相同
  • isa_ok:断言,类型判断
  • can_ok:断言,判断是否包含指定的方法(或方法列表)
  • is_deeply:断言,比较两个对象的内容是否相同
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
use strict;
use warnings;
use Modern::Perl;
use Test::More tests => 7;

ok( 1, 'the number one should be true' );
ok( !0, '... and the number zero should not' );
ok( !'', 'the empty string should be false' );
ok( '!', '... and a non-empty string should not' );

is( 4, 2 + 2, 'addition should hold steady across the universe' );
isnt( 'pancake', 100, 'pancakes should have a delicious numeric value' );

{
use Clone;
my $numbers = [ 4, 8, 15, 16, 23, 42 ];
my $clonenums = Clone::clone($numbers);
is_deeply( $numbers, $clonenums,
'Clone::clone() should produce identical structures' );
}

done_testing();

14.3 Carp

Carp用于输出告警信息,包括代码上下文等

1
2
3
4
5
6
7
8
9
10
11
12
use strict;
use warnings;
use Modern::Perl;
use Carp;

sub only_two_arguments {
my ( $lop, $rop ) = @_;
Carp::carp('Too many arguments provided') if @_ > 2;
}

my ( $first, $second, $third ) = ( 1, 2, 3 );
only_two_arguments( $first, $second, $third );

14.4 Path

Path::Class提供了跨平台的路径操作方式(不必关系路径分隔符是/还是\诸如此类的问题)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
use strict;
use warnings;
use Modern::Perl;
use Path::Class;

my $dir = dir( 'foo', 'bar' ); # Path::Class::Dir object
my $file = file( 'bob', 'file.txt' ); # Path::Class::File object

say "dir: $dir";
say "file: $file";

my $subdir = $dir->subdir('baz'); # foo/bar/baz
my $parent = $subdir->parent; # foo/bar
my $parent2 = $parent->parent; # foo

say "subdir: $subdir";
say "parent: $parent";
say "parent2: $parent2";

14.5 Cwd

Cwd主要用于计算真实路径,例如/tmp/././a就返回/tmp/a。详细用法参考perldoc Cwd

1
2
3
4
5
6
use strict;
use warnings;
use Modern::Perl;
use Cwd;

say "abs path of '/tmp/a/b/..':", Cwd::abs_path("/tmp/a/b/..");

14.6 File

详细用法参考perldoc File::Specperldoc File::Basename

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
use strict;
use warnings;
use Modern::Perl;
use File::Spec;
use File::Basename;

my $path = File::Spec->rel2abs(__FILE__);
my ( $vol, $dir, $file ) = File::Spec->splitpath($path);

say "path: $path";
say "vol: $vol";
say "dir: $dir";
say "file: $file";

my $rel_dir = dirname(__FILE__);
say "rel_dir: $rel_dir";

14.7 Time

Perl提供了localtime函数用于获取时间信息

1
2
3
4
5
6
7
8
9
10
use strict;
use warnings;
use Modern::Perl;

my @months = qw( 一月 二月 三月 四月 五月 六月 七月 八月 九月 十月 十一月 十二月 );
my @days = qw(星期天 星期一 星期二 星期三 星期四 星期五 星期六);

my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
localtime();
say "$mday $months[$mon] $days[$wday]";

如果只想获取年份的话可以使用Time模块,详细请参考perldoc Time::Piece

1
2
3
4
5
6
7
8
9
10
11
12
use strict;
use warnings;
use Modern::Perl;
use Time::Piece;

my $now = Time::Piece->new();
say "year:", $now->year;
say "mon:", $now->month;
say "day_of_month:", $now->day_of_month;
say "hour:", $now->hour;
say "minute:", $now->minute;
say "second:", $now->second;

14.8 Perl-Tidy

Perl-Tidy是代码格式化工具

15 高级特性

15.1 属性

具名实体,包括变量以及函数都可以拥有属性,语法如下

1
2
my $fortress :hidden;
sub erupt_volcano :ScienceProject { ... }

上述定义会触发名为hidden以及ScienceProject的属性处理过程( Attribute Handlers)。如果对应的Handler不存在,则会报错

属性可以包含一系列参数,Perl会将其视为一组常量字符串

大部分时候,你不需要使用属性

16 Builtin

参考perlfunc。此外可以通过perldoc perlfunc查看

  1. say:将给定字符串(默认为$_)输出到当前select的文件句柄中
  2. chomp:删除给定字符串(默认为$_)中尾部的换行符
  3. defined:判断给定变量是否已定义(是否赋值过)
  4. use:引入包
  5. our:为package变量创建别名
  6. my:声明局部变量
  7. state:声明静态变量
  8. map:映射
  9. grep:过滤
  10. sort:排序
  11. scalar:显式声明标量上下文

17 进阶

modern-perl.pdf

语言设计哲学:

  1. TIMTOWTDI:There’s more than one way to do it!

工具:

  1. perldoc
    • perldoc perltoc:文档内容表
    • perldoc perlsyn:语法
    • perldoc perlop:运算符
    • perldoc perlfuncbuiltin函数
      • perldoc -f wantarray
    • perldoc perlsub:函数
    • perldoc perlretut:正则表达式教程
    • perldoc perlre:正则表达式详细文档
    • perldoc perlreref:正则表达式指导
    • perldoc perlmod
    • perldoc perlvar:预定义的全局变量
    • perldoc List::Util
    • perldoc Moose::Manual
    • perldoc -D <keyword>:搜索包含关键字的文档
    • perldoc -v <variable>
      • perldoc -v $/
  2. cpan
    • cpan Modern::Perl
    • cpan Moose
  3. perlbrew

站点:

一些概念:

  • Bareword:A bareword is an identifier without a sigil or other attached disambiguation as to its intended syntactical function.
  • prototype:A prototype is a piece of optional metadata attached to a function declaration

TODO:

  1. map
  2. To count the number of elements returned from an expression in list context without using a temporary variable, you use the idiom - P21
  3. You do not need parentheses to create lists; the comma operator creates lists - P22
  4. Lists and arrays are not interchangeable in Perl. Lists are values and arrays are containers. - P22
  5. If you must use $_ rather than a named variable, make the topic variable lexical with my $_: - P29
  6. Given/When - P33
  7. Scalars may be lexical, package, or global (see Global Variables, page 153) variables. - P35
  8. Reset a hash’s iterator with the use of keys or values in void context - P43
  9. if your cached value evaluates to false in a boolean context, use the defined-or assignment operator (//=) instead - P46
  10. Filehandle References - P54
  11. Dualvars - P48
  12. Aliasing - P66
  13. use Carp 'cluck'; - P70
  14. AUTOLOAD - P85
  15. Named Captures - P94
  16. abc|def(abc|def)的差异
  17. use autodie; - P167

18 Best Practice

18.1 文本处理-1

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
use warnings;
use strict;
use Modern::Perl;
use List::Util qw(min max sum);
use Data::Dumper;

my $fileName = shift or die "missing 'fileName'";
my $indexName = shift or die "missing 'indexName'";

open my $fh, "< $fileName" or die "$!";
my $indexNamePat0 = qr/\b$indexName\b/;
my $indexNamePat1 = qr/\b$indexName\b\s*:\s*(\d+(?:\.\d+)?)(ns|us|ms)/;
my $indexNamePat2 = qr/\b$indexName\b\s*:\s*(\d+)s(\d+)ms/;

sub norm_time1($$) {
my ( $n, $u ) = @_;
if ( $u eq "ns" ) {
return $n / 1000000000.0;
} elsif ( $u eq "us" ) {
return $n / 1000000.0;
} elsif ( $u eq "ms" ) {
return $n;
} else {
return $n * 1000.0;
}
}

sub norm_time2($$) {
my ( $sec, $ms ) = @_;
return $sec * 1000.0 + $ms;
}

my @lines0 = map { chomp; $_ } <$fh>;
my @lines = grep { /$indexNamePat0/ }
map { $_ . ":" . $lines0[ $_ - 1 ] } 1 .. scalar(@lines0);
my @norm_lines1 = map { /$indexNamePat1/; [ norm_time1( $1, $2 ), $_ ] }
grep { /$indexNamePat1/ } @lines;
my @norm_lines2 = map { /$indexNamePat2/; [ norm_time2( $1, $2 ), $_ ] }
grep { /$indexNamePat2/ } @lines;
my @norm_lines = ( @norm_lines1, @norm_lines2 );
my @sorted_lines = sort { $a->[0] <=> $b->[0] } @norm_lines;
for my $line (@sorted_lines) {
printf "cost=%d, %s\n", $line->[0], $line->[1];
}

18.2 文本处理-2

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
use warnings;
use strict;
use Modern::Perl;

my $fileName = shift or die "missing 'fileName'";

open my $fh, "< $fileName" or die "$!";

my @items =
sort { $a->[1] <=> $b->[1] || $a->[2] <=> $b->[2] || $a->[0] cmp $b->[0] }
map {
[ split( '/', $_->[0] ), $_->[1] ]
} # [walk_through_sort, 1000000, 1000000, 72202569]
map {
[ split( ' ', $_ ) ]
} # [walk_through_sort/1000000/1000000, 72202569, ns, 72199515, ns, 10]
<$fh>;

for ( 0 .. $#items / 2 ) {
my $map_item = $items[$_];
my $sort_item = $items[ $_ + 1 ];

my $factor = $map_item->[2] / $map_item->[1];
my $ratio = sprintf( "%.3f", $map_item->[3] / $sort_item->[3] );
say "map/sort/$map_item->[1]/$map_item->[2]/$factor = $ratio;";
}

待处理的文本如下:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
walk_through_map/100000/100000           8636963 ns      8636513 ns           81
walk_through_map/100000/50000 6366875 ns 6366535 ns 109
walk_through_map/100000/10000 1673647 ns 1673538 ns 419
walk_through_map/100000/5000 1250455 ns 1250342 ns 558
walk_through_map/100000/1000 923048 ns 922904 ns 758
walk_through_map/100000/500 882537 ns 882477 ns 792
walk_through_map/100000/100 853013 ns 852950 ns 820
walk_through_map/1000000/1000000 143390781 ns 143372481 ns 5
walk_through_map/1000000/500000 103008123 ns 102991327 ns 7
walk_through_map/1000000/100000 29208765 ns 29205713 ns 24
walk_through_map/1000000/50000 20150060 ns 20148346 ns 35
walk_through_map/1000000/10000 9287158 ns 9286203 ns 75
walk_through_map/1000000/5000 8815741 ns 8814831 ns 79
walk_through_map/1000000/1000 8375886 ns 8375070 ns 84
walk_through_map/10000000/10000000 4002424030 ns 4001833235 ns 1
walk_through_map/10000000/5000000 2693123212 ns 2692943252 ns 1
walk_through_map/10000000/1000000 1076483581 ns 1076438325 ns 1
walk_through_map/10000000/500000 630116707 ns 630089794 ns 1
walk_through_map/10000000/100000 193023047 ns 192987351 ns 4
walk_through_map/10000000/50000 157515867 ns 157498497 ns 4
walk_through_map/10000000/10000 85139131 ns 85128214 ns 8
walk_through_map/100000000/100000000 5.1183e+10 ns 5.1175e+10 ns 1
walk_through_map/100000000/50000000 3.9879e+10 ns 3.9871e+10 ns 1
walk_through_map/100000000/10000000 2.9220e+10 ns 2.9218e+10 ns 1
walk_through_map/100000000/5000000 2.5468e+10 ns 2.5467e+10 ns 1
walk_through_map/100000000/1000000 1.7363e+10 ns 1.7362e+10 ns 1
walk_through_map/100000000/500000 1.3896e+10 ns 1.3894e+10 ns 1
walk_through_map/100000000/100000 1921860931 ns 1921779584 ns 1
walk_through_sort/100000/100000 6057105 ns 6056490 ns 118
walk_through_sort/100000/50000 6036402 ns 6035855 ns 116
walk_through_sort/100000/10000 5569400 ns 5569251 ns 125
walk_through_sort/100000/5000 5246500 ns 5246360 ns 133
walk_through_sort/100000/1000 4401430 ns 4401309 ns 158
walk_through_sort/100000/500 4070692 ns 4070582 ns 171
walk_through_sort/100000/100 3353855 ns 3353763 ns 211
walk_through_sort/1000000/1000000 72202569 ns 72199515 ns 10
walk_through_sort/1000000/500000 72882608 ns 72880609 ns 10
walk_through_sort/1000000/100000 67659113 ns 67654984 ns 10
walk_through_sort/1000000/50000 63923624 ns 63920953 ns 11
walk_through_sort/1000000/10000 55889055 ns 55886778 ns 12
walk_through_sort/1000000/5000 53487160 ns 53485651 ns 13
walk_through_sort/1000000/1000 45948298 ns 45946604 ns 15
walk_through_sort/10000000/10000000 850539566 ns 850505737 ns 1
walk_through_sort/10000000/5000000 842845660 ns 842812567 ns 1
walk_through_sort/10000000/1000000 806016938 ns 805984295 ns 1
walk_through_sort/10000000/500000 769532280 ns 769496042 ns 1
walk_through_sort/10000000/100000 688427730 ns 688391316 ns 1
walk_through_sort/10000000/50000 656184024 ns 656154090 ns 1
walk_through_sort/10000000/10000 580176790 ns 580159655 ns 1
walk_through_sort/100000000/100000000 1.0196e+10 ns 1.0195e+10 ns 1
walk_through_sort/100000000/50000000 9803249176 ns 9802624677 ns 1
walk_through_sort/100000000/10000000 9383023476 ns 9382273047 ns 1
walk_through_sort/100000000/5000000 9016790984 ns 9015835565 ns 1
walk_through_sort/100000000/1000000 8154018906 ns 8153267525 ns 1
walk_through_sort/100000000/500000 7797706457 ns 7796576221 ns 1
walk_through_sort/100000000/100000 7080835898 ns 7079696031 ns 1

输出:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
map/sort(100000/100/0.001) = 0.254
map/sort(100000/500/0.005) = 0.217
map/sort(100000/1000/0.01) = 0.210
map/sort(100000/5000/0.05) = 0.238
map/sort(100000/10000/0.1) = 0.301
map/sort(100000/50000/0.5) = 1.055
map/sort(100000/100000/1) = 1.426
map/sort(1000000/1000/0.001) = 0.182
map/sort(1000000/5000/0.005) = 0.165
map/sort(1000000/10000/0.01) = 0.166
map/sort(1000000/50000/0.05) = 0.315
map/sort(1000000/100000/0.1) = 0.432
map/sort(1000000/500000/0.5) = 1.413
map/sort(1000000/1000000/1) = 1.986
map/sort(10000000/10000/0.001) = 0.147
map/sort(10000000/50000/0.005) = 0.240
map/sort(10000000/100000/0.01) = 0.280
map/sort(10000000/500000/0.05) = 0.819
map/sort(10000000/1000000/0.1) = 1.336
map/sort(10000000/5000000/0.5) = 3.195
map/sort(10000000/10000000/1) = 4.706
map/sort(100000000/100000/0.001) = 0.271
map/sort(100000000/500000/0.005) = 1.782
map/sort(100000000/1000000/0.01) = 2.129
map/sort(100000000/5000000/0.05) = 2.825
map/sort(100000000/10000000/0.1) = 3.114
map/sort(100000000/50000000/0.5) = 4.068
map/sort(100000000/100000000/1) = 5.020

19 参考