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;
}

47、编写一个子例程，用于计算传递给它的所有参数的总和

以下是一个用 Perl 编写的子例程，用于计算传递给它的所有参数的总和：

sub sum {
    my $total = 0;
    foreach my $num (@_) {
        $total += $num;
    }
    return $total;
}

你可以使用以下方式调用这个子例程：

my $result = sum(1, 2, 3, 4);
print $result; # 输出 10

48、编写程序，让用户输入一个字符串和一个数字，将字符串重复该数字次数并输出，要求字符串出现在不同行

以下是一个满足需求的 Perl 程序示例：

print "请输入一个字符串: ";
chomp(my $str = <STDIN>);
print "请输入一个数字: ";
chomp(my $num = <STDIN>);
for (my $i = 0; $i < $num; $i++) {
    print $str . "
";
}

该程序首先提示用户输入一个字符串和一个数字，然后使用

for

循环将字符串重复指定的次数，并在每次重复时换行输出。

49、编写一个子程序来计算参数列表的平均值，再编写一个子程序返回参数列表中大于平均值的元素

以下是使用Perl语言实现的代码：

# 计算平均值的子程序
sub calculate_average {
    my $sum = 0;
    my $count = scalar @_;
    foreach my $num (@_) {
        $sum += $num;
    }
    return $sum / $count;
}

# 返回大于平均值元素的子程序
sub above_average {
    my $avg = calculate_average(@_);
    my @result;
    foreach my $num (@_) {
        if ($num > $avg) {
            push @result, $num;
        }
    }
    return @result;
}

# 示例调用
my @numbers = (1, 2, 3, 4, 5);
my $average = calculate_average(@numbers);
my @above_avg = above_average(@numbers);
print "平均值: $average
";
print "大于平均值的元素: @above_avg
";

上述代码定义了两个子程序，

calculate_average

用于计算参数列表的平均值，

above_average

用于返回参数列表中大于平均值的元素。最后给出了示例调用并打印结果。

50、编写一个 greet 子程序，使用状态变量记住所有与之交谈过的人

以下是一个使用 Perl 编写的

greet

子程序示例，它使用状态变量来记住所有与之交谈过的人：

sub greet {
    my $name = shift;
    state @seen;

    if (@seen == 0) {
        print "Hi $name! You are the first one here!
";
    } else {
        my $seen_str = join " ", @seen;
        print "Hi $name! I've seen: $seen_str
";
    }

    push @seen, $name;
}

# 测试代码
greet( "Fred" );
greet( "Barney" );
greet( "Wilma" );
greet( "Betty" );

在这个子程序中，

state

关键字用于声明一个状态变量

@seen

，它会在子程序调用之间保留其值。每次调用

greet

子程序时，会根据

@seen

数组的情况输出不同的问候语，并将新的名字添加到

@seen

数组中。

51、编写程序，提示用户输入一些行，然后将这些行右对齐到第 20 列输出，并打印一个标尺行

以下是一个满足需求的 Perl 程序示例：

print "请输入一些行，输入空行结束输入：
";
my @lines;
while (my $line = <STDIN>) {
    chomp $line;
    last if $line eq '';
    push @lines, $line;
}

# 打印标尺行
print "1 2
";
print "01234567890123456789
";

# 右对齐输出输入的行
foreach my $line (@lines) {
    printf "%20s
", $line;
}

该程序首先提示用户输入一些行，输入空行时结束输入。接着打印一个标尺行，最后将用户输入的行右对齐到第 20 列输出。

52、编写程序，读取用户输入的一些行文本，然后将这些行右对齐到第 20 列并打印出来

以下是一个使用 Perl 编写的示例代码来实现该功能：

while (<STDIN>) {
    chomp;
    printf "%20s
", $_;
}

这段代码会不断从标准输入读取每一行文本，去除行尾的换行符，然后使用

printf

函数将每行文本右对齐到第 20 列并打印出来。

你可以将上述代码保存为一个

.pl

文件，然后在命令行中运行该文件，输入一些文本行进行测试。例如，保存为

align.pl

，在命令行中执行

