Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Devel::SummarizedWarnings

by diotalevi (Canon)
on Oct 09, 2003 at 23:37 UTC ( #298144=sourcecode: print w/replies, xml ) Need Help??
Category: Miscellaneous
Author/Contact Info
Description:

This traps warnings and prints them summarized instead of in masses. Instead of getting 3542 messages stating "Use of uninitialized value ..." at various lines you get only a few and they list all the lines it happened at and how many times.

Updated: The warnings are now displayed in the order they were first seen (they used to be in ascibetical order) and the warning messages are slightly more succinct. Instead of "on line 5 (11 times), line 8" now "on line 5 (x11) and 8".

package Devel::SummarizedWarnings;
use strict;
use warnings;
our @Warnings;

use constant NoSuchLine => 'NoSuchLine';

# Modify this globally
BEGIN {
    my $old_sig = $SIG{'__WARN__'};
    $SIG{'__WARN__'} =
        ref $SIG{'__WARN__'}
        ? sub { &$old_sig; &append_to_warning_log }
        : \ &append_to_warning_log;
}

END {
    dump_warnings();
}

sub append_to_warning_log {
    push @Warnings, grep +(not ref), @_;
}

sub dump_warnings {
    if ( $SIG{'__WARN__'} == \&append_to_warning_log ) {
        delete $SIG{'__WARN__'};
    } else {
        push @Warnings, __PACKAGE__ . " was disabled prior to summariz
+ation\n";
    }
    
    # Summarize the saved warnings
    my %order;
    my %sum;
    for ( @Warnings ) {
    my $msg;
    my $line;
        if ( not /^(.*) at $0 line (\d+).$/os ) {
        s/\n$//;
        $msg = $_;
        $line = NoSuchLine;
        } else {
        $msg  = $1;
        $line = $2;
        }
    $sum{$msg}{$line}++;
    
    if ( not exists $order{$msg} ) {
        no warnings 'numeric';
        $order{$msg} = 1 + %order;
    }
    }
    @Warnings = ();

    # Reformat the summarization
    my @out;
    for ( sort { $order{$a} <=> $order{$b} }
      keys %order ) {
        my $wrn = $sum{$_};
        if ( exists $wrn->{+NoSuchLine} ) {
            push
        @out,
            $_
                . ( $wrn->{+NoSuchLine} > 1
                    ? " (x$wrn->{+NoSuchLine})"
                    : '' );
        } else {
            push
        @out,
        "$_ on line@{[1 < keys %$wrn ? 's' : '']} "
                . join( 2 == keys %$wrn ? ' and ' : ', ',
            map "$_@{[ $wrn->{$_} == 1
                                   ? ''
                                   : qq[ (x$wrn->{$_})]]}",
            sort { $a <=> $b }
                        keys %$wrn );
        }
    }
    
    local $, = "\n";
    print STDERR @out;
}

1;

__END__

=head1 NAME

Devel::SummarizedWarnings - Causes warnings to be summarized

=head1 SYNOPSIS

 use Devel::SummarizedWarnings;
 use warnings;

 for ( 0 .. 10 ) {
     $k = 0 + undef . $_;
 }

 $k = 1 + undef . $_;

 warn "Seagulls!\n";

produces the output

 Warning: Use of "undef" without parens is ambiguous on lines 5 and 8
 Use of uninitialized value in addition (+) on lines 5 (x11) and 8
 Use of uninitialized value in concatenation (.) or string on line 8
 Seagulls!

instead of

 Warning: Use of "undef" without parens is ambiguous at w.pl line 5.
 Warning: Use of "undef" without parens is ambiguous at w.pl line 8.
 Use of uninitialized value in addition (+) at w.pl line 5.
 Use of uninitialized value in addition (+) at w.pl line 5.
 Use of uninitialized value in addition (+) at w.pl line 5.
 Use of uninitialized value in addition (+) at w.pl line 5.
 Use of uninitialized value in addition (+) at w.pl line 5.
 Use of uninitialized value in addition (+) at w.pl line 5.
 Use of uninitialized value in addition (+) at w.pl line 5.
 Use of uninitialized value in addition (+) at w.pl line 5.
 Use of uninitialized value in addition (+) at w.pl line 5.
 Use of uninitialized value in addition (+) at w.pl line 5.
 Use of uninitialized value in addition (+) at w.pl line 5.
 Use of uninitialized value in addition (+) at w.pl line 8.
 Use of uninitialized value in concatenation (.) or string at w.pl lin
+e 8.
 Seagulls!

=head1 DESCRIPTION

This module traps all warnings and summarizes them when the your perl 
+script
exits. Warning trapping can be interrupted and resumed by removing/ins
+talling
the Devel::SummarizedWarnings::append_to_warning_log handler into
$SIG{'__WARN__'}.

Trapped warnings are stored in @Devel::SummarizedWarnings::Warnings.

=head1 AUTHOR

Joshua b. Jore E<lt>jjore@cpan.orgE<gt>

=cut

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://298144]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (3)
As of 2022-01-25 08:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    In 2022, my preferred method to securely store passwords is:












    Results (65 votes). Check out past polls.

    Notices?