活动公告

系统通知
05-18 21:22
系统通知
通知:本站资源由网友上传分享,如有违规等问题请到版务模块进行投诉,资源失效请在帖子内回复要求补档,会尽快处理!
10-23 09:31

Perl匹配输出深度解析从基础正则表达式到高级输出技巧涵盖匹配操作符使用输出格式化错误处理性能优化以及实战应用助你解决文本处理难题提升编程效率

SunJu_FaceMall

3万

主题

2860

科技点

3万

积分

白金月票

碾压王

积分
32872

塔罗立华奏

<font color=白金月票" /> 发表于 2025-9-15 02:10:16 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

x
1. 引言

Perl作为一种强大的文本处理语言,其正则表达式和输出处理能力一直是其核心优势。本文将深入探讨Perl中的匹配输出技术,从基础的正则表达式概念到高级的输出技巧,帮助读者全面掌握Perl在文本处理方面的强大功能,提升编程效率。

2. 基础正则表达式

2.1 正则表达式简介

正则表达式(Regular Expression,简称regex)是一种用于描述字符串模式的工具。在Perl中,正则表达式被广泛应用于文本搜索、替换和验证等操作。

2.2 基本语法

Perl中的正则表达式通常包含在斜杠//之间,例如:
  1. if ($string =~ /pattern/) {
  2.     print "匹配成功\n";
  3. }
复制代码

2.3 元字符

正则表达式中的元字符具有特殊含义,以下是一些常用的元字符:

• .:匹配任意单个字符(除换行符外)
• *:匹配前面的元素零次或多次
• +:匹配前面的元素一次或多次
• ?:匹配前面的元素零次或一次
• []:字符类,匹配方括号内的任意字符
• ^:匹配字符串的开始位置
• $:匹配字符串的结束位置
• |:选择,匹配两个或多个模式之一
• ():分组,将多个元素组合为一个单元

示例:
  1. my $text = "The quick brown fox jumps over the lazy dog";
  2. # 匹配包含"fox"的行
  3. if ($text =~ /fox/) {
  4.     print "文本中包含'fox'\n";
  5. }
  6. # 匹配以"The"开头的字符串
  7. if ($text =~ /^The/) {
  8.     print "文本以'The'开头\n";
  9. }
  10. # 匹配以"dog"结尾的字符串
  11. if ($text =~ /dog$/) {
  12.     print "文本以'dog'结尾\n";
  13. }
  14. # 匹配"fox"或"dog"
  15. if ($text =~ /(fox|dog)/) {
  16.     print "文本中包含'fox'或'dog'\n";
  17. }
复制代码

2.4 字符类

字符类允许你指定一组字符中的任意一个:
  1. my $text = "The temperature is 25 degrees Celsius";
  2. # 匹配任意数字
  3. if ($text =~ /[0-9]/) {
  4.     print "文本中包含数字\n";
  5. }
  6. # 匹配任意大写字母
  7. if ($text =~ /[A-Z]/) {
  8.     print "文本中包含大写字母\n";
  9. }
  10. # 匹配任意小写字母
  11. if ($text =~ /[a-z]/) {
  12.     print "文本中包含小写字母\n";
  13. }
  14. # 使用预定义字符类
  15. if ($text =~ /\d/) {  # \d 等同于 [0-9]
  16.     print "文本中包含数字\n";
  17. }
  18. if ($text =~ /\w/) {  # \w 等同于 [a-zA-Z0-9_]
  19.     print "文本中包含单词字符\n";
  20. }
  21. if ($text =~ /\s/) {  # \s 匹配空白字符
  22.     print "文本中包含空白字符\n";
  23. }
复制代码

2.5 量词

量词用于指定匹配的次数:
  1. my $text = "The ISBN number is 978-3-16-148410-0";
  2. # 匹配一个或多个数字
  3. if ($text =~ /\d+/) {
  4.     print "文本中包含一个或多个连续数字\n";
  5. }
  6. # 匹配3个连续的数字
  7. if ($text =~ /\d{3}/) {
  8.     print "文本中包含3个连续数字\n";
  9. }
  10. # 匹配2到4个连续的数字
  11. if ($text =~ /\d{2,4}/) {
  12.     print "文本中包含2到4个连续数字\n";
  13. }
  14. # 匹配零个或多个数字
  15. if ($text =~ /\d*/) {
  16.     print "匹配零个或多个数字\n";
  17. }
  18. # 匹配零个或一个数字
  19. if ($text =~ /\d?/) {
  20.     print "匹配零个或一个数字\n";
  21. }
