求助：修复Perl提取XML数据时无法获取firstName的问题

我需要用Perl提取XML文件中的作者数据，XML里的作者信息格式如下：

<authorList>
<author>
<fullName>Oliver LA</fullName>
<firstName>L A</firstName>
<lastName>Oliver</lastName>
<initials>LA</initials>
<authorAffiliationDetailsList>
<authorAffiliation>
<affiliation>University of Liverpool, Liverpool, UK. Electronic address: l.oliver@liverpool.ac.uk.</affiliation>
</authorAffiliation>
</authorAffiliationDetailsList>
</author>
<author>
<fullName>Hutton DP</fullName>
<firstName>D P</firstName>
<lastName>Hutton</lastName>
<initials>DP</initials>
<authorAffiliationDetailsList>
<authorAffiliation>
<affiliation>North West Radiotherapy Operational Delivery Network, The Christie Hospital, Manchester, UK; University of Liverpool, Liverpool, UK.</affiliation>
</authorAffiliation>
</authorAffiliationDetailsList>
</author>
<author>
<fullName>Hall T</fullName>
<firstName>T</firstName>
<lastName>Hall</lastName>
<initials>T</initials>
<authorAffiliationDetailsList>
<authorAffiliation>
<affiliation>North West Radiotherapy Operational Delivery Network, The Christie Hospital, Manchester, UK.</affiliation>
</authorAffiliation>
</authorAffiliationDetailsList>
</author>
<author>
<fullName>Cain M</fullName>
<firstName>M</firstName>
<lastName>Cain</lastName>
<initials>M</initials>
<authorAffiliationDetailsList>
<authorAffiliation>
<affiliation>Clatterbridge Cancer Centre, Liverpool, UK.</affiliation>
</authorAffiliation>
</authorAffiliationDetailsList>
</author>
<author>
<fullName>Bates M</fullName>
<firstName>M</firstName>
<lastName>Bates</lastName>
<initials>M</initials>
<authorAffiliationDetailsList>
<authorAffiliation>
<affiliation>East of England Radiotherapy Network, Norfolk & Norwich University Hospital, Norwich, UK.</affiliation>
</authorAffiliation>
</authorAffiliationDetailsList>
</author>
<author>
<fullName>Cree A</fullName>
<firstName>A</firstName>
<lastName>Cree</lastName>
<initials>A</initials>
<authorAffiliationDetailsList>
<authorAffiliation>
<affiliation>Clatterbridge Cancer Centre, Liverpool, UK.</affiliation>
</authorAffiliation>
</authorAffiliationDetailsList>
</author>
<author>
<fullName>Mullen E</fullName>
<firstName>E</firstName>
<lastName>Mullen</lastName>
<initials>E</initials>
<authorAffiliationDetailsList>
<authorAffiliation>
<affiliation>Clatterbridge Cancer Centre, Liverpool, UK.</affiliation>
</authorAffiliation>
</authorAffiliationDetailsList>
</author>
</authorList>

要求输出格式为Email,firstName,lastName,affiliation并导出到文本文件。我写了下面的Perl代码，但现在只能输出email,,lastname,affiliation，firstName无法正确获取：

#!usr/bin/perl
use strict;
use warnings;
open(FILEHANDLE, "<data.xml")|| die "Can't open";
my @line;
my @affi;

my @lines;
my $ct =1 ;
print "Enter the start position:-";

my $start= <STDIN>;
print "Enter the end position:-";


my $end = <STDIN>;

print "Processing your data...\n";
my $i =0;
my $t =0;
while(<FILEHANDLE>)
{
    if($ct>$end)
    {
       close(FILEHANDLE);
       exit;
       
    }
    if($ct>=$start)
    {
       $lines[$t] = $_;
       $t++;
     }
     
     if($ct == $end)
     {
    my $i = 0;
    my $j = 0;
    my @last;
    my @first;
    my $l = @lines;
    my $s = 0;

while($j<$l)
{
    if ($lines[$j] =~m/@/)
    {
        $line[$i] = $lines[$j];
        $s = $j-3;
        $first[$i]=$lines[$s]; 
        $s--;
        $last[$i] = $lines[$s];
        $i++;
    }
$j++;
}
my $k = 0;
foreach(@line)
{
  $line[$k] =~ s/<.*>(.* )(.*@.*)<.*>/$2/;
  $affi[$k] = $1;
  $line[$k] = $2;
    $line[$k] =~ s/\.$//;
    
    
    $k++;
  }

my $u = 0;
foreach(@first)
{
  $first[$u] =~s/<firstName>(.*)<.*>/$1/;
  $first[$u]=$l;  
  $u++
  }
my $m = 0;
foreach(@last)
{
  $last[$m] =~s/<lastName>(.*)<.*>/$1/;
  $last[$m] = $1;    
  $m++
  }
my $q=@line;
open(FILE,">RAVI.txt")|| die "can't open";
my $p;

for($p =0; $p<$q; $p++)
{  
  print FILE "$line[$p],$first[$p],$last[$p],$affi[$p]\n";
} 

close(FILE);
     }
     
  
  $ct++;
  }

