Perl XML解析代码修正求助：无法提取firstName字段

无法正确解析XML数据，编写的Perl代码本应从数据中提取lastName、firstName和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];
        $u = $j-3;
        $first[$i]=$lines[$s]; 
        $s--;
        $last[$i] = $lines[$u];
        #$j = $j+3;
        #$last[$i]= $lines[$j];
        #$j++;
        #$first[$i] = $lines[$j];
        $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/<.*>(.*)<.*>/$1/;
  $first[$u]=$1;  
  $u++;
  }
my $m = 0;
foreach(@last)
{
  $last[$m] =~s/<.*>(.*)<.*>/$1/;
  $last[$m] = $1;    
  $m++;
  }
my $q=@line;
open(FILE,">Hayathi.txt")|| die "can't open";
my $p;

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

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

问题分析 #

1. XML解析方式错误：用逐行读取+正则表达式解析XML极不可靠，XML结构可能存在换行、缩进、嵌套等变化，正则无法稳定匹配所有合法的XML格式。
2. firstName提取逻辑完全错误：代码中$first[$i]=$lines[$s]; $s--;的逻辑不符合XML结构的位置关系，初始s为0，每次赋值后s变为负数，导致取到空元素或错误内容。
3. 未声明变量：$u在未用my声明的情况下直接使用，在use strict模式下会触发编译错误，导致代码无法正常运行。
4. 逻辑冗余混乱：存在重复变量声明、数组索引逻辑混乱等问题，进一步加剧错误。

修正方案 #

推荐方案：使用专业XML解析模块（XML::LibXML） #

Perl有成熟的XML解析模块，处理XML比正则可靠得多。以下是使用XML::LibXML的示例代码：

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

# 读取XML文件
my $parser = XML::LibXML->new();
my $doc = $parser->parse_file('data.xml') or die "无法解析XML文件: $!";

# 打开输出文件
open(my $out_fh, '>', 'Hayathi.txt') or die "无法打开输出文件: $!";

# 假设XML中每个条目节点名为'person'（需根据实际XML结构调整）
foreach my $person ($doc->findnodes('//person')) {
    my $lastName = $person->findvalue('./lastName');
    my $firstName = $person->findvalue('./firstName');
    my $email = $person->findvalue('./email'); # 对应原代码中的@字段
    my $affiliation = $person->findvalue('./affiliation');

    # 输出到文件
    print $out_fh "$email  $lastName,$firstName   $affiliation\n";
}

close($out_fh);

注意：需根据实际XML结构调整节点路径（如//person、./lastName等）。若未安装XML::LibXML，可通过cpan XML::LibXML命令安装。

临时修复原代码（不推荐，仅作应急） #

若必须沿用逐行读取方式，需修正firstName提取逻辑并修复变量问题：

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

my @lines;
my $ct = 1 ;
print "Enter the start position:-";
chomp(my $start = <STDIN>);
print "Enter the end position:-";
chomp(my $end = <STDIN>);

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 = scalar @lines;

        while($j < $l) {
            if ($lines[$j] =~ m/@/) {
                $line[$i] = $lines[$j];
                # 假设lastName在@行的前3行，firstName在@行的前2行（需根据实际XML结构调整）
                my $u = $j - 3;
                my $v = $j - 2;
                $last[$i] = $lines[$u];
                $first[$i] = $lines[$v];
                $i++;
            }
            $j++;
        }
        
        my $k = 0;
        foreach my $entry (@line) {
            if ($entry =~ s/<.*>(.* )(.*@.*)<.*>/$2/) {
                $affi[$k] = $1;
                $line[$k] = $2;
                $line[$k] =~ s/\.$//;
            }
            $k++;
        }
        
        my $u = 0;
        foreach my $fname (@first) {
            if ($fname =~ s/<.*>(.*)<.*>/$1/) {
                $first[$u] = $1;
            }
            $u++;
        }
        
        my $m = 0;
        foreach my $lname (@last) {
            if ($lname =~ s/<.*>(.*)<.*>/$1/) {
                $last[$m] = $1;
            }
            $m++;
        }
        
        open(my $out_fh, '>', 'Hayathi.txt') or die "can't open Hayathi.txt: $!";
        my $q = scalar @line;
        for(my $p = 0; $p < $q; $p++) {  
            print $out_fh "$line[$p]  $last[$p],$first[$p]   $affi[$p]\n";  
        } 
        close($out_fh);
    }
    $ct++;
}
close($fh);

注意：此方案依赖XML每行的固定位置，若XML结构稍有变化就会失效，强烈建议使用专业XML模块。

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