复制代码

3. 匹配操作符使用

3.1 匹配操作符m//

Perl中的匹配操作符m//用于检查字符串是否匹配某个模式。m可以省略,直接使用//。
  1. my $text = "Perl is a powerful programming language";
  2. # 使用m//进行匹配
  3. if ($text =~ m/Perl/) {
  4.     print "匹配成功\n";
  5. }
  6. # 省略m的写法
  7. if ($text =~ /language/) {
  8.     print "匹配成功\n";
  9. }
复制代码

3.2 修饰符

正则表达式可以带有各种修饰符,改变其行为:

• i:不区分大小写的匹配
• g:全局匹配,找到所有匹配项
• m:多行模式,使^和$匹配每行的开始和结束
• s:单行模式,使.匹配包括换行符在内的所有字符
• x:忽略模式中的空白和注释
• o:只编译一次模式
• e:将替换部分作为表达式执行

示例:
  1. my $text = "Perl is a powerful programming language\nPerl is also great for text processing";
  2. # 不区分大小写匹配
  3. if ($text =~ /PERL/i) {
  4.     print "不区分大小写匹配成功\n";
  5. }
  6. # 全局匹配
  7. my @matches = $text =~ /Perl/g;
  8. print "找到 " . scalar(@matches) . " 个'Perl'\n";
  9. # 多行模式
  10. my $multiline_text = "Line 1\nLine 2\nLine 3";
  11. if ($multiline_text =~ /^Line/m) {
  12.     print "多行模式匹配成功\n";
  13. }
  14. # 单行模式
  15. my $text_with_newlines = "Start\nMiddle\nEnd";
  16. if ($text_with_newlines =~ /Start.*End/s) {
  17.     print "单行模式匹配成功\n";
  18. }
  19. # 使用x修饰符添加注释
  20. my $pattern = qr/
  21.     \b      # 单词边界
  22.     \w+     # 一个或多个单词字符
  23.     \s      # 空白字符
  24.     \w+     # 一个或多个单词字符
  25.     \b      # 单词边界
  26. /x;
  27. if ($text =~ $pattern) {
  28.     print "带注释的模式匹配成功\n";
  29. }
复制代码

3.3 替换操作符s///

替换操作符s///用于在字符串中查找并替换匹配的文本:
  1. my $text = "The quick brown fox jumps over the lazy dog";
  2. # 简单替换
  3. $text =~ s/dog/cat/;
  4. print "$text\n";  # 输出: The quick brown fox jumps over the lazy cat
  5. # 不区分大小写的替换
  6. $text =~ s/the/THE/gi;
  7. print "$text\n";  # 输出: THE quick brown fox jumps over THE lazy cat
  8. # 使用捕获组
  9. $text =~ s/(quick) (brown)/$2 $1/;
  10. print "$text\n";  # 输出: THE brown quick fox jumps over THE lazy cat
  11. # 使用表达式进行替换
  12. $text =~ s/(\d+)/$1 * 2/eg;
  13. print "$text\n";  # 如果文本中有数字,将被乘以2
复制代码

3.4 转换操作符tr///

转换操作符tr///(或y///)用于逐个字符的转换:
  1. my $text = "The quick brown fox jumps over the lazy dog";
  2. # 转换为大写
  3. $text =~ tr/a-z/A-Z/;
  4. print "$text\n";  # 输出: THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG
  5. # 删除所有元音
  6. $text =~ tr/aeiou//d;
  7. print "$text\n";  # 输出: TH QCK BRWN FX MPS VR TH LZY DG
  8. # 计算特定字符的出现次数
  9. my $count = $text =~ tr/t/t/;
  10. print "字母't'出现了 $count 次\n";
复制代码

4. 输出格式化

4.1 print 函数

print是Perl中最基本的输出函数:
  1. my $name = "Alice";
  2. my $age = 30;
  3. # 简单输出
  4. print "Hello, World!\n";
  5. # 输出变量
  6. print "Name: $name, Age: $age\n";
  7. # 输出多个值
  8. print "Name: ", $name, ", Age: ", $age, "\n";