perl align.pl

，之后输入文本并按回车键，输入完成后按

Ctrl + D

（在 Windows 上按

Ctrl + Z

）结束输入。

53、编写程序，先询问用户想要的列宽，然后读取用户输入的一些行文本，将这些行右对齐到指定列宽并打印出来

以下是一个使用Python实现该功能的示例代码：

# 询问用户想要的列宽
width = int(input('请输入列宽: '))

# 读取用户输入的行文本
lines = []
print('请输入文本行，输入空行结束输入:')
while True:
    line = input()
    if not line:
        break
    lines.append(line)

# 将行右对齐到指定列宽并打印
for line in lines:
    print(line.rjust(width))

这段代码首先让用户输入列宽，接着允许用户输入多行文本，以空行结束输入。最后，将每一行文本右对齐到指定列宽并打印出来。

54、编写程序，使用哈希表存储一些人的名字和姓氏，然后根据用户输入的名字输出对应的全名

以下是一个使用Python实现的示例代码：

# 创建一个哈希表（在Python中是字典）来存储名字和姓氏
name_dict = {
    "张三": "张",
    "李四": "李",
    "王五": "王"
}

# 获取用户输入的名字
first_name = input("请输入名字: ")

# 检查名字是否在哈希表中
if first_name in name_dict:
    # 输出全名
    full_name = name_dict[first_name] + first_name
    print(f"全名是: {full_name}")
else:
    # 若名字不在哈希表中，输出提示信息
    print("未找到该名字的信息。")

上述代码通过字典存储名字和姓氏的映射关系，根据用户输入的名字查找对应的姓氏并输出全名，若未找到则给出提示。

55、修改第一题的模式，使其能匹配 ‘fred’ 或 ‘Fred’。

将第一题答案中使用的模式修改为

/[fF]red/

。你也可以尝试

/(f|F)red/

或

/fred|Fred/

，但字符类更高效。

56、修改一个模式，使其能匹配点号 ‘.’

将使用的模式改为 /./，因为点号是元字符所以需要反斜杠；也可以使用字符类 /[.]/。

57、修改给定的正则表达式模式，使其能匹配两个连续相同的非空白字符

将原答案中使用的模式改为 /(S)1/

58、编写一个程序，找出同时包含 ‘wilma’ 和 ‘fred’ 的行并打印出来

方法一：

```perl
while (<>) {
    if (/wilma/) {
        if (/fred/) {
            print;
        }
    }
}

方法二：

while (<>) {
    if (/wilma.*fred|fred.*wilma/) {
        print;
    }
}

方法三（使用逻辑与运算符，前提是已了解该运算符）：

在同一个

if

条件中同时进行

/fred/

和

/wilma/

测试

##59、编写一个模式，在插入 $what 后，它类似于 /(fred|barney){3}/，并解释为什么需要括号。
模式为 `/($what){3}/`。若没有括号，模式会变成类似 `/fred|barney{3}/` 的形式，等同于 `/fred|barneyyy/`，无法正确匹配三个连续的 `$what` 副本，所以括号是必需的。

##60、编写一个模式，匹配$what变量所代表的模式连续出现3次的情况
可以使用如下模式：

/(?:$what){3}/

在代码中可设置 `$what`，例如：

```perl
my $what = 'fred|barney';

然后使用该模式进行匹配。

61、编写一个程序，在所有以#!开头的文件的第一行后面添加一行版权声明## Copyright (C) 20XX by Yours Truly，并创建备份文件

以下是实现该功能的Perl程序：

# 为避免重复添加版权声明，对文件进行两次遍历
# 首先，使用哈希表创建一个“集合”，键为文件名，值使用1
my %do_these;
foreach (@ARGV) {
    $do_these{$_} = 1;
}

# 接着，检查文件，从待处理列表中移除已包含版权声明的文件
while (<>) {
    if (/^## Copyright/) {
        delete $do_these{$ARGV};
    }
}