原代码核心错误 #

处理firstName的循环里，$first[$u]=$l;这行完全覆盖了之前正则匹配到的firstName值，把它改成了数组@lines的长度，这就是firstName为空的直接原因。

修正后的代码 #

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

open(my $fh, "<", "data.xml") || die "Can't open data.xml: $!";
my @line;
my @affi;
my @lines;
my $ct = 1;

print "Enter the start position:-";
my $start = <STDIN>;
chomp $start; # 去掉输入的换行符，避免数值判断错误
print "Enter the end position:-";
my $end = <STDIN>;
chomp $end;

print "Processing your data...\n";
my $t = 0;

while(<$fh>) {
    if($ct > $end) {
        close($fh);
        exit;
    }
    if($ct >= $start) {
        $lines[$t] = $_;
        $t++;
    }
     
    if($ct == $end) {
        my $i = 0;
        my $j = 0;
        my @last;
        my @first;
        my $l = @lines;

        while($j < $l) {
            if ($lines[$j] =~ m/@/) {
                $line[$i] = $lines[$j];
                # 定位firstName和lastName的行位置
                my $s = $j - 3;
                $first[$i] = $lines[$s]; 
                $s--;
                $last[$i] = $lines[$s];
                $i++;
            }
            $j++;
        }

        # 处理Email和affiliation
        my $k = 0;
        foreach my $email_line (@line) {
            if ($email_line =~ s/<.*>(.*?)([^\s]+@[^\s]+)<.*>/$2/) {
                $affi[$k] = $1;
                $line[$k] =~ s/\.$//; # 去掉邮箱末尾的点
            }
            $k++;
        }

        # 处理firstName
        my $u = 0;
        foreach my $first_line (@first) {
            if ($first_line =~ s/<firstName>(.*?)<\/firstName>/$1/) {
                $first[$u] = $1;
            }
            $u++;
        }

        # 处理lastName
        my $m = 0;
        foreach my $last_line (@last) {
            if ($last_line =~ s/<lastName>(.*?)<\/lastName>/$1/) {
                $last[$m] = $1;
            }
            $m++;
        }

        # 输出到文件
        open(my $out_fh, ">", "RAVI.txt") || die "Can't open RAVI.txt: $!";
        my $q = @line;
        for(my $p = 0; $p < $q; $p++) {  
            # 处理字段缺失的情况，默认空字符串
            my $email = $line[$p] // '';
            my $first_name = $first[$p] // '';
            my $last_name = $last[$p] // '';
            my $affiliation = $affi[$p] // '';
            # 去掉内容末尾的换行和多余空格
            s/\s+$// for ($email, $first_name, $last_name, $affiliation);
            print $out_fh "$email,$first_name,$last_name,$affiliation\n";
        } 
        close($out_fh);
    }
    $ct++;
}

关键修复点 #

1. 移除错误覆盖：删掉$first[$u]=$l;这行，保留正则匹配到的firstName值。
2. 严谨的正则匹配：修改XML标签匹配规则，用<\/firstName>明确匹配闭合标签，同时用.*?非贪婪匹配避免内容过长时的误匹配。
3. 清理输入换行：对$start和$end执行chomp，避免换行符导致的数值判断错误。
4. 健壮性优化：添加变量默认值处理（// ''），避免数组元素缺失时出现未定义值；改用词法文件句柄（$fh），符合Perl现代写法。
5. 字段格式化：用s/\s+$//清理各字段末尾的换行和空格，输出更整洁。

更稳健的方案：使用XML解析模块 #

通过行位置匹配XML内容非常脆弱，只要XML格式稍有变化（比如换行、缩进调整），代码就会失效。推荐使用Perl的专业XML解析模块XML::LibXML，示例如下：

#!usr/bin/perl
use strict;
use warnings;
use XML::LibXML;

my $parser = XML::LibXML->new();
my $doc = $parser->parse_file('data.xml');

open(my $out_fh, ">", "RAVI.txt") || die "Can't open RAVI.txt: $!";
# 可选添加表头
print $out_fh "Email,firstName,lastName,affiliation\n";

foreach my $author ($doc->findnodes('//author')) {
    my $first_name = $author->findvalue('./firstName');
    my $last_name = $author->findvalue('./lastName');
    my $affiliation = $author->findvalue('./authorAffiliationDetailsList/authorAffiliation/affiliation');
    my $email = '';
    
    # 从affiliation中提取邮箱
    if ($affiliation =~ /([^\s]+@[^\s]+)/) {
        $email = $1;
        $email =~ s/\.$//;
        # 把邮箱信息从affiliation中移除
        $affiliation =~ s/ Electronic address: [^\s]+@[^\s]+//;
    }
    
    # 清理字段多余空格
    s/\s+$// for ($email, $first_name, $last_name, $affiliation);
    print $out_fh "$email,$first_name,$last_name,$affiliation\n";
}
close($out_fh);

这个方法完全不依赖XML的换行和格式，只要XML结构正确就能稳定提取数据，适合处理大量XML文件。

内容的提问来源于stack exchange，提问作者ravi.g teja