复制代码

4.2 printf 函数

printf函数提供格式化输出功能:
  1. my $name = "Bob";
  2. my $age = 25;
  3. my $height = 1.75;
  4. my $money = 1234.5678;
  5. # 格式化输出
  6. printf "Name: %s, Age: %d\n", $name, $age;
  7. # 指定宽度和对齐
  8. printf "Name: %-10s Age: %3d\n", $name, $age;
  9. # 浮点数格式化
  10. printf "Height: %.2f meters\n", $height;
  11. # 货币格式化
  12. printf "Money: \$%.2f\n", $money;
  13. # 科学计数法
  14. printf "Scientific: %e\n", $money;
复制代码

4.3 sprintf 函数

sprintf函数与printf类似,但它返回格式化后的字符串而不是直接输出:
  1. my $name = "Charlie";
  2. my $age = 35;
  3. # 格式化字符串
  4. my $formatted = sprintf "Name: %s, Age: %d", $name, $age;
  5. print "$formatted\n";
  6. # 在复杂表达式中使用
  7. my $message = "The user " . $name . " is " . sprintf("%d", $age) . " years old.";
  8. print "$message\n";
复制代码

4.4 here文档

here文档(heredoc)是一种方便的多行字符串输出方式:
  1. my $name = "David";
  2. my $email = "david@example.com";
  3. # 使用here文档
  4. print <<EOF;
  5. User Information:
  6. Name: $name
  7. Email: $email
  8. Registration Date: 2023-05-15
  9. EOF
  10. # 带引号的here文档(不进行变量插值)
  11. print <<'END';
  12. This is a literal text.
  13. Variables like $name or $email won't be interpolated.
  14. END
  15. # 使用缩进的here文档
  16. print <<~INDENT;
  17.     This is an indented here document.
  18.     The leading tabs will be removed.
  19.     Name: $name
  20.     Email: $email
  21. INDENT
复制代码

4.5 格式化输出(format)

Perl的format功能提供了一种类似报表的输出格式:
  1. # 定义格式
  2. format STDOUT =
  3. User Details:
  4. ================
  5. Name: @<<<<<<<<<<<<<<<<<<<<<<
  6. $name
  7. Age:  @##
  8. $age
  9. Email: @<<<<<<<<<<<<<<<<<<<<<<
  10. $email
  11. ================
  12. .
  13. my $name = "Eve";
  14. my $age = 28;
  15. my $email = "eve@example.com";
  16. # 写入格式
  17. write;
复制代码

5. 错误处理

5.1 正则表达式匹配失败处理

当正则表达式匹配失败时,Perl不会产生错误,但我们可以通过检查返回值来处理:
  1. my $text = "This is a sample text";
  2. my $pattern = "missing";
  3. # 检查匹配是否成功
  4. if ($text =~ /$pattern/) {
  5.     print "匹配成功: $&\n";
  6. } else {
  7.     print "匹配失败: 未找到'$pattern'\n";
  8. }
复制代码

5.2 使用eval处理错误

eval块可以捕获运行时错误:
  1. my $text = "Sample text";
  2. my $pattern = "[invalid regex";
  3. # 使用eval捕获正则表达式错误
  4. eval {
  5.     if ($text =~ /$pattern/) {
  6.         print "匹配成功\n";
  7.     } else {
  8.         print "匹配失败\n";
  9.     }
  10. };
  11. if ($@) {
  12.     print "正则表达式错误: $@\n";
  13. }
复制代码

5.3 警告处理

使用warnings模块可以获取详细的警告信息:
  1. use warnings;
  2. my $text = "Sample text";
  3. my $pattern = "[invalid regex";
  4. # 这将产生警告
  5. if ($text =~ /$pattern/) {
  6.     print "匹配成功\n";
  7. } else {
  8.     print "匹配失败\n";
  9. }
复制代码

5.4 自定义错误消息

