'Log::Message' => {
'MAINTAINER' => 'kane',
- 'DISTRIBUTION' => 'BINGOS/Log-Message-0.04.tar.gz',
+ 'DISTRIBUTION' => 'BINGOS/Log-Message-0.06.tar.gz',
'FILES' => q[cpan/Log-Message],
'UPSTREAM' => 'cpan',
},
package Log::Message;
+use if $] > 5.017, 'deprecate';
use strict;
BEGIN {
use vars qw[$VERSION @ISA $STACK $CONFIG];
-
- $VERSION = 0.04;
-
+ $VERSION = '0.06';
$STACK = [];
}
These are individual message items, which are objects that contain
the user message as well as the meta-data described above.
-See the L<Log::Message::Item> manpage to see how to extract this
+See the L<Log::Message::Item> manpage to see how to extract this
meta-data and how to work with the Item objects.
You should never need to create your own Item objects, but knowing
about their methods and accessors is important if you want to write
=item verbose
Log::Message makes use of another module to validate its arguments,
-which is called L<Params::Check>, which is a lightweight, yet
-powerful input checker and parser. (See the L<Params::Check>
+which is called L<Params::Check>, which is a lightweight, yet
+powerful input checker and parser. (See the L<Params::Check>
manpage for details).
The verbose setting will control whether this module will
};
my $args = check( $tmpl, \%hash, $CONFIG->verbose ) or (
- warn(loc(q[Could not create a new stack object: %1],
+ warn(loc(q[Could not create a new stack object: %1],
Params::Check->last_error)
),
return
%hash = @_;
}
- my $args = check( $tmpl, \%hash ) or (
- warn( loc(q[Could not store error: %1], Params::Check->last_error) ),
- return
+ my $args = check( $tmpl, \%hash ) or (
+ warn( loc(q[Could not store error: %1], Params::Check->last_error) ),
+ return
);
my $extra = delete $args->{extra};
}
my $args = check( $tmpl, \%hash ) or (
- warn( loc(q[Could not parse input: %1], Params::Check->last_error) ),
- return
+ warn( loc(q[Could not parse input: %1], Params::Check->last_error) ),
+ return
);
-
+
my @list =
grep { $_->tag =~ /$args->{tag}/ ? 1 : 0 }
grep { $_->level =~ /$args->{level}/ ? 1 : 0 }
sub flush {
my $self = shift;
-
+
return splice @{$self->{STACK}};
}
package Log::Message::Config;
+use if $] > 5.017, 'deprecate';
use strict;
use Params::Check qw[check];
BEGIN {
use vars qw[$VERSION $AUTOLOAD];
- $VERSION = 0.04;
+ $VERSION = '0.06';
}
sub new {
package Log::Message::Handlers;
+use if $] > 5.017, 'deprecate';
use strict;
use vars qw[$VERSION];
-$VERSION = '0.04';
+$VERSION = '0.06';
=pod
package Log::Message::Item;
+use if $] > 5.017, 'deprecate';
use strict;
use vars qw[$VERSION];
BEGIN {
use vars qw[$AUTOLOAD $VERSION];
- $VERSION = '0.04';
+ $VERSION = '0.06';
}
### create a new item.
### Log::Message::Config test suite ###
-BEGIN {
+BEGIN {
if( $ENV{PERL_CORE} ) {
chdir '../lib/Log/Message' if -d '../lib/Log/Message';
unshift @INC, '../../..';
}
-}
+}
BEGIN { chdir 't' if -d 't' }
);
is_deeply( $mixed, $log->{CONFIG}, q[Config creation from file & options] );
}
-
+
### Log::Message test suite ###
-BEGIN {
+BEGIN {
if( $ENV{PERL_CORE} ) {
chdir '../lib/Log/Message' if -d '../lib/Log/Message';
unshift @INC, '../../..';
}
-}
+}
BEGIN { chdir 't' if -d 't' }
Log::Message::Item Log::Message::Handlers]
) {
use_ok( $pkg ) or diag "'$pkg' not found. Dying";
-}
+}
### test global stack
{
);
{
- ok( $log->retrieve( message => qr/baz/ ),
+ ok( $log->retrieve( message => qr/baz/ ),
q[ Retrieving based on message] );
- ok( $log->retrieve( tag => qr/TAG/ ),
+ ok( $log->retrieve( tag => qr/TAG/ ),
q[ Retrieving based on tag] );
- ok( $log->retrieve( level => qr/test/ ),
+ ok( $log->retrieve( level => qr/test/ ),
q[ Retrieving based on level] );
}
like( $item->shortmess, qr/\w+/,
q[ Item shortmess stored properly]
);
-
+
ok( $item->longmess, q[Item longmess stored] );
like( $item->longmess, qr/Log::Message::store/s,
q[ Item longmess stored properly]
{
ok( $item->remove, q[Removing item from stack] );
- ok( (!grep{ $item eq $_ } $log->retrieve),
+ ok( (!grep{ $item eq $_ } $log->retrieve),
q[ Item removed from stack] );
}
ok( @{$log->{STACK}} == 0, q[Flushing stack] );
}
}
-
-### test errors
+
+### test errors
{ my $log = Log::Message->new( private => 1 );
-
+
### store errors
{ ### dont make it print
my $warnings;
local $SIG{__WARN__} = sub { $warnings .= "@_" };
-
+
my $rv = $log->store();
ok( !$rv, q[Logging empty message failed] );
like( $warnings, qr/message/, q[ Spotted the error] );
}
-
+
### retrieve errors
{ ### dont make it print
my $warnings;
local $SIG{__WARN__} = sub { $warnings .= "@_" };
-
+
### XXX whitebox test!
local $Params::Check::VERBOSE = 1; # so the warnings are emitted
local $Params::Check::VERBOSE = 1; # so the warnings are emitted
-
+
my $rv = $log->retrieve( frobnitz => $$ );
ok( !$rv, q[Retrieval with bogus args] );
- like( $warnings, qr/not a valid key/,
+ like( $warnings, qr/not a valid key/,
qq[ Spotted the error] );
}
-}
+}
# retrieve errors in chronological order, or not?
# if none provided, set to '1'
- chrono = 0
+ chrono = 0
\ No newline at end of file