32、Perl 编程练习解答与实践指南

元编程奶

于 2025-12-03 09:27:26 发布

阅读量2

点赞数

CC 4.0 BY-SA版权

分类专栏：深入Perl：从模块到对象文章标签： Perl Animal包 MyDate模块

本文链接：https://blog.youkuaiyun.com/b9c0d/article/details/155569866

深入Perl：从模块到对象专栏收录该内容

33 篇文章 ¥499.90

订阅专栏¥69.90

会员秒杀 ¥9.9 重磅福利

超级会员免费看

Perl 编程练习解答与实践指南

1. 前期准备与测试覆盖

在开始编程前，我们可以进行测试覆盖相关操作，步骤如下：
1. 执行 ./Build testcover 命令。
2. 执行 cover 命令。
3. 打开 cover_db/coverage.html 文件查看测试覆盖情况。

虽然前期准备工作看似繁琐，但能为后续节省大量时间。

2. 第 15 章练习解答

2.1 创建 Animal 包

我们先创建 Animal 包，代码如下：

package Animal;
use Carp qw(croak);
sub named {
  ref(my $class = shift) and croak "class name needed";
  my $name = shift;
  my $self = { Name => $name, Color => $class->default_color };
  bless $self, $class;
}
## backstops (should be overridden)
sub default_color { "brown" }
sub sound { croak "subclass must define a sound" }

上述代码中， named 方法用于创建对象， default_color 方法设置默认颜色， sound 方法要求子类必须定义具体声音。

2.2 定义通用方法

接着定义适用于类或实例的方法：

sub speak {
  my $either = shift;
  print $either->name, " goes ", $either->sound, "\n";
}
sub name {
  my $either = shift;
  ref $either
    ? $either->{Name}
    : "an unnamed $either";
}
sub color {
  my $either = shift;
  ref $either
    ? $either->{Color}
    : $either->default_color;
}

这些方法分别用于输出对象发声、获取对象名称和颜色。

2.3 定义实例方法

最后定义仅适用于特定实例的方法：

sub set_name {
  ref(my $self = shift) or croak "instance variable needed";
  $self->{Name} = shift;
}
sub set_color {
  ref(my $self = shift) or croak "instance variable needed";
  $self->{Color} = shift;
}

这些方法用于设置对象的名称和颜色。

2.4 测试代码

我们创建 scripts/mr_ed.pl 脚本来测试上述更改：

my $tv_horse = Horse->named("Mr. Ed");
$tv_horse->set_name("Mister Ed");
$tv_horse->set_color("grey");
print $tv_horse->name, " is ", $tv_horse->color, "\n";
print Sheep->name, " colored ", Sheep->color, " goes ", Sheep->sound, "\n";

3. 第 16 章练习解答

3.1 实现 MyDate 包

我们在脚本同一文件中创建 MyDate 包，代码如下：

{
  package MyDate;
  use vars qw($AUTOLOAD);
  use Carp;
  my %Allowed_methods = qw( date 3 month 4 year 5 );
  my @Offsets         = qw(0 0 0 0 1 1900 0 0 0);
  sub new      { bless {}, $_[0] }
  sub DESTROY  {}
  sub AUTOLOAD {
    my $method = $AUTOLOAD;
    $method =~ s/.*:://;
    unless( exists $Allowed_methods{ $method } ) {
      carp "Unknown method: $AUTOLOAD";
      return;
    }
    my $slice_index = $Allowed_methods{ $method };
    return (localtime)[$slice_index] + $Offsets[$slice_index];
    }
  }
MyDate->import;  # we don't use it
my $date = MyDate->new();
print "The date is "  . $date->date  . "\n";
print "The month is " . $date->month . "\n";
print "The year is "  . $date->year  . "\n";

这里使用 AUTOLOAD 方法处理特定方法调用，通过 %Allowed_methods 存储允许的方法名及其在 localtime 列表中的偏移量。

3.2 新增 UNIVERSAL::debug 方法

在上述基础上，新增 UNIVERSAL::debug 方法：

