54、编程练习题解答汇总

dd012

于 2025-12-02 12:54:12 发布

阅读量13

点赞数

CC 4.0 BY-SA版权

分类专栏： Perl实战入门指南文章标签： Perl 距离转换 Person类

本文链接：https://blog.youkuaiyun.com/dd012/article/details/155510611

Perl实战入门指南专栏收录该内容

55 篇文章 ¥499.90

订阅专栏¥69.90

会员秒杀 ¥9.9 重磅福利

超级会员免费看

编程练习题解答汇总

1. 距离转换相关

在距离转换的程序中，有如下代码用于输出公里和米之间的转换关系：

print “There are $meters meters in $kilometers kilometers\n”;
$kilometers = meters_to_kilometers($meters);
print “There are $kilometers kilometers in $meters meters\n”;

运行该程序会输出类似如下内容：

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

对于测试部分，初始的 t/00-load.t 文件内容如下：

#!perl –T
use Test::More tests => 1;
BEGIN {
    use_ok( ‘Convert::Distance::Imperial’ )
      || print “Bail out!\n”;
}
diag( “Testing Convert::Distance::Imperial 
      $Convert::Distance::Imperial::VERSION,
Perl $], $^X” );

当添加 Convert::Distance::Metric 后，文件内容变为：

#!perl -T
use Test::More tests => 2;
BEGIN {
    use_ok( ‘Convert::Distance::Imperial’ ) 
      || print “Bail out!\n”;
    use_ok( ‘Convert::Distance::Metric’ ) 
      || print “Bail out!\n”;
}
diag( “Testing Convert::Distance::Imperial 
      $Convert::Distance::Imperial::VERSION,
Perl $], $^X” );

使用 prove 工具进行测试，输出结果类似如下：

$ prove -lv t/00-load.t 
t/00-load.t .. 
1..2
ok 1 - use Convert::Distance::Imperial;
ok 2 - use Convert::Distance::Metric;
# Testing Convert::Distance::Imperial 0.01, Perl 5.010001, 
/Users/ovid/perl5/perlbrew/perls/perl-5.10.1/bin/perl
ok
All tests successful.
Files=1, Tests=2,  0 wallclock secs ( 0.02 usr  0.01 sys +
  0.02 cusr  0.00 csys =  0.05 CPU)
Result: PASS

2. 人员类相关

编写 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;

可以使用以下代码测试该类：

use DateTime;
my $person = Person->new({
    name      => ‘Bertrand Russell’,
    birthdate => DateTime->new(
        year  => 1872,
        month => 5,
        day   => 18,
    ),
});
print $person->name, ‘ is ‘, $person->age, ‘ years old’;

输出结果会根据运行时间不同而不同，例如可能输出：

Bertrand Russell is 139 years old

在 new() 构造函数中，如果使用单参数形式的 bless ，会导致子类对象被祝福到父类，而不是子类。因此，应始终使用双参数形式的 bless() 。

Customer 类继承自 Person 类，代码如下：

package Customer;
use strict;
use warnings;
use Carp ‘croak’;
use base ‘Person’;
sub _initialize {
    my ( $self, @args ) = @_;
    $self->SUPER::_initialize(@args);
    if ( $self->age < 18 ) {
        croak “Customers must be 18 years old or older”;
    }
}
1;

3. 用户类相关

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’);

Does::ToHash 角色的实现如下：

package Does::ToHash;
use Moose::Role;
sub to_hash {
    my $self = shift;
    my @attributes = map { $_->name }
      $self->meta->get_all_attributes;
    my %hash;
    foreach my $attribute (@attributes) {
        my $value = $self->$attribute;
        next if ref $value;
        $hash{$attribute} = $value;
    }
    return \%hash;
}
1;

扩展 User 类以提供 Does::ToHash 方法：

package User;
use Moose;
with ‘Does::ToHash’;
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;

运行以下测试脚本：

use Data::Dumper;
my $user = User->new(
    username => ‘Ovid’,
    password => ‘Corinna’,
);
print Dumper($user->to_hash);

输出结果如下：

$VAR1 = {
          ‘password’ => ‘5169c96db420b1157c60ba46a6d4b43c’,
          ‘username’ => ‘Ovid’
        };

4. 数组处理相关

unique() 函数用于返回数组中的唯一元素，代码如下：

