Perl编程实践技巧与示例

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

要获得 PAUSE 账户，可访问 http://pause.perl.org/ 并点击 “Request PAUSE account” 链接，填写包含姓名、电子邮件地址和首选 PAUSE 账户名等基本信息的网络表单（目前 PAUSE 名称长度需在 4 到 9 个字符之间，部分遗留名称为 3 个字符），申请会提交给 PAUSE 管理员进行人工审核，通常一两天内会获批。获批后会获得一个带有账户名的 @cpan.org 地址，还可使用该地址创建一个 Gravatar 头像。

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

请访问网站 http://www.intermediateperl.com/ ，关注下载部分并下载对练习有用的文件存档，以便在无网络时使用。

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

以下是两种实现方式的代码：

方式一：


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

方式二：


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

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

可使用以下代码实现：


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;

这段代码中， grep { -s $_ < 1000 } @ARGV 用于筛选出命令行参数中文件大小小于 1000 字节的文件名， map { " $_ " } 用于给筛选出的文件名前加上四个空格并在后面加上换行符，最后使用 print 输出结果列表。

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

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


use strict;
use warnings;
use File::Spec;
# 硬编码目录
my $directory = '/etc';
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, $directory) or die "Can't open $directory: $!";
    my @files = readdir($dh);
    closedir($dh);
    # 查找匹配的文件
    my @matching_files;
    foreach my $file (@files) {
        if ($file =~ $regex) {
            push @matching_files, File::Spec->catfile($directory, $file);
        }
    }
    # 输出匹配的文件
    if (@matching_files) {
        print "Matching files:";
        print join("
", @matching_files), "
";
    } else {
        print "No matching files found.
";
    }
}

代码说明：

输入处理 ：程序会不断提示用户输入正则表达式，直到用户输入空字符串。 正则表达式预编译 ：使用 eval 和 qr// 来预编译用户输入的正则表达式，这样可以捕获无效模式并避免程序崩溃。 文件匹配 ：读取硬编码目录中的所有文件，并检查文件名是否与预编译的正则表达式匹配。 输出结果 ：输出匹配的文件列表，如果没有匹配的文件，则给出相应提示。

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

这些表达式指的不同事物有2个。除了 ${$ginger[2]}[1] ，其他三个表达式 $ginger->[2][1] 、 $ginger->[2]->[1] 、 ${$ginger->[2]}[1] 指的是同一事物。

有对应两个不同事物的 PeGS 图，一个是 $ginger->[2][1] 、 $ginger->[2]->[1] 和 ${$ginger->[2]}[1] 的 PeGS 图；另一个是 ${$ginger[2]}[1] 的 PeGS 图。

8、使用 `check_required_items` 的最终版本，编写一个名为 `check_items_for_all` 的子程序，该子程序仅接受一个哈希引用作为参数。该哈希的键是 `Minnow` 号上的人员，对应的值是他们打算带上船的物品的数组引用。例如，哈希引用可以这样构建： `my @gilligan = ( '物品1', '物品2' ); my @skipper = ( '物品3', '物品4' ); my @professor = ( '物品5', '物品6' ); my %all = ( Gilligan => @gilligan, Skipper => @skipper, Professor => @professor, ); check_items_for_all(\%all);` 新构建的子程序应该为哈希中的每个人调用 `check_required_items` ，更新他们的物资清单以包含所需物品。

以下是 check_items_for_all 子程序的实现：


sub check_items_for_all {
    my $people_items_ref = shift;
    foreach my $person (keys %$people_items_ref) {
        my @items = @{$people_items_ref->{$person}};
        check_required_items($person, @items);
    }
}

上述代码接受一个哈希引用作为参数，遍历哈希中的每个人员，获取其物品列表，然后调用 check_required_items 子程序检查每个人是否携带了所需物品。

9、不运行程序，分析以下代码存在的问题：代码定义了两个哈希变量 %passenger_1 和 %passenger_2 ，并将它们的引用存储在数组 @passengers 中。

代码存在问题，在 Perl 里，使用花括号 {} 会创建哈希引用，而不是哈希。应该用圆括号 () 来定义哈希。正确代码如下：


my %passenger_1 = (
    name         => 'Ginger',
    age          => 22,
    occupation   => 'Movie Star',
    real_age     => 35,
    hat          => undef,
);

my %passenger_2 = (
    name           => 'Mary Ann',
    age            => 19,
    hat            => 'bonnet',
    favorite_food  => 'corn',
);

my @passengers = (%passenger_1, %passenger_2);

10、给定一个coconet.dat文件，重写该文件，使其格式不变，但按源机器排序。为每个源机器报告一次每个目标机器以及传输的总字节数。目标机器应缩进显示在源机器名称下方，并按机器名称排序，示例输出如下：ginger.hut maryann.hut 13744 professor.hut gilligan.hut 1845 maryann.hut 90 thurston.howell.hut lovey.howell.hut 97560…


需编写程序处理 `coconet.dat` 文件，跳过注释行，统计每个源机器到各目标机器的总字节数，按源机器排序，每个源机器下的目标机器按名称排序并缩进显示，最后将结果以相同格式重写回文件。

