如何捕捉一切在你的子程序的「警告」電話在Perl

Question

我使用的是桂枝分析器執行幾個帳戶驗證檢查 - 並想抓住所有的「警告」電話，因爲他們出現我的「process_account內'子程序（爲了顯示每個帳戶顯示的警告次數等）。

以下是我的代碼塊。

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); 

我（使用警告爲EG）

local $SIG{__WARN__} = sub { 
    state %WARNS; 
    my $message = shift; 
    return if $WARNS{$message}++; 
    logger('warning', $message); 
}; 
if ((%WARNS) > 0) { #things i would like to do 
    } 

但沒有選擇的工作嘗試了幾種方案，在這方面我會很感激你的指導。

Answer 1

我不認爲我會通過warn做到這一點，而不是僅僅保留日誌錯誤事件。

E.g.

my %warnings; 

sub log_warning { 
    my ($account_id, $warning) = @_; 
    warn "$account id has problem with $warning\n"; 
    push (@{$warnings{$warnings}}, $account_id); 
} 

這將填充警告哈希值，你會得到消息的列表和帳戶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"; 
}