'Log::Message::Simple' => {
'MAINTAINER' => 'kane',
- 'DISTRIBUTION' => 'BINGOS/Log-Message-Simple-0.08.tar.gz',
+ 'DISTRIBUTION' => 'BINGOS/Log-Message-Simple-0.10.tar.gz',
'FILES' => q[cpan/Log-Message-Simple],
'UPSTREAM' => 'cpan',
},
package Log::Message::Simple;
+use if $] > 5.017, 'deprecate';
use strict;
use Log::Message private => 0;;
-BEGIN {
- use vars qw[$VERSION];
- $VERSION = 0.08;
+BEGIN {
+ use vars qw[$VERSION];
+ $VERSION = '0.10';
}
-
+
=pod
local $Log::Message::Simple::MSG_FH = \*STDERR;
local $Log::Message::Simple::ERROR_FH = \*STDERR;
local $Log::Message::Simple::DEBUG_FH = \*STDERR;
-
+
### force a stacktrace on error
local $Log::Message::Simple::STACKTRACE_ON_ERROR = 1
=head2 debug("message string" [,VERBOSE])
Records a debug message on the stack, and prints it to C<STDOUT> (or
-actually C<$DEBUG_FH>, see the C<GLOBAL VARIABLES> section below),
+actually C<$DEBUG_FH>, see the C<GLOBAL VARIABLES> section below),
if the C<VERBOSE> option is true.
The C<VERBOSE> option defaults to false.
Exported by default, or using the C<:STD> tag.
-=cut
+=cut
{ package Log::Message::Handlers;
-
+
sub msg {
my $self = shift;
my $verbose = shift || 0;
my $msg = '['. $self->tag . '] ' . $self->message;
- print $Log::Message::Simple::STACKTRACE_ON_ERROR
- ? Carp::shortmess($msg)
+ print $Log::Message::Simple::STACKTRACE_ON_ERROR
+ ? Carp::shortmess($msg)
: $msg . "\n";
select $old_fh;
@ISA = 'Exporter';
@EXPORT = qw[error msg debug];
@EXPORT_OK = qw[carp cluck croak confess];
-
+
%EXPORT_TAGS = (
STD => \@EXPORT,
CARP => \@EXPORT_OK,
ALL => [ @EXPORT, @EXPORT_OK ],
- );
+ );
my $log = new Log::Message;
for my $func ( @EXPORT, @EXPORT_OK ) {
no strict 'refs';
-
+
### up the carplevel for the carp emulation
### functions
*$func = sub { local $Carp::CarpLevel += 2
if grep { $_ eq $func } @EXPORT_OK;
-
+
my $msg = shift;
$log->store(
message => $msg,
=item $STACKTRACE_ON_ERROR
-If this option is set to C<true>, every call to C<error()> will
+If this option is set to C<true>, every call to C<error()> will
generate a stacktrace using C<Carp::shortmess()>.
Defaults to C<false>
$ERROR_FH = \*STDERR;
$MSG_FH = \*STDOUT;
$DEBUG_FH = \*STDOUT;
-
+
$STACKTRACE_ON_ERROR = 0;
}
### test empty import
{ package Test::A;
-
+
eval "use $Class ()";
Test::More::ok( !$@, "using $Class with no import" );
-
+
for my $func ( @Carp, @Msg ) {
Test::More::ok( !__PACKAGE__->can( $func ),
" $func not imported" );
}
-}
+}
### test :STD import
{ package Test::B;
eval "use $Class ':STD'";
Test::More::ok( !$@, "using $Class with :STD import" );
-
+
for my $func ( @Carp ) {
Test::More::ok( !__PACKAGE__->can( $func ),
" $func not imported" );
}
-
+
for my $func ( @Msg ) {
Test::More::ok( __PACKAGE__->can( $func ),
" $func imported" );
- }
-}
+ }
+}
### test :CARP import
{ package Test::C;
eval "use $Class ':CARP'";
Test::More::ok( !$@, "using $Class with :CARP import" );
-
+
for my $func ( @Msg ) {
Test::More::ok( !__PACKAGE__->can( $func ),
" $func not imported" );
}
-
+
for my $func ( @Carp ) {
Test::More::ok( __PACKAGE__->can( $func ),
" $func imported" );
- }
-}
+ }
+}
### test all import
eval "use $Class ':ALL'";
Test::More::ok( !$@, "using $Class with :ALL import" );
-
+
for my $func ( @Carp, @Msg ) {
Test::More::ok( __PACKAGE__->can( $func ),
" $func imported" );
- }
-}
+ }
+}
### & friends will print there
for my $name (@Carp, @Msg) {
no strict 'refs';
- *$name = sub {
+ *$name = sub {
local $^W;
### do the block twice to avoid 'used only once'
local *STDERR;
local $SIG{__WARN__} = sub { };
-
+
my $ref = $Class->can( $name );
$ref->( @_ );
};
- }
+ }
}
for my $name (@Carp, @Msg) {
-
+
my $ref = $Pkg->can( $name );
ok( $ref, "Found function for '$name'" );
### start with an empty stack?
cmp_ok( scalar @{[$Class->stack]}, '==', 0,
" Starting with empty stack" );
- ok(!$Class->stack_as_string," Stringified stack empty" );
-
+ ok(!$Class->stack_as_string," Stringified stack empty" );
+
### call the func... no output should appear
### eval this -- the croak/confess functions die
eval { $ref->( $Text ); };
-
+
my @stack = $Class->stack;
cmp_ok( scalar(@stack), '==', 1,
" Text logged to stack" );
-
- for my $re ( $Text, quotemeta '['.uc($name).']' ) {
+
+ for my $re ( $Text, quotemeta '['.uc($name).']' ) {
like( $Class->stack_as_string, qr/$re/,
" Text as expected" );
}
- ### empty stack again ###
+ ### empty stack again ###
ok( $Class->flush, " Stack flushed" );
cmp_ok( scalar @{[$Class->stack]}, '==', 0,
" Starting with empty stack" );
- ok(!$Class->stack_as_string," Stringified stack empty" );
+ ok(!$Class->stack_as_string," Stringified stack empty" );
}