可以自定义错误处理函数:
  1. sub regex_match {
  2.     my ($text, $pattern) = @_;
  3.    
  4.     eval {
  5.         if ($text =~ /$pattern/) {
  6.             print "匹配成功: $&\n";
  7.             return 1;
  8.         } else {
  9.             print "匹配失败: 未找到模式\n";
  10.             return 0;
  11.         }
  12.     };
  13.    
  14.     if ($@) {
  15.         print "错误: 无效的正则表达式 '$pattern' - $@\n";
  16.         return -1;
  17.     }
  18. }
  19. my $text = "This is a sample text";
  20. regex_match($text, "sample");  # 成功匹配
  21. regex_match($text, "missing");  # 匹配失败
  22. regex_match($text, "[invalid");  # 正则表达式错误
复制代码

6. 性能优化

6.1 预编译正则表达式

对于重复使用的正则表达式,预编译可以提高性能:
  1. use Benchmark qw(timethese);
  2. my $text = "The quick brown fox jumps over the lazy dog" x 1000;
  3. my $pattern = "fox";
  4. # 普通匹配
  5. sub normal_match {
  6.     my $count = 0;
  7.     for my $i (1..1000) {
  8.         $count++ if $text =~ /$pattern/;
  9.     }
  10.     return $count;
  11. }
  12. # 预编译正则表达式
  13. sub precompiled_match {
  14.     my $count = 0;
  15.     my $regex = qr/$pattern/;
  16.     for my $i (1..1000) {
  17.         $count++ if $text =~ /$regex/;
  18.     }
  19.     return $count;
  20. }
  21. # 性能比较
  22. timethese(100, {
  23.     'Normal' => \&normal_match,
  24.     'Precompiled' => \&precompiled_match,
  25. });
复制代码

6.2 避免贪婪匹配

贪婪匹配(.*)可能导致性能问题,特别是在长文本中:
  1. my $html = '<div>Content 1</div><div>Content 2</div><div>Content 3</div>';
  2. # 贪婪匹配(可能效率较低)
  3. if ($html =~ /<div>.*<\/div>/s) {
  4.     print "贪婪匹配: $&\n";
  5. }
  6. # 非贪婪匹配(通常更高效)
  7. if ($html =~ /<div>.*?<\/div>/s) {
  8.     print "非贪婪匹配: $&\n";
  9. }
  10. # 更精确的匹配(最高效)
  11. if ($html =~ /<div>[^<]*<\/div>/) {
  12.     print "精确匹配: $&\n";
  13. }
复制代码

6.3 使用字符类而非选择

字符类比选择操作符|更高效:
  1. my $text = "The quick brown fox jumps over the lazy dog";
  2. # 使用选择(效率较低)
  3. if ($text =~ /(cat|dog|fox)/) {
  4.     print "找到动物: $1\n";
  5. }
  6. # 使用字符类(效率较高)
  7. if ($text =~ /([cdf]ox|[acd]og|[cat]at)/) {
  8.     print "找到动物: $1\n";
  9. }
复制代码

6.4 避免不必要的捕获

如果不需要捕获组,使用非捕获组可以提高性能:
  1. my $text = "The quick brown fox jumps over the lazy dog";
  2. # 使用捕获组
  3. if ($text =~ /(quick) (brown) (fox)/) {
  4.     print "捕获: $1, $2, $3\n";
  5. }
  6. # 使用非捕获组
  7. if ($text =~ /(?:quick) (?:brown) (fox)/) {
  8.     print "只捕获了: $1\n";
  9. }
复制代码

6.5 使用适当的锚点

使用适当的锚点(^,$,\b)可以提高匹配效率:
  1. my $text = "The quick brown fox jumps over the lazy dog";
  2. # 低效的匹配
  3. if ($text =~ /.*fox.*/) {
  4.     print "找到'fox'\n";
  5. }
  6. # 高效的匹配
  7. if ($text =~ /fox/) {
  8.     print "找到'fox'\n";
  9. }
  10. # 如果知道位置,使用锚点
  11. if ($text =~ /^The/) {
  12.     print "以'The'开头\n";
  13. }
  14. if ($text =~ /dog$/) {
  15.     print "以'dog'结尾\n";
  16. }
  17. if ($text =~ /\bfox\b/) {
  18.     print "找到完整的单词'fox'\n";
  19. }
复制代码

7. 实战应用

7.1 日志文件分析

