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
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.