use Test::Most;
sub unique {
    my @array = @_;
    my %seen;
    my @unique;
    foreach my $element (@array) {
       push @unique => $element unless $seen{$element}++;
    }
    return @unique;
}
my @have = unique( 2, 3, 5, 4, 3, 5, 7 );
my @want = ( 2, 3, 5, 4, 7 );
is_deeply \@have, \@want,
  ‘unique() should return unique() elements in order’;
done_testing;

输出结果：

ok 1 - unique() should return unique() elements in order
1..1

原 unique() 函数返回的元素顺序是随机的，通过排序可以解决这个问题：

is_deeply [ sort @have ], [ sort @want ],
  ‘unique() should return unique() elements in order’;

reciprocal() 函数用于计算一个数的倒数，代码如下：

use Test::Most;
use Carp ‘croak’;
use Scalar::Util ‘looks_like_number’;
sub reciprocal {
    my $number = shift;
    unless ( looks_like_number($number) ) {
        croak(“Argument to reciprocal\(\) must be a number”);
    }
    unless ($number) {
        croak(“Illegal division by zero”);
    }
    return 1 / $number;
}
throws_ok { reciprocal([]) }
  qr/Argument to reciprocal\(\) must be a number/,
  ‘Passing non-numbers to reciprocal() should fail’;
diag reciprocal([]);
done_testing;

5. 测试相关

TestsFor::TV::Episode 类的实现如下：

package TestsFor::TV::Episode;
use Test::Most;
use base ‘TestsFor’;
sub attributes : Tests(14) {
    my $test               = shift;
    my %default_attributes = $test->default_attributes;
    my $class              = $test->class_to_test;
    my $episode            = $class->new(%default_attributes);
    while ( my ( $attribute, $value ) = each %default_attributes ) {
        can_ok $episode, $attribute;
        is $episode->$attribute, $value,
          “The value for ‘$attribute’ should be correct”;
    }
    my %attributes = %default_attributes;    # copy ‘em
    foreach my $attribute (qw/season episode_number/) {
        $attributes{$attribute} = 0;
        throws_ok { $class->new(%attributes) }
        qr/Attribute \($attribute\) does not pass the type constraint/,
          “Setting the $attribute to a value less than zero should fail”;
    }
}
sub default_attributes {
    return (
        series         => ‘Firefly’,
        director       => ‘Marita Grabiak’,
        title          => ‘Jaynestown’,
        genre          => ‘awesome’,
        season         => 1,
        episode_number => 7,
    );
}
1;

TestsFor::TV::Episode::Broadcast 类继承自 TestsFor::TV::Episode 类，代码如下：

package TestsFor::TV::Episode::Broadcast;
use Test::Most;
use DateTime;
use base ‘TestsFor::TV::Episode’;
sub default_attributes {
    my $test       = shift;
    my %attributes = $test->SUPER::default_attributes;
    $attributes{broadcast_date} = DateTime->new(
        year  => 2002,
        month => 10,
        day   => 8,
    );
    return %attributes;
}
sub attributes : Tests(+2) {
    my $test = shift;
    $test->SUPER::attributes;
}
1;

运行测试套件的输出结果如下：

% prove t
t/query.t ......... ok
t/test_classes.t .. ok
t/testit.t ........ ok
All tests successful.
Files=3, Tests=59,  4 wallclock secs
Result: PASS

6. 模板和脚本相关

在模板 characters.tt 中，在 Profession 之后添加以下选择组，用于选择教育程度：

<tr>
  <td>Education</td>
  <td>
    <select name=”education”>
      <option value=”combat”>Combat</option>
      <option value=”medical”>Medical</option>
      <option value=”engineering”>Engineering</option>
    </select>
  </td>
</tr>

在模板 character_display.tt 中，在 Profession 之后添加以下行，用于显示所选的教育程度：

<tr><td>Education</td><td>[% character.education %]</td></tr>

在 characters.psgi 的 generate_character() 子例程中， %adjustments_for 哈希和 %label_for 哈希的内容更新如下：

