Xml 如何抓住所有的“机会”；“警告”；在Perl中调用子例程

我正在使用一个细枝解析器来执行几个帐户验证检查，并希望捕获在我的“process\u account”子例程中发生的所有“warn”调用（以便显示每个帐户显示的警告数量/etc）

下面是我的一段代码

use strict;
use warnings;
use XML::Twig; 
use Time::Piece; 

use vars qw/$user/; #User Choice (grabbed via another sub routine)

    sub process_account {
        my ( $twig, $account ) = @_;
        print "Account Name: ", $account -> first_child_text('Id'), "\tAccount Status: ", ($account -> first_child_text('Locked') eq 'false' ? "Not Locked" : "LOCKED"), "\n";
        my $logindate = join ( "-", map { $account -> first_child('LastLoginDate')->att($_) // 0 } qw ( year month day-of-month) );
        my $createdate = join ( "-", map { $account -> first_child('CreationDate')->att($_) // 0 } qw ( year month day-of-month) );

        if ($user == 1){
            #Checking if the LoginID length is between 7-15 & it only contains alphanumeric characters (the length limit will be changed as per the necessity)
            if ( $account -> first_child_text('Id') !~ /^[A-Za-z0-9_-]+$/ || 7 > length $account -> first_child_text('Id') || 14 < length $account -> first_child_text('Id') ) { 
                warn "\tALERT: Login Name is out of the defined Parameters.\n", return;
            }
        }
        if ($user == 2){
            # Checking if the LastLoginDate is older than the creation date.
            if ( eval{ Time::Piece -> strptime ( $createdate, "%Y-%m-%d" )} > eval{Time::Piece -> strptime ( $logindate, "%Y-%m-%d" )} ) {
                warn "\tALERT: Last Login Date is older than the creation date.\n", return; 
            }
        }
        if ($user == 3){
            #Checking if the Login Count has been incremented since the creation of this account.
            if (    $logindate eq 0 && $account -> first_child_text('LoginsCount') eq '0') {
                warn "\tALERT: Login Date exists but the Login Count is still '0'.\n", return; 
                }
            }
  $twig -> purge; #For Emptying the processed data (so far).
    }
my $twig = XML::Twig -> new ( twig_handlers => { 'Account' => \& process_account } );
$twig -> parsefile ($file); 

---

但是这些选项都不起作用，我非常感谢您在这方面的指导。

我认为我不会通过

warn

来实现这一点，而只是记录错误事件

例如

这将填充一个警告散列，您将得到一个消息列表以及触发它的帐户ID

您可以通过以下方式调用它：

log_warning ( $account -> first_child_text('Id'), 
            "Login Date exists but the Login Count is still 0"); 

解析完成后，您可以通过以下方式进行提取：

foreach my $message ( keys %warnings ) { 
    print scalar @{ $warnings{$message}} . " warnings found of ". $message,"\n";
    print "Accounts:\n"; 
    print join ("\n\t", @{$warnings{$message}} ), "\n";
}

反正是这样的

如果您正在查找失败的帐户-添加：

my %failed_accounts;

在那艘潜艇里，-或者只是一个计数：

$failed_accounts{$account_id}++; 

或者，如果您想要失败列表：

push ( @{$failed_accounts{$account_id}}, $message ); 

然后您可以使用以下工具进行报告：

foreach my $acc_id ( keys %failed_accounts ) { 
   print $acc_id, " has ", scalar @{$failed_accounts{$acc_id}}, " errors\n";
   print join ( "\n\t", @{$failed_accounts{$acc_id}}),"\n";
}

---

它是Perl或Perl，但不是Perl。@serenesat（已更正）-您对这个问题有答案吗？（因为它与前一个不同）。上一个问题：“如何用Perl解析给定的文件”。此问题：“无法从内部哈希中检索值”。收到的答案也不是针对SAX的！我重新打开它是因为它现在不同了，但是你到底想要什么结果呢？请记住，对于每种警告类型（可能在多个帐户中多次出现），您得到的似乎只会触发一次。@Sobrique我想要两件事-首先，只有当帐户有任何警告时，才会打印帐户名称。其次，如果帐户有任何警告，也打印该迭代中的警告数。我已经编辑了我的代码块，以包含调用细枝构造函数的部分。感谢您的快速响应-但是，如果我只想在帐户id有任何“警告”消息时打印帐户id的名称-我将如何做到这一点（如果您能使用我的代码，将您的回答块插入到各自的位置，并提供一套完整的答案，我将不胜感激。）仍然无法理解：-（如果您能用我在问题中给出的代码绘制您的解决方案，并提供一个工作答案（我可以接受并测试）-这可能会完成工作。（请原谅我对Perl的理解太低——我对它还相当陌生）。

push ( @{$failed_accounts{$account_id}}, $message ); 

foreach my $acc_id ( keys %failed_accounts ) { 
   print $acc_id, " has ", scalar @{$failed_accounts{$acc_id}}, " errors\n";
   print join ( "\n\t", @{$failed_accounts{$acc_id}}),"\n";
}