Perl编程实战：数组、哈希与子程序应用

table {
border-collapse: collapse;
width: 100%;
margin-bottom: 1rem;
}
th, td {
border: 1px solid #ddd;
padding: 8px;
text-align: left;
}
th {
background-color: #f2f2f2;
}
tr:nth-child(even) {
background-color: #f9f9f9;
}
pre {
background-color: #f8f8f8;
padding: 15px;
border-radius: 4px;
overflow-x: auto;
}

1、创建一个包含值Andrew、Andy和Kaufman的数组，并编写一个程序来打印Andrew “Andy” Kaufman。

以下是实现该功能的Perl代码：

use strict;
use warnings;
my @array = ('Andrew', 'Andy', 'Kaufman');
print $array[0], ' “', $array[1], '” ', $array[2], "
";

上述代码首先创建了一个包含指定值的数组，然后通过数组索引获取元素并按要求的格式打印输出。

2、创建一个哈希表，键为水果名称，值为它们的常见颜色，然后将每个键值对作为单独的一行打印出来，格式类似“香蕉是黄色的”。

以下是实现该功能的代码：

use strict;
use warnings;
use diagnostics;

my %color_for = ( 
    bananas => 'yellow', 
    apples => 'red', 
    oranges => 'orange',
);

for my $fruit (keys %color_for) { 
    my $color = $color_for{$fruit};
    print "$fruit are $color
";
}

3、根据包含值 (0, 32, 65, 80, 212) 的 @fahrenheit 数组创建 @celsius 数组。

要创建

@celsius

数组，需要将

@fahrenheit

数组中的每个华氏温度值转换为摄氏温度值。转换公式是先减去 32，然后乘以 5/9。以下是对应的代码：

my @fahrenheit = ( 0, 32, 65, 80, 212 );
my @celsius = map { ( $_ - 32 ) * 5 / 9 } @fahrenheit;

4、从包含值 qw(AAA bbb Ccc ddD EEE) 的 @ids 数组创建 @upper 数组，要求 @upper 数组中的元素为 @ids 数组对应元素的大写形式。

可以使用循环遍历

@ids

数组，将每个元素转换为大写后存入

@upper

数组，示例代码如下：

my @ids = qw(AAA bbb Ccc ddD EEE);
my @upper;

foreach my $element (@ids) {
    push @upper, uc($element);
}

以上代码通过

uc

函数将每个元素转换为大写后添加到

@upper

数组中。

5、分析给定代码中$answer1、$answer2和$answer3的值，并解释自增运算符的作用。

由于没有给出具体代码，无法准确得知计算过程，但能按常规逻辑分析。

$answer1

的值为28，因为乘法运算符的优先级高于加法。

$answer2

初始值为6，因为减法是左结合的，但在第三行自增后，其值变为7。

$answer3

的值为4，因为在

$answer2

自增前，它会先从10中减去

$answer2

的值；若自增运算符在

$answer2

之前（

10 - ++$answer2

），

$answer3

的值将为3。

自增运算符用于将变量的值增加1，将其放在单独的语句中，代码通常更易理解。

6、在Perl中，将数字1到10逐行打印出来。

在 Perl 里，可使用如下代码把数字 1 到 10 逐行打印：

for (1..10) {
    print $_ . "
";
}

7、计算数组@numbers（值为qw< 3 9 0 7 8 >）中数字的平均值，并打印出这些数字和平均值。

可以使用以下代码实现：

my @numbers = qw< 3 9 0 7 8 >;
my $total = 0;
$total += $_ foreach @numbers;
my $average = $total / @numbers;
print "The numbers are: @numbers
";
print "The average is $average
";

8、找出并修复给定代码中 C 风格 for 循环终止条件的逻辑错误。

逻辑错误在于循环终止条件为

$i <= $num_elements

，这会导致最终的

$i

值比

@array