my %adjustments_for = (
    profession => {
        programmer => {
            strength     => -3,
            intelligence => 8,
            health       => -2,
        },
        pilot    => { intelligence => 3 },
        redshirt => { strength     => 5 }
    },
    birthplace => {
        earth => {
            strength     => 2,
            intelligence => 0,
            health       => -2,
        },
        mars => { strength     => -5, health => 2 },
        vat  => { intelligence => 2,  health => -2 }
    },
    education => {
        combat      => { strength     => 2 },
        medical     => { health       => 2 },
        engineering => { intelligence => 2 }
    },
);
my %label_for = (
    profession => {
        pilot      => “Starship Pilot”,
        programmer => “Programmer”,
        redshirt   => “Doomed”,
    },
    education => {
        combat      => “Combat”,
        medical     => “Medical”,
        engineering => “Engineering”,
    },
    birthplace => {
        earth => “Earth”,
        mars  => “Mars”,
        vat   => “Vat 3-5LX”,
    },
);

然后，在迭代属性时添加 education ：

foreach my $attribute (qw/name education profession birthplace/) {
    # create character
}

运行 plackup characters.psgi 即可进行测试。

使用以下代码进行多次角色生成并统计属性：

use strict;
use warnings;
use WWW::Mechanize;
use HTML::TableExtract;
use List::Util qw/min max sum/;
my $url  = ‘http://localhost:5000/’;
my $mech = WWW::Mechanize->new;
my %stats_for = map { $_ => [] } qw/Strength Intelligence Health/;
for ( 1 .. 100 ) {
    $mech->get($url);
    $mech->follow_link( text_regex => qr/Please click here/ );
    $mech->submit_form(
        form_number => 1,
        fields      => {
            name       => ‘Bob’,
            profession => ‘programmer’,
            education  => ‘engineering’,
            birthplace => ‘earth’,
        },
    );
    my $te = HTML::TableExtract->new;
    $te->parse( $mech->content );
    foreach my $ts ( $te->tables ) {
        foreach my $row ( $ts->rows ) {
            if ( exists $stats_for{ $row->[0] } ) {
                push @{ $stats_for{ $row->[0] } } => $row->[1];
            }
        }
    }
}
while ( my ( $stat, $values ) = each %stats_for ) {
    my $min = min @$values;
    my $max = max @$values;
    my $avg = sum(@$values)/scalar @$values;
    print “$stat:  Min ($min) Max ($max) Average ($avg)\n”;
}

运行结果示例如下：

Health:  Min (2) Max (23) Average (12.72)
Strength:  Min (5) Max (26) Average (15.32)
Intelligence:  Min (15) Max (39) Average (26.32)
Health:  Min (0) Max (24) Average (12.12)
Strength:  Min (4) Max (26) Average (14.79)
Intelligence:  Min (17) Max (38) Average (26.29)

7. 数据库操作相关

在数据库操作中，查询 customers 表的示例如下：

my $sth = $dbh->prepare(“SELECT id, name FROM customers”);
$sth->execute;
while ( my @row = $sth->fetchrow_array ) {
    print “ID: $row[0] Name: $row[1]\n”;
}

如果觉得上述代码过于冗长，且数据量不大，可以使用以下代码：

my $customers = $dbh->selectall_arrayref($sql);

交换 licenses 表中许可证ID的代码如下：

use strict;
use warnings;
use lib ‘lib’;
use MyDatabase ‘db_handle’;
use Try::Tiny;
my $pb_id = $dbh->selectall_arrayref(<<’END’);
 SELECT id
   FROM licenses
  WHERE name = ‘Public Domain’
END
if ( @$pb_id > 1 ) {
    die “More than one Public Domain id found”;
}
my $cc_id = $dbh->selectall_arrayref(<<’END’);
 SELECT id
   FROM licenses
  WHERE name = ‘Attribution CC BY’