# 最后，重新建立缩减后的文件名列表，执行添加版权声明的操作
@ARGV = sort keys %do_these;
$^I = ".bak"; # 创建备份文件
while (<>) {
    if (/^#!/) { # 判断是否为shebang行
        $_ .= "## Copyright (c) 20XX by Yours Truly
";
    }
    print;
}

将上述代码保存为一个

.pl

文件，然后在命令行中运行，将需要处理的文件名作为参数传递给该脚本，例如：

perl your_script.pl file1 file2

62、编写一个猜数字游戏程序，程序随机生成一个1到100之间的整数，让用户输入猜测的数字，根据用户输入给出提示，直到用户猜对或退出

以下是一个满足需求的Perl程序示例：

use 5.010;
my $secret = int(1 + rand 100);
while (1) {
    print "请输入一个1到100之间的数字（输入quit退出）：";
    my $guess = <STDIN>;
    chomp $guess;
    if ($guess eq "quit") {
        last;
    }
    if ($guess !~ /^d+$/ ) {
        print "输入无效，请输入一个有效的数字。
";
        next;
    }
    if ($guess < $secret) {
        print "猜的数字太小了，再试一次。
";
    } elsif ($guess > $secret) {
        print "猜的数字太大了，再试一次。
";
    } else {
        print "恭喜你，猜对了！
";
        last;
    }
}

该程序首先随机生成一个1到100之间的整数，然后进入一个无限循环，不断提示用户输入猜测的数字。如果用户输入

quit

，则退出循环；如果输入无效，会提示用户重新输入；根据用户输入的数字与随机数的大小关系给出相应提示，直到猜对为止。

63、编写一个程序，生成一个1到100之间的随机数作为秘密数字，让用户输入猜测的数字，根据用户输入给出提示（太小、太大、猜对），如果用户输入quit、exit或空白则退出程序并告知秘密数字。

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

use strict;
use warnings;

# 生成1到100之间的随机数作为秘密数字
my $secret = int(1 + rand 100);

while (1) {
    print "请输入你的猜测（输入quit、exit或空白可退出）：";
    my $guess = <STDIN>;
    chomp $guess;

    # 检查是否退出
    if ($guess eq "quit" || $guess eq "exit" || $guess eq "") {
        print "退出程序，秘密数字是 $secret。
";
        last;
    }

    # 检查输入是否为数字
    if ($guess =~ /^d+$/ ) {
        if ($guess < $secret) {
            print "你的猜测太小了。
";
        } elsif ($guess > $secret) {
            print "你的猜测太大了。
";
        } else {
            print "猜对了！秘密数字就是 $secret。
";
            last;
        }
    } else {
        print "输入无效，请输入一个有效的数字。
";
    }
}

64、编写一个程序，设置一些环境变量，其中键ZERO和EMPTY有假但已定义的值，键UNDEFINED没有值，使用//运算符在$ENV{$key}未定义时选择字符串(undefined)并打印环境变量的键和值。若不使用Perl 5.10的特性，使用三元运算符实现相同功能。

下面是给定的【文本内容】：

使用`//`运算符的代码：