中的最终索引大 1，即出现“差一错误”。这是 C 风格 for 循环常见的问题。将循环条件改为

$i < $num_elements

可解决该问题。

9、添加代码为 %stat_for 哈希中的键分配随机值。

以下代码可以为

%stat_for

哈希中的键分配随机值：

my %stat_for;
my @stats = ('strength', 'intelligence', 'dexterity');

foreach my $stat (@stats) {
    my $random = 2 + int(rand(6)) + int(rand(6));
    redo if $random < 6;
    $stat_for{$stat} = $random;
}

print <<"END_CHARACTER";
Strength: $stat_for{strength}
Intelligence: $stat_for{intelligence}
Dexterity: $stat_for{dexterity}
END_CHARACTER

这段代码首先定义了一个空的

%stat_for

哈希和一个包含键名的数组

@stats

，然后遍历该数组，为每个键生成一个 2 到 12 之间的随机数，并将其赋值给

%stat_for

哈希中对应的键，最后打印出每个键及其对应的值。

10、编写完整代码，为 %stat_for 哈希中的键分配大于或等于 6 的随机值，并打印结果。

use strict;
use warnings;

my %stat_for;
my @stats = ('strength', 'intelligence', 'dexterity');

foreach my $stat (@stats) {
    my $random;
    do {
        $random = 2 + int(rand(6)) + int(rand(6));
    } while ($random < 6);
    $stat_for{$stat} = $random;
}

print <<"END_CHARACTER";
Strength: $stat_for{strength}
Intelligence: $stat_for{intelligence}
Dexterity: $stat_for{dexterity}
END_CHARACTER

11、创建一个数组 @first，其值为 1 到 5，然后创建一个数组 @second，使其具有与 @first 相同的值。

在 Perl 中可以这样实现：

my @first = (1, 2, 3, 4, 5);
my @second = @first;

12、从给定的 $sales 哈希中计算 Jim 在周五的销售数量和销售总额，假设 $sales 哈希的结构为 $sales->{星期几}->{人名} 存储着该人在对应星期几的销售金额列表。

Jim 在周五的销售数量和销售总额可通过以下代码计算得出：

my $friday = $sales->{friday}{jim};
my $num_sales = @$friday;
my $total = 0;
$total += $_ foreach @$friday;

其中

$num_sales

为销售数量，

$total

为销售总额。

13、用两种不同的方式从$score_for哈希中提取Jim和Mary的分数。

第一种方式：