分析Web服务器日志文件,提取特定信息:
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. # 假设日志格式为:IP - - [date] "request" status size
  5. my $log_file = 'access.log';
  6. my %status_codes;
  7. my %top_ips;
  8. my $total_requests = 0;
  9. open my $fh, '<', $log_file or die "无法打开日志文件: $!";
  10. while (my $line = <$fh>) {
  11.     # 解析日志行
  12.     if ($line =~ /^(\S+) \S+ \S+ \[([^\]]+)\] "([^"]+)" (\d+) (\d+)$/) {
  13.         my ($ip, $date, $request, $status, $size) = ($1, $2, $3, $4, $5);
  14.         
  15.         # 统计状态码
  16.         $status_codes{$status}++;
  17.         
  18.         # 统计IP访问次数
  19.         $top_ips{$ip}++;
  20.         
  21.         $total_requests++;
  22.     }
  23. }
  24. close $fh;
  25. # 输出统计结果
  26. print "总请求数: $total_requests\n\n";
  27. print "状态码统计:\n";
  28. foreach my $status (sort keys %status_codes) {
  29.     printf "  %s: %d (%.2f%%)\n", $status, $status_codes{$status},
  30.            ($status_codes{$status} / $total_requests) * 100;
  31. }
  32. print "\nTop 10 IP地址:\n";
  33. my $count = 0;
  34. foreach my $ip (sort { $top_ips{$b} <=> $top_ips{$a} } keys %top_ips) {
  35.     last if $count++ >= 10;
  36.     printf "  %s: %d 次 (%.2f%%)\n", $ip, $top_ips{$ip},
  37.            ($top_ips{$ip} / $total_requests) * 100;
  38. }
复制代码

7.2 数据提取和转换

从HTML文档中提取数据并转换为CSV格式:
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. # 假设HTML格式为:
  5. # <div class="product">
  6. #   <h2>Product Name</h2>
  7. #   <span class="price">$19.99</span>
  8. #   <p class="description">Product description</p>
  9. # </div>
  10. my $html = do { local $/; <DATA> };  # 从__DATA__读取HTML内容
  11. my @products;
  12. # 提取产品信息
  13. while ($html =~ /<div class="product">\s*<h2>([^<]+)<\/h2>\s*<span class="price">([^<]+)<\/span>\s*<p class="description">([^<]+)<\/p>\s*<\/div>/sg) {
  14.     my ($name, $price, $description) = ($1, $2, $3);
  15.    
  16.     # 清理数据
  17.     $name =~ s/^\s+|\s+$//g;
  18.     $price =~ s/^\s+|\s+$//g;
  19.     $description =~ s/^\s+|\s+$//g;
  20.    
  21.     push @products, {
  22.         name => $name,
  23.         price => $price,
  24.         description => $description
  25.     };
  26. }
  27. # 输出CSV
  28. print "Name,Price,Description\n";
  29. foreach my $product (@products) {
  30.     # 转义CSV中的特殊字符
  31.     my $name_csv = $product->{name};
  32.     $name_csv =~ s/"/""/g;
  33.     $name_csv = ""$name_csv"" if $name_csv =~ /,/;
  34.     my $price_csv = $product->{price};
  35.     $price_csv =~ s/"/""/g;
  36.     $price_csv = ""$price_csv"" if $price_csv =~ /,/;
  37.     my $desc_csv = $product->{description};
  38.     $desc_csv =~ s/"/""/g;
  39.     $desc_csv = ""$desc_csv"" if $desc_csv =~ /,/;
  40.     print "$name_csv,$price_csv,$desc_csv\n";
  41. }
  42. __DATA__
  43. <div class="product">
  44.   <h2>Product 1</h2>
  45.   <span class="price">$19.99</span>
  46.   <p class="description">This is the first product</p>
  47. </div>
  48. <div class="product">
  49.   <h2>Product 2</h2>
  50.   <span class="price">$29.99</span>
  51.   <p class="description">This is the second product</p>
  52. </div>
  53. <div class="product">
  54.   <h2>Product 3</h2>
  55.   <span class="price">$39.99</span>
  56.   <p class="description">This is the third product</p>
  57. </div>
复制代码

7.3 文本批量处理