```perl
use 5.010;
$ENV{ZERO} = 0;
$ENV{EMPTY} = '';
$ENV{UNDEFINED} = undef;

my $longest = 0;
foreach my $key ( keys %ENV ) {
    my $key_length = length( $key );
    $longest = $key_length if $key_length > $longest;
}

foreach my $key ( sort keys %ENV ) {
    printf "%-${longest}s %s
", $key, $ENV{$key} // "(undefined)";
}

不使用Perl 5.10特性，使用三元运算符的代码：

$ENV{ZERO} = 0;
$ENV{EMPTY} = '';
$ENV{UNDEFINED} = undef;

my $longest = 0;
foreach my $key ( keys %ENV ) {
    my $key_length = length( $key );
    $longest = $key_length if $key_length > $longest;
}

foreach my $key ( sort keys %ENV ) {
    printf "%-${longest}s %s
", $key, defined $ENV{$key} ? $ENV{$key} : "(undefined)";
}

65、安装DateTime模块后，创建两个日期并计算它们之间的差值，注意日期顺序。

以下是示例代码：

use DateTime;
my $dt1 = DateTime->new( year => 1987, month => 12, day => 18,);
my $dt2 = DateTime->new( year => 2011, month => 5, day => 1,);
my $duration = $dt2 - $dt1;
my @units = $duration->in_units( qw(year month day) );
printf '%d years, %d months, and %d days', @units;

代码中创建了两个DateTime对象

$dt1

和

$dt2

，计算

$dt2 - $dt1

得到差值

$duration

，并将差值转换为年、月、日表示。同时要保证日期顺序是较晚日期减去较早日期，否则差值为负。

66、编写一个使用 DateTime 计算当前日期与你在命令行输入的年、月、日所表示的日期之间的时间间隔的程序。

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

use DateTime;
use Time::Piece;

my $t = localtime;
my $now = DateTime->new(
    year => $t->year,
    month => $t->mon,
    day => $t->mday,
);

my $then = DateTime->new(
    year => $ARGV[0],
    month => $ARGV[1],
    day => $ARGV[2],
);

if( $now < $then ) {
    die "You entered a date in the future!
";
}

my $duration = $now - $then;
my @units = $duration->in_units( qw(years months days) );
printf "%d years, %d months, and %d days
", @units;

将上述代码保存为

duration.pl

，然后在命令行运行：

$ perl duration.pl 1960 9 30

程序会输出当前日期与 1960 年 9 月 30 日之间的时间间隔。

67、使用

given

重写猜数字程序（不一定使用智能匹配）。猜数字程序规则为：程序随机生成一个1到100之间的整数，用户输入猜测的数字，程序根据用户输入给出相应提示，直到用户猜对为止。

原答案不完整，无法完成猜数字程序的功能，属于明显不规范，因此为 DELETE

68、使用给定（given）和智能匹配（smart matching）来检查从命令行参数 $ARGV[0] 获取的一个数字是否为质数，若不是质数则获取其除数。

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

use 5.010;
say "Checking the number <$ARGV[0]>";
given( $ARGV[0] ) {
    when( ! /Ad+/ ) {
        say "Not a number!"
    }
    my @divisors = divisors( $_ );
    my @empty;
    when( @divisors ~~ @empty ) {
        say "Number is prime"
    }
    default {
        say "$_ is divisible by @divisors"
    }
}
sub divisors {
    my $number = shift;
    my @divisors = ();
    foreach my $divisor ( 2 .. $number/2 ) {
        push @divisors, $divisor unless $number % $divisor;
    }
    return @divisors;
}

69、编写一个 Perl 程序，添加更多的

when

块来处理额外的报告情况，例如检查输入的数字是偶数、奇数、能被喜欢的数字（假设喜欢的数字为 42）整除，或者该数字本身就是喜欢的数字。

以下是实现代码：

use 5.010;

say "Checking the number <$ARGV[0]>";
my $favorite = 42;
given( $ARGV[0] ) {
    when( ! /Ad+/ ) {
        say "Not a number!"
    }
    my @divisors = divisors( $ARGV[0] );
    when( @divisors ~~ 2 ) { # 2 is in @divisors
        say "$_ is even";
        continue;
    }
    when( !( @divisors ~~ 2 ) ) { # 2 isn't in @divisors
        say "$_ is odd";
        continue;
    }
    when( @divisors ~~ $favorite ) {
        say "$_ is divisible by my favorite number";
        continue;
    }
    when( $favorite ) { # $_ ~~ $favorite
        say "$_ is my favorite number";
        continue;
    }
    my @empty;
    when( @divisors ~~ @empty ) {
        say "Number is prime"
    }
    default {
        say "$_ is divisible by @divisors"
    }
}

sub divisors {
    my $number = shift;
    my @divisors = ();
    foreach my $divisor ( 2 .. ($ARGV[0]/2 + 1) ) {
        push @divisors, $divisor unless $number % $divisor;
    }
    return @divisors;
}

70、将当前工作目录更改为根目录并执行 ‘ls -l’ 命令。

以下是一种实现方式：

chdir '/' or die "Can't chdir to root directory: $!";
exec 'ls', '-l' or die "Can't exec ls: $!";