Perl编程实践技巧与案例解析

1、如何申请一个 PAUSE 账户？

要获得 PAUSE 账户，访问 http://pause.perl.org/ 并点击 “Request PAUSE account” 链接，填写包含姓名、电子邮箱地址和首选 PAUSE 账户名等基本信息的网络表单。

PAUSE 账户名目前需为 4 到 9 个字符（部分遗留账户名可能为 3 个字符）。

申请会由人工审核，以防机器人和重复账户，通常一两天内申请会获批。

获批后会有一个以
@cpan.org 结尾的邮箱地址，还可使用该地址创建一个 Gravatar 头像。

2、访问网站http://www.intermediateperl.com/，特别关注其下载部分，下载对练习有用的存档文件，以便在以后没有网络连接时也能使用。

请访问网站： Intermediate Perl ，关注 下载 部分，并下载对练习有用的文件存档，以便在无网络时使用。

3、读取当前目录中的文件列表，并将文件名转换为完整路径规范。不要使用 shell 或外部程序来获取当前目录。可以使用随 Perl 附带的 File::Spec 和 Cwd 模块。在每个路径前打印四个空格，后面跟一个换行符。

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

use Cwd;
use File::Spec;
my $cwd = getcwd;
foreach my $file ( glob( ".* *" ) ) {
    print "    ", File::Spec->catfile( $cwd, $file ), "
";
}

或者使用
File::Spec::Functions 模块，代码如下：

use Cwd;
use File::Spec::Functions;
my $cwd = getcwd;
foreach my $file ( glob( ".* *" ) ) {
    print "    ", catfile( $cwd, $file ), "
";
}

4、从CPAN安装Business::ISBN模块，并使用它从国际标准书号（978144939390）中提取组代码和出版商代码。

可使用以下代码实现：

use Business::ISBN;
my $isbn = Business::ISBN->new( '9781449393090' );
print "ISBN is " . $isbn->as_string . "
";
print "Country code: " . $isbn->country_code . "
";
print "Publisher code: " . $isbn->publisher_code . "
";

5、编写一个程序，从命令行获取文件名列表，使用grep筛选出大小小于1000字节的文件。使用map对该列表中的字符串进行转换，在每个字符串前添加四个空格，后面添加一个换行符。最后打印结果列表。

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

