How to catch all the "warn" calls in your sub-routine in Perl

Question

I am using a Twig Parser to perform several account validation checks - and would like to grab all the 'warn' calls as they occur inside my 'process_account' subroutine (in order to display number of warnings each account has shown/etc).

Following is a chunk of my code.

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

I've tried several options (for eg using Warn)

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
   }

But none of the option is working and I would really appreciate your guidance in this regard.

Answer 1

I don't think I'd do this via warn and instead just keep a log of error events.

E.g.

my %warnings; 

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

This will populate a warning hash, and you'll get a list of messages and which account ids triggered it.

You might invoke it with:

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

After your parsing is done, you'd be able to extract via:

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

Something like that anyway.

If you're just after failed accounts - add:

my %failed_accounts;

And in that sub, - either just a count:

$failed_accounts{$account_id}++; 

Or if you want a list of failures:

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

Which you can then report with:

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";
}