use MyDate;
my $date = MyDate->new();
sub UNIVERSAL::debug {
  my $self = shift;
  my $when = localtime;
  my $message = join '|', @_;
  print "[$when] $message\n";
}
print "The date is "  . $date->date  . "\n";
print "The month is " . $date->month . "\n";
print "The year is "  . $date->year  . "\n";
$date->debug( "I'm all done" );

由于 Perl 在查找 AUTOLOAD 方法前会先搜索 @ISA 和 UNIVERSAL ，所以 debug 方法不会触发 AUTOLOAD 报错。

4. 第 17 章练习解答

4.1 实现 Oogaboogoo::Date 模块

Oogaboogoo::Date 模块代码如下：

package Oogaboogoo::Date;
use strict;
use Exporter qw(import);
our @EXPORT = qw(day mon);
my @day = qw(ark dip wap sen pop sep kir);
my @mon = qw(diz pod bod rod sip wax lin sen kun fiz nap dep);
sub day {
  my $num = shift @_;
  die "$num is not a valid day number"
    unless $num >= 0 and $num <= 6;
  $day[$num];
}
sub mon {
  my $num = shift @_;
  die "$num is not a valid month number"
    unless $num >= 0 and $num <= 11;
  $mon[$num];
}
1;

该模块提供 day 和 mon 方法，根据输入数字返回对应的日期和月份名称。

4.2 使用 Oogaboogoo::Date 模块

使用该模块的程序如下：