```perl
my ( $jim, $mary ) = @$score_for{ qw{jim mary} };

第二种方式：

$jim = $score_for->{jim};
$mary = $score_for->{mary};

14、编写一个名为 average 的子程序，计算传递给它的数字的平均值，并打印数字 (1, 5, 18, 3, 5) 的平均值。

以下是实现该功能的 Perl 代码：

sub average {
    my $sum = 0;
    my $count = scalar @_;
    foreach my $num (@_) {
        $sum += $num;
    }
    return $sum / $count;
}

print average(1, 5, 18, 3, 5);

上述代码定义了一个名为

average

的子程序，它接收一系列数字作为参数，计算这些数字的总和并除以数字的数量得到平均值，最后打印出数字 (1, 5, 18, 3, 5) 的平均值。

15、修改 average 子例程，检查输入是否为数字，并适当地处理非数字输入，然后打印将 (1, 5, 18, bob, 3, 5) 传递给它的结果。

以下是修改后的

average

子例程及打印结果的代码：

use Scalar::Util 'looks_like_number';
use Carp 'croak';

sub average {
    my @numbers = @_;
    my $total = 0;
    foreach my $number (@numbers) {
        if ( not looks_like_number($number) ) {
            croak "$number doesn't look like a number";
        } else {
            $total += $number;
        }
    }
    return $total / @numbers;
}

print average(qw< 1 5 18 bob 3 5>);

当执行此代码时，由于输入中包含非数字

'bob'

，程序会抛出错误并终止，错误信息为：

bob doesn't look like a number

16、编写一个递归子例程sum，用于计算传递给它的数字之和，并打印(1, 93, 3, 5)的和。

以下是实现该功能的Perl代码：

sub sum {
    my @numbers = @_;
    return 0 if scalar(@numbers) == 0;
    my $first = shift @numbers;
    return $first + sum(@numbers);
}

print sum(1, 93, 3, 5);

上述代码定义了一个递归子例程

sum

来计算传入数字的总和，并打印出

(1, 93, 3, 5)

的和。

17、使用正则表达式从给定文本中提取用户名及其对应的五位数编号。

可以使用以下代码来实现：

use strict;
use warnings;
use Data::Dumper;

my $employee_numbers = <<'END_EMPLOYEES';
alice: 48472
bob:34582
# we need to fire charlie
charlie : 45824
# denise is a new hire
denise : 34553
END_EMPLOYEES

my %employee_number_for;
while ( $employee_numbers =~ /^ s* (w+) s* : s* (d{5}) s* $/gmx ) {
    $employee_number_for{$1} = $2;
}

print Dumper \%employee_number_for;

运行上述代码可以得到一个包含用户名及其对应五位数编号的哈希表。

18、从标准输入读取输入，跳过仅含空白字符的行和注释行，并打印其余行。

可以通过以下步骤实现：

从标准输入读取行；

检查行是否仅含空白字符或为注释行，若是则跳过；

打印其余行。

在 Perl 中示例代码如下：

use strict;
use warnings;

while (my $line = <STDIN>) {
    next if $line =~ /^s*$/; # 跳过仅含空白字符的行
    next if $line =~ /^s*#/; # 跳过注释行
    print $line;
}

19、将作为命令行参数传递的单词拆分为字符，获取每个字符的 Unicode 码点并打印出来。同时，将输出格式改为 U+XXXX。

可以使用以下代码实现该功能：

use strict;
use warnings;
use utf8::all;
foreach my $word (@ARGV) {
    my @chars = split //, $word;
    foreach my $char (@chars) {
        $char = "U+" . uc sprintf "%04x", ord $char;
        print "$char ";
    }
    print "
";
}

上述代码中，首先遍历命令行参数中的每个单词，将其拆分为字符。然后，对于每个字符，获取其 Unicode 码点，并将其转换为

U+XXXX

的格式。最后，打印出每个字符的 Unicode 码点，并在每个单词的码点列表后换行。

20、对十六进制数字数组进行降序排序，并以十进制和十六进制格式打印结果。

以下是实现该功能的代码示例：

my @numbers = ( 0x23, 0xAA, 0xaa, 0x01, 0xfB );
# 降序排序
my @sorted = sort { $b <=> $a } @numbers;
# 打印十进制结果
print join ', ', @sorted; print "
";
# 打印十六进制结果
print join ', ', map { sprintf "0x%X", $_ } @sorted; print "
";

运行上述代码，输出为：

251, 170, 170, 35, 1
0xFB, 0xAA, 0xAA, 0x23, 0x1

21、从数组中移除重复元素，同时保持每个元素首次出现的顺序。

可以使用哈希表和循环来实现。示例代码如下：

my %seen;
my @ordered;
foreach my $element (@array) {
    if (not $seen{$element}++) {
        push @ordered, $element;
    }
}

其中，

@array

是原始数组，

@ordered

是移除重复元素后且保持顺序的数组。

22、更新MANIFEST文件，以包含用于分发的Convert::Distance::Metric模块。

应在

MANIFEST

文件中添加以下内容：

lib/Convert/Distance/Metric.pm

确保

MANIFEST

文件内容如下：

Changes
lib/Convert/Distance/Imperial.pm
lib/Convert/Distance/Metric.pm
Makefile.PL
MANIFEST
README
t/00-load.t
t/manifest.t
t/pod-coverage.t
t/pod.t

23、编写一个程序来测试 Convert::Distance::Metric 模块中的公里到米和米到公里的转换函数。

以下为测试程序示例，可使用该模块将 3.5 公里转换为米，再将结果转换回公里，并输出转换结果：

use Convert::Distance::Metric qw(:all);
my $kilometers = 3.5;
my $meters = kilometers_to_meters($kilometers);
print "There are $meters meters in $kilometers kilometers
";
$kilometers = meters_to_kilometers($meters);
print "There are $kilometers kilometers in $meters meters
";

运行程序后，输出结果如下：

There are 3500 meters in 3.5 kilometers
There are 3.5 kilometers in 3500 meters

24、编写一个 Person 类，包含 name、birthdate 属性和一个用于计算人年龄的 age 方法。

以下是实现该需求的 Person 类代码：

package Person;
use strict;
use warnings;
use DateTime;
use Carp 'croak';

sub new {
    my ( $class, $args ) = @_;
    my $self = bless {} => $class;
    $self->_initialize($args);
    return $self;
}

sub _initialize {
    my ( $self, $args ) = @_;
    my %args = %$args;
    my $name = delete $args{name};
    my $birthdate = delete $args{birthdate};

    # must have at least one non - whitespace character
    unless ( $name && $name =~ /S/ ) {
        croak "Person name must be supplied";
    }

    # trap the error if it’s not an object
    unless ( eval { $birthdate->isa('DateTime') } ) {
        croak "Person birthdate must be a DateTime object";
    }

    $self->{name} = $name;
    $self->{birthdate} = $birthdate;
}

sub name {
    $_[0]->{name}
}

sub birthdate {
    $_[0]->{birthdate}
}

sub age {
    my $self = shift;
    my $duration = DateTime->now - $self->birthdate;
    return $duration->years;
}

1;

25、识别并修复与 bless 函数相关的类的 new() 构造函数中的问题。

问题在于使用单参数

bless

时未指定要将引用祝福到的类，这会使 Perl 将对象祝福到当前包，不利于后续继承。修复方法是在

bless

函数中明确指定类名。

例如，将有问题的代码：

sub new {
    my ( $class, $arg_for ) = @_;
    return bless {
        name  => $arg_for->{name},
        budget => $arg_for->{budget}
    }; # 假设当前包，不良形式
}

修复为：

sub new {
    my ( $class, $arg_for ) = @_;
    return bless {
        name  => $arg_for->{name},
        budget => $arg_for->{budget}
    }, $class;
}

26、编写一个从 Person 类继承的 Customer 类，并检查客户是否年满 18 岁。

以下是实现该功能的

Customer

类代码：

package Customer;
use Moose;
extends 'Person';
use Carp 'croak';
use namespace::autoclean;

sub BUILD {
    my $self = shift;
    if ( $self->age < 18 ) {
        my $age = $self->age;
        croak("Customers must be 18 years old or older, not $age");
    }
}

__PACKAGE__->meta->make_immutable;
1;

27、使用 Moose 编写一个 User 类，包含用户名和密码属性，对密码进行哈希处理，并提供一个方法来检查密码。

以下是使用 Moose 编写的

User

类：

package User;
use Moose;
use Digest::MD5 'md5_hex';
use namespace::autoclean;

has username => (
    is       => 'ro',
    isa      => 'Str',
    required => 1
);

has password => (
    is      => 'ro',
    isa     => 'Str',
    writer  => '_set_password'
);

sub BUILD {
    my $self = shift;
    $self->_set_password(md5_hex($self->password));
}

sub password_eq {
    my ( $self, $password ) = @_;
    $password = md5_hex($password);
    return $password eq $self->password;
}

__PACKAGE__->meta->make_immutable;
1;

你可以使用以下代码测试上述类：

my $user = User->new(
    username => 'Ovid',
    password => 'Corinna',
);

print $user->dump;
print "Yes" if $user->password_eq('Corinna');