END
if ( @$cc_id > 1 ) {
    die “More than one Attribution CC BY id found”;
}
my $sql    = ‘SELECT id FROM media WHERE license_id = ?’;
my $pb_ids = $dbh->selectcol_arrayref( $sql, undef, $pb_id->[0] );
my $cc_ids = $dbh->selectcol_arrayref( $sql, undef, $cc_id->[0] );
# now that we have all of our relevant data, time to move on:
if ( @$pb_ids && @$cc_ids ) {
    $dbh->begin_work;
    try {
        # here, we replace every id with a question mark and 
        # then join the question marks.
        my $placeholders = join ‘,’, map { ‘?’ } @$pb_ids;
        my $rows_affected = $dbh->do(<<”END”, undef, $cc_id, @$pb_ids);
        UPDATE media SET license_id = ? WHERE id IN ($placeholders)
END
        unless ( $rows_affected == @$pb_ids ) {
            my $expected = @$pb_ids;
            die “We should have changed $expected rows, not $rows_affected”;
        }
        $placeholders = join ‘,’, map { ‘?’ } @$cc_ids;
        $rows_affected = $dbh->do( <<”END”, undef, $pb_id, @$cc_ids );
        UPDATE media SET license_id = ? WHERE id IN ($placeholders)
END
        unless ( $rows_affected == @$pb_ids ) {
            my $expected = @$pb_ids;
            die “We should have changed $expected rows, not $rows_affected”;
        }
        # if we got to here, we swapped them safely
        $dbh->commit;
    }
    catch {
        $dbh->rollback;
        die $_;
    };
}

8. 日期处理相关

计算用户年龄的代码如下：

use strict;
use warnings;
use DateTime;
use DateTime::Format::Strptime;
my $datetime_formatter = DateTime::Format::Strptime->new(
    pattern   => ‘%Y-%m-%d’,
    time_zone => ‘GMT’,
);
print “Enter your birthday in YYYY-MM-DD format: “;
my $birthday = <STDIN>;
chomp($birthday);
my $birthday_date = $datetime_formatter->parse_datetime($birthday)
  or die “Could not parse birthday: $birthday”;
my $duration = DateTime->now - $birthday_date;
printf “You are %d years old\n” => $duration->years;

使用命令行参数计算年龄的代码如下：

use strict;
use warnings;
use DateTime;
use Getopt::Long;
use DateTime::Format::Strptime;
my ( $birthdate, $age_at );
GetOptions(
    ‘birthdate=s’ => \$birthdate,
    ‘age_at=s’   => \$age_at,
) or die “Could not parse options”;
my $name = join “ “ => @ARGV;
my $datetime_formatter = DateTime::Format::Strptime->new(
    pattern   => ‘%Y-%m-%d’,
    time_zone => ‘GMT’,
);
unless ($birthdate) {
    print “Enter your birthday in YYYY-MM-DD format: “;
    $birthdate = <STDIN>;
    chomp($birthdate);
}
my $birthday_date = $datetime_formatter->parse_datetime($birthdate)
  or die “Could not parse birthday: $birthdate”;
my $end_date = DateTime->now;
if ($age_at) {    # overwrite $end_date if we have $age_at
    $end_date = $datetime_formatter->parse_datetime($age_at)
      or die “Could not parse birthday: $age_at”;
}
if ( $end_date < $birthday_date ) {
    die “End date must be on or after the birthday”;
}
my $duration = $end_date - $birthday_date;
if ($name) {
    printf “$name is %d years old\n” => $duration->years;
}
else {
    printf “You are %d years old\n” => $duration->years;
}

测试上述年龄计算程序的代码如下：

use strict;
use warnings;
use Test::More;
use DateTime;
use Capture::Tiny ‘capture’;
my ( $stdout, $stderr, @output ) = capture {
    qx/perl age.pl --birthdate 1964-10-18 --age_at 2007-10-02 Charles Stross/;
};
is $output[0], “Charles Stross is 42 years old\n”,
  ‘Charles Stross was 42 years old when he wrote Halting State’;
( $stdout, $stderr, @output ) = capture {
    qx/perl age.pl --birthday 1967-06-20/;
};
like $stderr, qr/Unknown option: birthday/,
  ‘Passing an unknown option should cause the program to fail’;
( $stdout, $stderr, @output ) = capture {
    open my $fh, ‘|-’, ‘perl age.pl Ovid’;
    print $fh ‘1967-06-20’;
};
like $stdout, qr/Enter your birthday in YYYY-MM-DD format:/,
  ‘Not entering a birthdate should prompt for our birthday’;
my $today    = DateTime->now;
my $birthday = DateTime->new(
    year  => 1967,
    month => 6,
    day   => 20,
);
my $age = ( $today - $birthday )->years;
like $stdout, qr/Ovid is $age years old/,
  ‘... and the program should still tell use the correct age’;
diag $stdout;
done_testing;

测试输出结果如下：