11、编写一个程序，打印出今天的日期和星期几，同时允许用户选择将输出发送到文件、标量或同时发送到两者。无论用户选择哪种方式，都使用一条打印语句输出。如果用户选择将输出发送到标量，程序结束时将标量的值打印到标准输出。

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


use IO::Tee;
use v5.8;
my $fh;
my $scalar;
print 'Enter type of output [Scalar/File/Tee]> ';
my $type = <STDIN>;
if( $type =~ /^s/i ) {
    open $fh, '>', $scalar;
} elsif( $type =~ /^f/i ) {
    open $fh, '>', "$0.out";
} elsif( $type =~ /^t/i ) {
    open my $file_fh, '>', "$0.out" or die "Could not open $0.out: $!";
    open my $scalar_fh, '>', $scalar;
    $fh = IO::Tee->new( $file_fh, $scalar_fh );
}
my $date = localtime;
my $day_of_week = (localtime)[6];
print $fh <<"HERE";
This is run $$
The date is $date
The day of the week is $day_of_week
HERE
print STDOUT <<"HERE" if $type =~ m/^[st]/i;
Scalar contains:
$scalar
HERE

程序中，先提示用户输入输出类型，根据用户输入，将输出分别导向标量、文件或两者。获取当前日期和星期几信息后，使用一条打印语句输出。若选择输出到标量，最后将标量内容打印到标准输出。

12、教授需要读取一个日志文件，日志文件内容类似如下示例：吉列根：1 个椰子船长：3 个椰子吉列根：1 根香蕉金吉尔：2 个木瓜教授：3 个椰子玛丽安：2 个木瓜……他想编写一系列名为 gilligan.info、maryann.info 等的文件，每个文件应包含所有以该名称开头的行（名称总是由后面的冒号分隔）。最后，gilligan.info 文件应开头为：吉列根：1 个椰子吉列根：1 根香蕉。现在，日志文件很大，且计算机速度不快，所以他想一次性处理输入文件并并行写入所有输出文件。他该怎么做？


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

13、编写一个程序，从命令行获取多个目录名，然后打印出这些目录的内容。使用一个函数，该函数接受一个用opendir创建的目录句柄引用。

以下是满足要求的程序：


my @not_dirs = grep { ! -d } @ARGV;
foreach my $not_dir ( @not_dirs ) {
    print "$not_dir is not a directory!
";
}
my @dirs = grep { -d } @ARGV;
my @dir_hs = map { opendir my $dh, $_; $dh } grep { -d } @ARGV;
foreach my $dh ( @dir_hs ) {
    print_contents( $dh )
};

sub print_contents {
    my $dh = shift;
    while( my $file = readdir $dh ) {
        next if( $file eq '.' or $file eq '..');
        print "$file
";
    }
};

该程序首先检查命令行参数中哪些不是有效的目录，并打印错误信息。然后，它找出有效的目录，为每个有效目录创建一个目录句柄，并将这些句柄存储在 @dir_hs 数组中。最后，程序遍历 @dir_hs 数组，并调用 print_contents 函数打印每个目录的内容。 print_contents 函数接受一个目录句柄引用，遍历该目录中的文件，并打印除 . 和 .. 之外的所有文件名。

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

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


#!/usr/bin/perl
use strict;
use warnings;

# 从文件中读取模式
open(my $pattern_file, '<', 'patterns.txt') or die "无法打开模式文件: $!";
my @patterns;
while (my $line = <$pattern_file>) {
    chomp $line;
    my $compiled_pattern = qr/$line/;
    push @patterns, $compiled_pattern;
}
close($pattern_file);

# 提示用户输入
print "请输入文本行，输入结束后按 Ctrl+D (Unix/Linux) 或 Ctrl+Z (Windows) 结束输入：
";
while (my $input = <STDIN>) {
    chomp $input;
    foreach my $pattern (@patterns) {
        if ($input =~ $pattern) {
            print "行号: $., 文本: $input
";
            last;
        }
    }
}

代码说明：

读取模式文件 ：打开 patterns.txt 文件，逐行读取模式，并使用 qr// 预编译每个模式，将编译后的模式存储在 @patterns 数组中。 提示用户输入 ：提示用户输入多行文本，当用户输入结束后按 Ctrl+D (Unix/Linux) 或 Ctrl+Z (Windows) 结束输入。 匹配输入行 ：对于用户输入的每一行，遍历 @patterns 数组，检查是否有匹配的模式。如果有匹配的模式，则打印行号和文本。

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


use v5.10;

chdir;

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

say join "
", @sorted;

16、使用施瓦茨变换读取一个单词列表，并按“字典顺序”对它们进行排序。字典顺序会忽略所有大小写和内部标点。提示：以下转换可能有用：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;

其中， @input_list 是待排序的单词列表， @dictionary_sorted 是排序后的列表。

17、修改 `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;
}

18、编写一个程序，打印出一条消息，例如“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.
";