批量处理文本文件,进行搜索替换:
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. use File::Find;
  5. use File::Copy;
  6. # 配置参数
  7. my $directory = './documents';  # 处理的目录
  8. my $file_pattern = '\.txt$';    # 处理的文件模式
  9. my $backup = 1;                 # 是否创建备份
  10. my $backup_ext = '.bak';        # 备份文件扩展名
  11. # 替换规则
  12. my @replacements = (
  13.     {
  14.         pattern => qr/\b(company name)\b/i,
  15.         replacement => 'ACME Corporation'
  16.     },
  17.     {
  18.         pattern => qr/\b(contact email)\b/i,
  19.         replacement => 'info@acme.com'
  20.     },
  21.     {
  22.         pattern => qr/\b(phone number)\b/i,
  23.         replacement => '+1 (555) 123-4567'
  24.     }
  25. );
  26. # 处理文件
  27. find(\&process_file, $directory);
  28. sub process_file {
  29.     my $file = $File::Find::name;
  30.    
  31.     # 只处理匹配模式的文件
  32.     return unless $file =~ /$file_pattern/;
  33.    
  34.     # 跳过备份文件
  35.     return if $backup && $file =~ /$backup_ext$/;
  36.    
  37.     print "处理文件: $file\n";
  38.    
  39.     # 读取文件内容
  40.     open my $fh, '<', $file or die "无法打开文件 $file: $!";
  41.     my $content = do { local $/; <$fh> };
  42.     close $fh;
  43.    
  44.     # 记录原始内容用于比较
  45.     my $original_content = $content;
  46.    
  47.     # 应用所有替换规则
  48.     foreach my $rule (@replacements) {
  49.         $content =~ s/$rule->{pattern}/$rule->{replacement}/gi;
  50.     }
  51.    
  52.     # 如果内容有变化,则写入文件
  53.     if ($content ne $original_content) {
  54.         # 创建备份
  55.         if ($backup) {
  56.             my $backup_file = $file . $backup_ext;
  57.             copy($file, $backup_file) or die "无法创建备份文件: $!";
  58.             print "  创建备份: $backup_file\n";
  59.         }
  60.         
  61.         # 写入新内容
  62.         open $fh, '>', $file or die "无法写入文件 $file: $!";
  63.         print $fh $content;
  64.         close $fh;
  65.         
  66.         print "  文件已更新\n";
  67.     } else {
  68.         print "  无需更改\n";
  69.     }
  70. }
复制代码

7.4 数据验证