age.t ..
ok 1 - Charles Stross was 42 years old when he wrote Halting State
ok 2 - Passing an unknown option should cause the program to fail
ok 3 - Not entering a birthdate should prompt for our birthday
ok 4 - ... and the program should still tell use the correct age
1..4
# Enter your birthday in YYYY-MM-DD format: Ovid is 44 years old
ok
All tests successful.
Files=1, Tests=4,  0 wallclock secs
Result: PASS

综上所述，这些代码示例涵盖了距离转换、类的实现、数组处理、数据库操作和日期处理等多个方面的编程问题及解决方案。通过学习这些示例，我们可以更好地掌握相关的编程技巧和概念。

编程练习题解答汇总（续）

9. 各部分总结与对比

为了更清晰地了解上述各部分的内容，我们可以通过表格进行总结对比：
| 类别 | 功能 | 关键代码 | 注意事项 |
| — | — | — | — |
| 距离转换 | 输出公里和米的转换关系，进行模块测试 | print “There are $meters meters in $kilometers kilometers\n”; 等 | 测试文件需根据添加的模块更新内容 |
| 人员类 | 实现 Person 类和 Customer 类，计算年龄 | sub age { ... } 等 | new() 构造函数中使用双参数 bless() |
| 用户类 | 实现 User 类和 Does::ToHash 角色 | has username => ( is => ‘ro’, isa => ‘Str’, required => 1 ); 等 | 注意密码的加密和验证 |
| 数组处理 | 返回数组中的唯一元素 | sub unique { ... } 等 | 原函数返回元素顺序随机，可通过排序解决 |
| 测试 | 对各类和函数进行测试 | is_deeply \@have, \@want, ... 等 | 注意测试用例的编写和异常处理 |
| 模板和脚本 | 更新模板和脚本，进行角色属性调整和统计 | my %adjustments_for = ( ... ); 等 | 注意模板和脚本中各属性的对应关系 |
| 数据库操作 | 查询和交换数据库中的数据 | $sth = $dbh->prepare(“SELECT id, name FROM customers”); 等 | 交换数据时需使用事务，避免数据损坏 |
| 日期处理 | 计算用户年龄并进行测试 | my $duration = DateTime->now - $birthday_date; 等 | 注意日期格式的解析和异常处理 |

10. 流程梳理

下面通过 mermaid 流程图来梳理部分关键流程，以数据库交换许可证 ID 为例：

graph TD;
    A[开始] --> B[获取 Public Domain 和 Attribution CC BY 的 ID];
    B --> C[获取对应媒体的 ID];
    C --> D{是否有数据};
    D -- 是 --> E[开始事务];
    D -- 否 --> F[结束];
    E --> G[更新 Public Domain 媒体的许可证 ID];
    G --> H{更新是否成功};
    H -- 是 --> I[更新 Attribution CC BY 媒体的许可证 ID];
    H -- 否 --> J[回滚事务并结束];
    I --> K{更新是否成功};
    K -- 是 --> L[提交事务并结束];
    K -- 否 --> J;

11. 代码复用和扩展思路

在实际编程中，我们可以考虑对上述代码进行复用和扩展。例如：
- 类的复用 ： Person 类和 User 类可以作为基础类，在其他项目中复用。我们可以通过继承和扩展这些类来实现更多功能，如添加新的属性和方法。
- 函数的复用 ： unique() 函数和 reciprocal() 函数可以封装成模块，方便在不同项目中使用。同时，我们可以对这些函数进行扩展，以处理更复杂的需求。
- 测试框架的复用 ：测试代码可以作为一个测试框架，在新的项目中进行复用。我们可以根据不同的需求，修改和扩展测试用例，确保代码的质量。

12. 实践建议

为了更好地掌握这些编程技巧和概念，我们可以采取以下实践建议：
- 动手实践 ：将上述代码复制到本地环境中运行，观察输出结果，理解代码的工作原理。同时，可以尝试修改代码，进行不同的测试，加深对代码的理解。
- 阅读文档 ：查阅相关模块的文档，了解其详细的使用方法和注意事项。例如，查阅 DateTime 、 Moose 等模块的文档，掌握其更多的功能和特性。
- 参与开源项目 ：参与开源项目，学习其他开发者的代码风格和编程技巧。在开源项目中，我们可以与其他开发者交流和合作，提升自己的编程水平。

通过以上的总结和建议，我们可以更系统地学习和掌握这些编程知识，提高自己的编程能力。希望这些内容对大家有所帮助。