print map { "    $_
" } grep { -s $_ < 1000 } @ARGV;

上述代码将直接筛选出大小小于1000字节的文件，对文件名进行转换并打印结果，不使用中间数组。

6、编写一个程序，要求用户输入一个正则表达式模式。从标准输入读取该模式，而不是从命令行参数获取。报告某个硬编码目录（如“/etc”或“C:Windows”）中文件名与该模式匹配的文件列表。重复此过程，直到用户输入空字符串而非模式。用户不应输入 Perl 中传统用于分隔模式匹配的斜杠；输入模式由尾随换行符分隔。确保有缺陷的模式（如括号不匹配的模式）不会使程序崩溃。

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

use strict;
use warnings;
use File::Spec;

# 硬编码目录
my $hardcoded_dir = '/etc'; # 可根据需要修改为 'C:\Windows'

while (1) {
    print 'Enter a pattern: ';
    chomp(my $pattern = <STDIN>);

    # 如果用户输入空字符串，退出循环
    last if $pattern eq '';

    # 预编译正则表达式
    my $regex = eval { qr/$pattern/ };
    if ($@) {
        print "Invalid pattern: $@. Please try again.";
        next;
    }

    # 获取目录中的文件列表
    opendir(my $dh, $hardcoded_dir) or die "Can't open $hardcoded_dir: $!";
    my @files = readdir($dh);
    closedir($dh);

    # 过滤出匹配的文件
    my @matching_files = grep { $_ =~ $regex } @files;

    # 输出匹配的文件
    if (@matching_files) {
        print "Matching files in $hardcoded_dir:
";
        foreach my $file (@matching_files) {
            print File::Spec->catfile($hardcoded_dir, $file), "
";
        }
    } else {
        print "No matching files found in $hardcoded_dir.
";
    }
}

这个程序会不断提示用户输入正则表达式模式，直到用户输入空字符串。对于每个输入的模式，程序会尝试预编译它，如果模式无效，会给出错误信息并提示用户重新输入。然后程序会列出硬编码目录中文件名与模式匹配的文件。

7、这些表达式指代多少种不同的事物？为每个表达式绘制一个 PeGS 结构：$ginger->[2][1]、${$ginger[2]}[1]、$ginger->[2]->[1]、${$ginger->[2]}[1]

这些表达式除了
${$ginger[2]}[1] 外，其余都指代相同的事物。
${$ginger[2]}[1] 等同于
$ginger[2][1] ，其基础是数组
@ginger ，而非标量
$ginger 。图 A – 1 是
$ginger->[2][1] 、
$ginger->[2]->[1] 和
${$ginger->[2]}[1] 的 PeGS 图；图 A – 2 是
${$ginger[2]}[1] 的 PeGS 图。

8、教授需要读取一个日志文件，日志文件内容类似：Gilligan: 1 coconut Skipper: 3 coconuts Gilligan: 1 banana Ginger: 2 papayas Professor: 3 coconuts MaryAnn: 2 papayas… 他想生成一系列文件，如gilligan.info、maryann.info等，每个文件应包含以对应名字开头的所有行（名字由后面的冒号分隔）。最终，gilligan.info文件应开头为：Gilligan: 1 coconut Gilligan: 1 banana。由于日志文件很大且电脑运行速度慢，他希望一次性处理输入文件并并行写入所有输出文件，该怎么做？

使用一个以角色名字为键的哈希表，其值为每个输出文件的 `IO::File` 对象。若文件不存在则创建，若存在则覆盖。

9、运行rightmost程序（可以从http://www.intermediateperl.com/ 的下载部分获取该程序）。在示例程序能正常运行后，修改rightmost程序，使其接收一个字符串和一个模式哈希的引用作为参数，并返回最右侧匹配项的键。不要使用如下调用方式：my $position = rightmost( ‘There is Mrs. Howell, Ginger, and Gilligan’, @patterns{ sort keys %patterns }); 而是使用这种调用方式：my $key = rightmost( ‘There is Mrs. Howell, Ginger, and Gilligan’, %patterns);

以下是修改后的
rightmost 子程序代码实现该需求：

sub rightmost {
    my( $string, $patterns ) = @_;
    my( $rightmost_position, $rightmost_key ) = ( -1, undef );
    while( my( $key, $value ) = each %$patterns ) {
        my $position = $string =~ m/$value/ ? $-[0] : -1;
        if( $position > $rightmost_position ) {
            $rightmost_position = $position;
            $rightmost_key = $key;
        }
    }
    return $rightmost_key;
}

调用示例：

my %patterns = (
    Gilligan => qr/(?:Willie )?Gilligan/,
    'Mary Ann' => qr/Mary Ann/,
    Ginger => qr/Ginger/,
    Professor => qr/(?:The )?Professor/,
    Skipper => qr/Skipper/,
    'A Howell' => qr/Mrs?. Howell/,
);
my $key = rightmost( 'There is Mrs. Howell, Ginger, and Gilligan', \%patterns);
print "Rightmost character is $key
";

10、编写一个程序，从文件中读取一组模式。预编译这些模式并将它们存储在一个数组中。例如，模式文件可能如下所示：cocoa?n[ue]t Mary[−s]+Anne? (Thes+)?(Skipper|Professor) 提示用户输入多行内容，打印出每行匹配的行号和文本。这里使用 $. 变量会很有用。

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

# 打开模式文件
open my $pattern_fh, '<', 'patterns.txt'
    or die "Could not open patterns.txt: $!";

# 初始化存储预编译模式的数组
my @patterns;

# 读取模式文件中的每一行，预编译并存储到数组中
while (<$pattern_fh>) {
    chomp;
    my $pattern = qr/$_/;
    push @patterns, $pattern;
}

# 关闭模式文件
close $pattern_fh;

# 提示用户输入内容
print "请输入内容，输入结束后按 Ctrl+D（Unix/Linux）或 Ctrl+Z（Windows）：
";

# 逐行读取用户输入
LINE: while (<>) {
    foreach my $pattern (@patterns) {
        if (/($pattern)/) {
            print "Match at line $. | $_";
            next LINE;
        }
    }
}

上述程序首先打开模式文件，将其中的每个模式预编译并存储在数组中。然后提示用户输入内容，逐行读取用户输入，检查每行是否与任何模式匹配，如果匹配则打印行号和文本。

11、使用 glob 操作符，按相对大小对主目录中的每个文件名进行简单排序的代码可能如下：chdir; # 默认是我们的主目录 my @sorted = sort { -s $a <=> -s $b } glob ‘*’; 请使用 Schwartzian Transform 技术重写此代码。

使用 Schwartzian Transform 技术重写后的代码如下：

use v5.10;

chdir;

my @sorted = map $_->[0],
             sort { $a->[1] <=> $b->[1] }
             map [ $_, -s $_ ],
             glob '*';

say join "
", @sorted;

12、使用施瓦茨变换（Schwartzian Transform）读取一个单词列表，并按“字典顺序”对它们进行排序。字典顺序会忽略所有大小写和内部标点符号。提示：以下转换可能有用：my $string = ‘Mary Ann’; $string =~ tr/A−Z/a−z/; # 强制全部转换为小写 $string =~ tr/a−z//cd; # 去除除 a – z 以外的所有字符 print $string; # 输出 “maryann” 确保不要破坏原始数据！如果输入包含 the Professor 和 The Skipper，输出应该按该顺序列出它们，并保持原有的大小写。

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

use v5.16;

my @dictionary_sorted = map $_->[0], sort { $a->[1] cmp $b->[1] } map {
    my $string = $_;
    $string =~ s/P{Letter}//g;  # 去除非字母字符
    $string = fc( $string );     # 正确的大小写折叠
    [ $_, $string ];
} @input_list;

代码中，首先使用
map 对输入列表中的每个元素进行处理，创建一个包含原始字符串和处理后字符串的数组引用。处理过程包括去除非字母字符和进行大小写折叠。然后使用
sort 对这些数组引用进行排序，比较的是处理后的字符串。最后再使用
map 提取出排序后的原始字符串。

13、修改递归目录转储程序，使其通过缩进显示嵌套目录。空目录应显示为：sandbar, an empty directory；而非空目录应显示嵌套内容，并缩进两个空格，例如：uss_minnow, with contents: anchor broken_radio galley, with contents: captain_crunch_cereal gallon_of_milk tuna_fish_sandwich life_preservers

以下是修改后的递归目录转储程序：

sub dump_data_for_path {
    my $path = shift;
    my $data = shift;
    my $level = shift || 0;

    print ' ' x $level, $path;

    if( not defined $data ) {
        # 普通文件
        print "
";
        return;
    }

    if( keys %$data ) {
        print ", with contents of:
";
        foreach (sort keys %$data) {
            dump_data_for_path( $_, $data->{$_}, $level + 1 );
        }
    } else {
        print ", an empty directory
";
    }
}

该程序将路径、数据和缩进级别作为参数。对于普通文件，直接打印路径并换行；对于非空目录，打印路径和提示信息，递归调用自身并增加缩进级别；对于空目录，打印路径和提示为空目录的信息。

14、修改
data_for_path 的迭代版本，使其能够处理深度优先或广度优先遍历。使用一个可选的第三个参数，让用户决定使用哪种遍历方式，示例调用如下：
my $depth = data_for_path( $start_dir, $threshold, 'depth-first' ); 以及
my $breadth = data_for_path( $start_dir, $threshold, 'breadth-first' );

以下是修改后的
data_for_path 函数代码：

sub data_for_path {
    my( $path, $threshold, $type ) = @_;
    my $data = {};
    my @queue = ( [ $path, 0, $data ] );
    while( my $next = shift @queue ) {
        my( $path, $level, $ref ) = @$next;
        my $basename = basename( $path );
        $ref->{$basename} = do {
            if( -f $path or -l $path ) {
                undef
            } else {
                my $hash = {};
                if( $level < $threshold ) {
                    opendir my $dh, $path;
                    my @new_paths = map { catfile( $path, $_ ) } grep { ! /^..?z/ } readdir $dh;
                    if ($type eq 'depth-first') {
                        unshift @queue, map { [ $_, $level + 1, $hash ] } @new_paths;
                    } else {
                        push @queue, map { [ $_, $level + 1, $hash ] } @new_paths;
                    }
                }
                $hash;
            }
        };
    }
    return $data;
}

在这个修改后的
data_for_path 函数中，增加了第三个参数
$type 用于指定遍历类型。当
$type 为
'depth-first' 时，使用
unshift 将新元素添加到队列前端，实现深度优先遍历；当
$type 为其他值（默认为广度优先遍历）时，使用
push 将新元素添加到队列后端。

15、用10分钟编写一个程序，使用相关库和以下代码打印一条消息，例如“Today is Monday, August 15 2011”，表示今天是八月的一个星期一。你可以使用localtime函数：my($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime; 提示：localtime返回的年份和月份数字可能和你预期的不同，需要进行相应处理。

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

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.
";

16、在20分钟内，通过在命令行运行Module::Starter创建你自己的Animal发行版。构建该发行版并运行测试。由于你没有做任何更改，所有测试应该都能通过。为了查看模块中出现错误时会发生什么，在Animal.pm中制造某种语法错误。重新运行测试，这次测试应该会失败。不用担心会弄乱任何东西，因为可以重新运行Module::Starter来创建发行版。

创建发行版：运行
module - starter --builder=ExtUtils::Makemaker --name=Animal 运行 Makefile.PL 创建 Makefile：运行
perl Makefile.PL 构建发行版：运行
make 确保测试通过：运行
make test 在 Animal.pm 中制造语法错误 重新运行测试：运行
make test ，此时测试应失败；若弄乱可重新运行

module - starter --builder=ExtUtils::Makemaker --name=Animal

若使用 Module::Build，步骤为：
运行
perl Build.PL 创建构建脚本，使用
./Build 相关命令，如

./Build test

./Build disttest

./Build dist
进行测试和创建发行版。

17、用你的姓名和电子邮件地址设置 Module::Starter 配置文件，然后前往 https://pause.perl.org/ 并点击“Request PAUSE account”链接，填写信息、提交表单后等待，此过程中不涉及 Animal 发行版相关内容。

设置配置文件时，可在
.module - starter/config 文件中添加类似如下内容：

author: 你的姓名
email: 你的邮箱地址

之后前往 https://pause.perl.org/ 并点击 “Request PAUSE account” 链接，填写信息、提交表单后等待，此过程不涉及 Animal 发行版相关内容。

18、在20分钟内，下载并安装 Module::Starter::AddModule，将该插件添加到Module::Starter配置文件中，然后将Cow模块添加到你的发行版中。

使用以下命令安装
Module::Starter::AddModule ：


bash % cpan -I Module::Starter::AddModule

更新
.module-starter/config 文件以使用新安装的插件，示例配置如下：


yaml author: Willie Gilligan email: gilligan@island.example.com builder: Module::Build verbose: 1 plugins: Module::Starter::AddModule

如果在发行版目录中，使用以下命令添加
Cow 模块：


bash % module-starter --module=Cow --dist=.