使用正则表达式验证各种格式的数据:
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. sub validate_email {
  5.     my ($email) = @_;
  6.    
  7.     # 基本电子邮件验证
  8.     return $email =~ /^[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\.[a-zA-Z]{2,}$/;
  9. }
  10. sub validate_url {
  11.     my ($url) = @_;
  12.    
  13.     # 基本URL验证
  14.     return $url =~ /^(https?:\/\/)?([\da-z\.-]+)\.([a-z\.]{2,6})([\/\w \.-]*)*\/?$/;
  15. }
  16. sub validate_phone {
  17.     my ($phone) = @_;
  18.    
  19.     # 基本电话号码验证(支持多种格式)
  20.     return $phone =~ /^(\+\d{1,2}\s)?\(?\d{3}\)?[\s.-]?\d{3}[\s.-]?\d{4}$/;
  21. }
  22. sub validate_date {
  23.     my ($date) = @_;
  24.    
  25.     # 日期验证(YYYY-MM-DD格式)
  26.     if ($date =~ /^(\d{4})-(\d{2})-(\d{2})$/) {
  27.         my ($year, $month, $day) = ($1, $2, $3);
  28.         
  29.         # 基本范围检查
  30.         return 0 if $year < 1900 || $year > 2100;
  31.         return 0 if $month < 1 || $month > 12;
  32.         return 0 if $day < 1 || $day > 31;
  33.         
  34.         # 更详细的日期验证(考虑闰年等)
  35.         my @days_in_month = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  36.         
  37.         # 闰年检查
  38.         if ($month == 2) {
  39.             if (($year % 400 == 0) || ($year % 100 != 0 && $year % 4 == 0)) {
  40.                 return $day <= 29;
  41.             } else {
  42.                 return $day <= 28;
  43.             }
  44.         }
  45.         
  46.         return $day <= $days_in_month[$month-1];
  47.     }
  48.    
  49.     return 0;
  50. }
  51. # 测试验证函数
  52. my @emails = (
  53.     'user@example.com',
  54.     'invalid.email',
  55.     'another@example.org'
  56. );
  57. my @urls = (
  58.     'https://www.example.com',
  59.     'http://example.org/path/to/page',
  60.     'ftp://example.com',
  61.     'not_a_url'
  62. );
  63. my @phones = (
  64.     '+1 (555) 123-4567',
  65.     '555-123-4567',
  66.     '555.123.4567',
  67.     '123-456-7890',
  68.     'invalid-phone'
  69. );
  70. my @dates = (
  71.     '2023-05-15',
  72.     '2023-02-29',  # 无效(2023年不是闰年)
  73.     '2020-02-29',  # 有效(2020年是闰年)
  74.     '2023-13-01',  # 无效(月份无效)
  75.     '2023-05-32',  # 无效(日期无效)
  76.     'invalid-date'
  77. );
  78. print "电子邮件验证:\n";
  79. foreach my $email (@emails) {
  80.     printf "  %-25s: %s\n", $email, validate_email($email) ? "有效" : "无效";
  81. }
  82. print "\nURL验证:\n";
  83. foreach my $url (@urls) {
  84.     printf "  %-35s: %s\n", $url, validate_url($url) ? "有效" : "无效";
  85. }
  86. print "\n电话号码验证:\n";
  87. foreach my $phone (@phones) {
  88.     printf "  %-20s: %s\n", $phone, validate_phone($phone) ? "有效" : "无效";
  89. }
  90. print "\n日期验证:\n";
  91. foreach my $date (@dates) {
  92.     printf "  %-15s: %s\n", $date, validate_date($date) ? "有效" : "无效";
  93. }
复制代码

7.5 高级文本处理

使用正则表达式进行复杂的文本处理和分析:
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. # 示例:从非结构化文本中提取结构化信息
  5. my $text = <<'TEXT';
  6. Customer Order Information
  7. Order ID: ORD-2023-001
  8. Date: May 15, 2023
  9. Customer: John Smith
  10. Email: john.smith@example.com
  11. Items:
  12. 1. Product A - $19.99 (Qty: 2)
  13. 2. Product B - $29.99 (Qty: 1)
  14. 3. Product C - $9.99 (Qty: 3)
  15. Shipping Address:
  16. 123 Main Street
  17. Anytown, ST 12345
  18. United States
  19. Payment Method: Credit Card (****-****-****-1234)
  20. Total Amount: $79.95
  21. Order ID: ORD-2023-002
  22. Date: May 16, 2023
  23. Customer: Jane Doe
  24. Email: jane.doe@example.com
  25. Items:
  26. 1. Product X - $49.99 (Qty: 1)
  27. 2. Product Y - $15.99 (Qty: 2)
  28. Shipping Address:
  29. 456 Oak Avenue
  30. Sometown, ST 67890
  31. United States
  32. Payment Method: PayPal
  33. Total Amount: $81.97
  34. TEXT
  35. # 提取订单信息
  36. my @orders;
  37. while ($text =~ /
  38.     Order\ ID:\ ([^\n]+)\n
  39.     Date:\ ([^\n]+)\n
  40.     Customer:\ ([^\n]+)\n
  41.     Email:\ ([^\n]+)\n
  42.     \n
  43.     Items:\n
  44.     ((?:\d+\..+\n)+)
  45.     \n
  46.     Shipping\ Address:\n
  47.     ([^\n]+)\n
  48.     ([^\n]+)\n
  49.     ([^\n]+)\n
  50.     \n
  51.     Payment\ Method:\ ([^\n]+)\n
  52.     Total\ Amount:\ ([^\n]+)
  53. /gx) {
  54.    
  55.     my ($order_id, $date, $customer, $email, $items_text, $addr1, $addr2, $addr3, $payment, $total) =
  56.         ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10);
  57.    
  58.     # 提取订单项
  59.     my @items;
  60.     while ($items_text =~ /(\d+)\.\ ([^-]+)\ -\ \$(\d+\.\d+)\ \(Qty:\ (\d+)\)/g) {
  61.         push @items, {
  62.             number => $1,
  63.             name => $2,
  64.             price => $3,
  65.             quantity => $4
  66.         };
  67.     }
  68.    
  69.     push @orders, {
  70.         order_id => $order_id,
  71.         date => $date,
  72.         customer => $customer,
  73.         email => $email,
  74.         items => \@items,
  75.         address => {
  76.             line1 => $addr1,
  77.             line2 => $addr2,
  78.             line3 => $addr3
  79.         },
  80.         payment_method => $payment,
  81.         total => $total
  82.     };
  83. }
  84. # 输出提取的信息
  85. foreach my $order (@orders) {
  86.     print "订单ID: " . $order->{order_id} . "\n";
  87.     print "日期: " . $order->{date} . "\n";
  88.     print "客户: " . $order->{customer} . "\n";
  89.     print "邮箱: " . $order->{email} . "\n";
  90.     print "订单项:\n";
  91.    
  92.     foreach my $item (@{$order->{items}}) {
  93.         print "  " . $item->{number} . ". " . $item->{name} .
  94.               " - $" . $item->{price} . " (数量: " . $item->{quantity} . ")\n";
  95.     }
  96.    
  97.     print "配送地址:\n";
  98.     print "  " . $order->{address}->{line1} . "\n";
  99.     print "  " . $order->{address}->{line2} . "\n";
  100.     print "  " . $order->{address}->{line3} . "\n";
  101.    
  102.     print "付款方式: " . $order->{payment_method} . "\n";
  103.     print "总金额: " . $order->{total} . "\n";
  104.     print "\n";
  105. }
  106. # 生成汇总报告
  107. my $total_revenue = 0;
  108. my %product_sales;
  109. my %customer_orders;
  110. foreach my $order (@orders) {
  111.     # 计算总收入
  112.     $order->{total} =~ /\$(\d+\.\d+)/;
  113.     $total_revenue += $1;
  114.    
  115.     # 统计产品销售
  116.     foreach my $item (@{$order->{items}}) {
  117.         $product_sales{$item->{name}} ||= {quantity => 0, revenue => 0};
  118.         $product_sales{$item->{name}}->{quantity} += $item->{quantity};
  119.         $product_sales{$item->{name}}->{revenue} += $item->{price} * $item->{quantity};
  120.     }
  121.    
  122.     # 统计客户订单
  123.     $customer_orders{$order->{customer}}++;
  124. }
  125. # 输出汇总报告
  126. print "=== 销售汇总报告 ===\n\n";
  127. printf "总订单数: %d\n", scalar(@orders);
  128. printf "总收入: \$%.2f\n\n", $total_revenue;
  129. print "产品销售排行:\n";
  130. my $product_count = 0;
  131. foreach my $product (sort { $product_sales{$b}->{revenue} <=> $product_sales{$a}->{revenue} } keys %product_sales) {
  132.     last if $product_count++ >= 5;  # 只显示前5名
  133.     printf "  %-15s 数量: %d, 收入: \$%.2f\n",
  134.            $product,
  135.            $product_sales{$product}->{quantity},
  136.            $product_sales{$product}->{revenue};
  137. }
  138. print "\n客户订单排行:\n";
  139. my $customer_count = 0;
  140. foreach my $customer (sort { $customer_orders{$b} <=> $customer_orders{$a} } keys %customer_orders) {
  141.     last if $customer_count++ >= 5;  # 只显示前5名
  142.     printf "  %-15s 订单数: %d\n", $customer, $customer_orders{$customer};
  143. }
复制代码

8. 结论

Perl的正则表达式和输出处理功能为文本处理提供了强大而灵活的工具。通过掌握基础正则表达式、匹配操作符、输出格式化、错误处理和性能优化等技巧,你可以解决各种复杂的文本处理问题,提高编程效率。

在实际应用中,Perl的正则表达式可以用于日志分析、数据提取、文本处理、数据验证等多种场景。合理使用正则表达式,结合适当的错误处理和性能优化技巧,可以构建高效、可靠的文本处理解决方案。

希望本文能够帮助你深入理解Perl的匹配输出功能,并在实际工作中灵活应用这些技术,解决各种文本处理难题。
「七転び八起き(ななころびやおき)」
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则