use strict;
use Oogaboogoo::Date qw(day mon);
my($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime;
my $day_name = day($wday);
my $mon_name = mon($mon);
$year += 1900;
print "Today is $day_name, $mon_name $mday, $year.\n";

4.3 添加 export tag “all”

为模块添加 export tag “all” ，代码如下：

our @EXPORT = qw(day mon);
our %EXPORT_TAGS = ( all => \@EXPORT );

修改后的程序使用 :all 导入标签：

use strict;
use Oogaboogoo::Date qw(:all);

4.4 导出 My::List::Util 子例程

对 My::List::Util 进行修改，导出 sum 和 shuffle 子例程，代码如下：

use Exporter qw(import);
our @EXPORT = qw(sum shuffle);

测试代码如下：

use Test::More;
BEGIN { use_ok( 'My::List::Util' ) }
ok( defined &sum, 'sum() is exported' );
is( sum( 1, 2, 3 ), 6, '1+2+3 is six' );
is( sum( qw(1 2 3) ), 6, '1+2+3 as strings is six' );
is( sum( 4, −9, 37, 6 ), 38, '4−9+37+6 is six' );
is( sum( 3.14, 2.2 ), 5.34, '3.14 + 2.2 is 5.34' );
is( sum(), undef, 'No arguments returns undef' );
is( sum( qw(a b) ), undef, 'All bad args gives undef' );
is( sum( qw(a b 4 5) ), 9, 'Some good args works' );
done_testing();

5. 第 18 章练习解答

5.1 实现 RaceHorse 类

RaceHorse 类继承自 Horse ，代码如下：

package RaceHorse;
use parent qw(Horse);
dbmopen (our %STANDINGS, "standings", 0666)
  or die "Cannot access standings dbm: $!";
sub named { # class method
  my $self = shift->SUPER::named(@_);
  my $name = $self->name;
  my @standings = split ' ', $STANDINGS{$name} || "0 0 0 0";
  @$self{qw(wins places shows losses)} = @standings;
  $self;
}
sub DESTROY { # instance method, automatically invoked
  my $self = shift;
  $STANDINGS{$self->name} = "@$self{qw(wins places shows losses)}";
  $self->SUPER::DESTROY if $self->can( 'SUPER::DESTROY' );
}
## instance methods:
sub won { shift->{wins}++; }
sub placed { shift->{places}++; }
sub showed { shift->{shows}++; }
sub lost { shift->{losses}++; }
sub standings {
  my $self = shift;
  join ", ", map "$self->{$_} $_", qw(wins places shows losses);
}

该类使用 dbmopen 关联 %STANDINGS 与永久存储，在创建和销毁对象时处理比赛成绩信息。

6. 第 19 章练习解答

6.1 创建模块分布

使用 module-starter 创建模块分布：

% module-starter --module=Animal,Horse,Cow,Sheep,Mouse

6.2 实现 Animal 类

Animal 类代码如下：

package Animal;
use strict;
use warnings;
use Moose;
our $VERSION = '0.01';
has 'name'  => ( is => 'rw' );
has 'color' => ( is => 'rw' );
has 'sound' => ( is => 'ro', default => sub { 'Grrrr!' } );
sub speak {
  my $self = shift;
  print $self->name, " goes ", $self->sound, "\n";
}
__PACKAGE__->meta->make_immutable;
1;

6.3 实现 Horse 类

Horse 类继承自 Animal ，代码如下：

package Horse;
use strict;
use warnings;
use Moose;
use namespace::autoclean;
extends 'Animal';
has 'sound' => ( is => 'ro', default => 'neigh' );
__PACKAGE__->meta->make_immutable;
1;

6.4 测试 Horse 类

测试代码如下：

use Test::More;
use strict;
use warnings;
BEGIN { use_ok( 'Horse' ) }
can_ok( 'Horse', qw(new sound color name speak) );
my $horse = Horse->new( name => 'Mr. Ed' );
isa_ok( $horse, 'Horse' );
is( $horse->name, 'Mr. Ed', 'Got the name right' );
done_testing();

6.5 将 Animal 作为角色实现

将 Animal 作为角色实现，代码如下：

package Animal;
use Moose::Role;
requires qw( sound );
has 'name'  => ( is => 'rw' );
has 'color' => ( is => 'rw' );
sub speak {
  my $self = shift;
  print $self->name, " goes ", $self->sound, "\n";
}
1;

Horse 类使用 with 关键字使用该角色：

package Horse;
use strict;
use warnings;
use Moose;
use namespace::autoclean;
with 'Animal';
sub sound { 'neigh' }
__PACKAGE__->meta->make_immutable;
1;

7. 第 20 章练习解答

7.1 检查文件存在和可读

使用 Test::File 检查文件存在和可读，代码如下：

use Test::More;
use Test::File;
my $unix_file    = '/etc/hosts';
my $windows_file = 'C:\\windows\\system32\\drivers\\etc\\hosts';
SKIP: {
  skip q(We're not on Windows), 1 unless $^O eq 'MSWin32';
  file_exists_ok( $windows_file );
  file_readable_ok( $windows_file );
}
SKIP: {
  skip q(We're not on Unix), 1 unless $^O ne 'MSWin32';
  file_exists_ok( $unix_file );
  file_readable_ok( $unix_file );
}
done_testing();

7.2 实现 sum_ok 子例程

实现 sum_ok 子例程用于测试求和结果，代码如下：

package Test::My::List::Util;
use strict;
use warnings;
use v5.10;
use Exporter qw(import);
use Test::Builder;
my $Test = Test::Builder->new();
our $VERSION = '0.10';
our @EXPORT  = qw(sum_ok);
sub sum_ok {
  my( $got, $expected, $label ) = @_;
  $label //=  "The sum is $expected";
  if( $got eq $expected ) {
    $Test->ok( 1, $label );
  }
  else {
    $Test->diag("The sums do not match. Got $got, expected $expected");
    $Test->ok( 0, $label );
  }
}
1;

使用该模块的测试代码如下：

use Test::More;
BEGIN { use_ok( 'Test::My::List::Util' ) }
BEGIN { use_ok( 'My::List::Util' ) }
ok( defined &sum, 'sum() is exported' );
ok( defined &sum_ok, 'sum_ok() is exported' );
sum_ok( sum( 1, 2, 3 ), 6, '1+2+3 is 6' );
done_testing();

8. 第 21 章练习解答

8.1 创建 PAUSE 账户

前往 https://pause.perl.org/ ，点击 “Request PAUSE account” 链接，填写信息并提交表单，然后等待审核。

8.2 测试并构建 Animal 分布

% ./Build disttest
% ./Build dist

8.3 创建新分布并实现 sum 子例程

创建新分布：

% module-starter --module=Acme::GILLIGAN::Utils
% cd Acme-GILLIGAN-Utils
% ./Build test

在 lib/Acme/GILLIGAN/Utils.pm 中添加 sum 子例程：

=head2 sum( LIST )
Numerically sums the argument list and returns the result.
=cut
sub sum {
  my $sum;
  foreach ( @_ ) { $sum += $_ }
  return $sum;
}

测试代码如下：

use Test::More tests => 4;
use_ok( 'Acme::GILLIGAN::Utils' );
ok( defined &Acme::GILLIGAN::Utils::sum, 'sum() is defined' );
my @good_list = 1 .. 10;
is( Acme::GILLIGAN::Utils::sum( @good_list), 55,
  'The sum of 1 to 10 is 55' );
my @weird_list = qw( a b c 1 2 3 123abc );
is( Acme::GILLIGAN::Utils::sum( @weird_list), 129,
  'The weird sum is 128' );

处理警告信息，可使用 no warnings 'numeric' 忽略警告：

sub sum {
  no warnings 'numeric';
  my $sum;
  foreach ( @_ ) { $sum += $_ }
  return $sum;
}

使用 Test::NoWarnings 确保无警告：

use Test::More tests => 5;
use Test::NoWarnings;
use_ok( 'Acme::GILLIGAN::Utils' );
ok( defined &Acme::GILLIGAN::Utils::sum, 'sum() is defined' );
my @good_list = 1 .. 10;
is( Acme::GILLIGAN::Utils::sum( @good_list), 55,
  'The sum of 1 to 10 is 55' );
my @weird_list = qw( a b c 1 2 3 123abc );
is( Acme::GILLIGAN::Utils::sum( @weird_list), 129,
  'The weird sum is 128' );

最后更新清单并上传到 PAUSE。

以下是部分操作的流程图：

graph TD;
    A[创建 PAUSE 账户] --> B[测试并构建 Animal 分布];
    B --> C[创建新分布];
    C --> D[实现 sum 子例程];
    D --> E[测试代码];
    E --> F[处理警告信息];
    F --> G[更新清单并上传到 PAUSE];

通过以上练习解答，我们可以更深入地理解 Perl 编程中的类、模块、测试等知识点，并掌握相关操作的具体实现方法。

Perl 编程练习解答与实践指南（续）

9. 各章节知识点总结

章节	主要内容	关键代码或操作
15 章	创建 `Animal` 包及相关方法	`package Animal;` 、 `sub named` 、 `sub speak` 等
16 章	实现 `MyDate` 包及 `UNIVERSAL::debug` 方法	`package MyDate;` 、 `sub AUTOLOAD` 、 `sub UNIVERSAL::debug`
17 章	实现 `Oogaboogoo::Date` 模块及导出子例程	`package Oogaboogoo::Date;` 、 `our @EXPORT` 、 `our %EXPORT_TAGS`
18 章	实现 `RaceHorse` 类	`package RaceHorse;` 、 `dbmopen` 、 `sub named` 、 `sub DESTROY`
19 章	创建模块分布，实现 `Animal` 类和 `Horse` 类	`module-starter` 、 `package Animal;` 、 `package Horse;`
20 章	检查文件存在和可读，实现 `sum_ok` 子例程	`use Test::File;` 、 `package Test::My::List::Util;` 、 `sub sum_ok`
21 章	创建 PAUSE 账户，测试并构建分布，实现 `sum` 子例程	`https://pause.perl.org/` 、 `./Build disttest` 、 `./Build dist` 、 `sub sum`

10. 代码复用与优化建议

在前面的练习中，我们实现了多个类和模块，为了提高代码的复用性和可维护性，以下是一些建议：

封装公共方法 ：将一些通用的方法封装到一个独立的模块中，例如在多个模块中都可能用到的文件检查方法，可以封装到一个专门的工具模块中。

package My::Utils;
use strict;
use warnings;
use Test::File;

sub check_file {
    my $file = shift;
    if (-e $file) {
        if (-r $file) {
            return 1;
        } else {
            return 0;
        }
    } else {
        return 0;
    }
}

1;

使用时可以在其他模块中引入该工具模块：

use My::Utils;
my $file = '/path/to/file';
if (My::Utils::check_file($file)) {
    print "文件存在且可读\n";
} else {
    print "文件不存在或不可读\n";
}

使用继承和角色 ：在第 19 章中，我们看到了如何使用继承和角色来实现代码复用。合理使用继承可以让子类继承父类的属性和方法，而角色则可以让类拥有更多的功能。例如，我们可以创建一个 Printable 角色，让需要打印信息的类使用该角色：

package Printable;
use Moose::Role;

sub print_info {
    my $self = shift;
    print "Name: ", $self->name, "\n";
    print "Color: ", $self->color, "\n";
}

1;

package Horse;
use strict;
use warnings;
use Moose;
use namespace::autoclean;
with 'Animal', 'Printable';
sub sound { 'neigh' }
__PACKAGE__->meta->make_immutable;
1;

这样， Horse 类就可以使用 Printable 角色中的 print_info 方法。

11. 测试策略与最佳实践

测试是保证代码质量的重要手段，在前面的练习中，我们使用了多种测试模块，如 Test::More 、 Test::File 、 Test::NoWarnings 等。以下是一些测试策略和最佳实践：

单元测试 ：对每个模块或类的单个方法进行测试，确保其功能的正确性。例如，在测试 My::List::Util 模块的 sum 方法时，我们使用了多个测试用例来覆盖不同的输入情况：

use Test::More;
BEGIN { use_ok( 'My::List::Util' ) }
ok( defined &sum, 'sum() is exported' );
is( sum( 1, 2, 3 ), 6, '1+2+3 is six' );
is( sum( qw(1 2 3) ), 6, '1+2+3 as strings is six' );
is( sum( 4, -9, 37, 6 ), 38, '4-9+37+6 is six' );
is( sum( 3.14, 2.2 ), 5.34, '3.14 + 2.2 is 5.34' );
is( sum(), undef, 'No arguments returns undef' );
is( sum( qw(a b) ), undef, 'All bad args gives undef' );
is( sum( qw(a b 4 5) ), 9, 'Some good args works' );
done_testing();

集成测试 ：测试多个模块或类之间的交互是否正常。例如，在测试 Acme::GILLIGAN::Utils 模块时，我们不仅测试了 sum 方法的功能，还测试了其与其他模块的集成情况：

use Test::More tests => 5;
use Test::NoWarnings;
use_ok( 'Acme::GILLIGAN::Utils' );
ok( defined &Acme::GILLIGAN::Utils::sum, 'sum() is defined' );
my @good_list = 1 .. 10;
is( Acme::GILLIGAN::Utils::sum( @good_list), 55, 'The sum of 1 to 10 is 55' );
my @weird_list = qw( a b c 1 2 3 123abc );
is( Acme::GILLIGAN::Utils::sum( @weird_list), 129, 'The weird sum is 128' );
done_testing();

使用测试框架 ：可以使用一些成熟的测试框架，如 Test::Class 来组织和管理测试用例，提高测试代码的可维护性。

12. 未来拓展方向

基于前面的练习和实践，我们可以考虑以下未来拓展方向：

开发更复杂的应用 ：结合多个模块和类，开发一个完整的应用程序，例如一个简单的动物管理系统，实现动物的创建、信息修改、比赛成绩记录等功能。
与数据库交互 ：将 RaceHorse 类中的比赛成绩信息存储到数据库中，而不是使用 dbmopen 关联的文件存储。可以使用 DBI 模块来实现与数据库的交互。
开发 Web 应用 ：使用 Perl 的 Web 框架，如 Mojolicious 或 Dancer ，将我们的应用程序部署到 Web 上，提供用户界面供用户操作。

以下是一个简单的开发流程拓展图：

graph TD;
    A[开发更复杂应用] --> B[与数据库交互];
    B --> C[开发 Web 应用];
    C --> D[持续优化和维护];

通过不断地实践和拓展，我们可以更深入地掌握 Perl 编程，提高自己的编程能力和解决实际问题的能力。同时，遵循代码复用、测试优先等原则，可以让我们的代码更加健壮和可维护。