Acme-Beamerang-Logger

 view release on metacpan or  search on metacpan

lib/Acme/Beamerang/Logger.pm  view on Meta::CPAN

use 5.006;    # our
use strict;
use warnings;

package Acme::Beamerang::Logger;

our $VERSION = '0.001000';

use parent 'Log::Contextual';

sub default_import { qw(:dlog :log ) }

# This ideally would be regulated by the importing class
# but I got tired of trying to guess what horrible magic
# was necessary to make Exporter::Declare and whatever
# the hell Log::Contextual's import logic does work.
sub _get_prefixes {
    my $class = $_[0];
    my (@parts) = split /::/sx, $class;

    # Always assume there is no Acme
    # Acme::X is X in the future.
    shift @parts if $parts[0] eq 'Acme';

    my (@prefixes);

    # Always include FQ name, sans Acme

lib/Acme/Beamerang/Logger.pm  view on Meta::CPAN

    # and create env vars for each level.
    if ( 2 <= @parts and ( 'Beamerang' eq shift @parts ) ) {
        while (@parts) {
            push @prefixes, uc( join q/_/, 'BEAMERANG', @parts );
            pop @parts;
        }
    }
    return @prefixes, 'BEAMERANG';
}

sub arg_default_logger {
    return $_[1] if $_[1];
    require Log::Contextual::WarnLogger::Fancy;
    my $caller = caller(3);

    my ( $env, @group ) = _get_prefixes($caller);
    return Log::Contextual::WarnLogger::Fancy->new(
        {
            env_prefix       => $env,
            group_env_prefix => \@group,
            label            => $caller,

t/basic-noacme.t  view on Meta::CPAN

use Test::More;
use Term::ANSIColor qw( colorstrip );

{
    package    # Hide from indexers
      Beamerang::KENTNL::Example;

    use Acme::Beamerang::Logger;

    sub do_work {
        log_warn { "This is a warning" };
        log_trace { "This is a trace" };
    }
}

my $capture = '';
{
    my %old = %ENV;
    delete $old{$_} for grep /BEAMERANG/, keys %old;
    local (%ENV) = (%old);
    local $SIG{__WARN__} = sub { $capture .= colorstrip( $_[0] ) };
    Beamerang::KENTNL::Example->do_work;
}
like( $capture, qr/\[warn\s+Beam/, "warn level emitted by default" );
unlike( $capture, qr/\[trace\s+Beame/, "trace level not emitted by default" );

$capture = '';
{
    my %old = %ENV;
    delete $old{$_} for grep /BEAMERANG/, keys %old;
    local (%ENV) = (%old);
    $ENV{BEAMERANG_UPTO} = 'fatal';
    local $SIG{__WARN__} = sub { $capture .= colorstrip( $_[0] ) };
    Beamerang::KENTNL::Example->do_work;
}
unlike( $capture, qr/\[warn\s+Beam/, "warn level not emitted with UPTO=fatal" );
unlike( $capture, qr/\[trace\s+Beam/,
    "trace level not emitted with UPTO=fatal" );

$capture = '';
{
    my %old = %ENV;
    delete $old{$_} for grep /BEAMERANG/, keys %old;
    local (%ENV) = (%old);
    $ENV{BEAMERANG_KENTNL_UPTO} = 'trace';
    local $SIG{__WARN__} = sub { $capture .= colorstrip( $_[0] ) };
    Beamerang::KENTNL::Example->do_work;
}
like( $capture, qr/\[warn\s+Beam/,  "warn level emitted with UPTO=trace" );
like( $capture, qr/\[trace\s+Beam/, "trace level emitted with UPTO=trace" );

done_testing;

t/basic-nobeamerang.t  view on Meta::CPAN

use Test::More;
use Term::ANSIColor qw( colorstrip );

{
    package    # Hide from indexers
      KENTNL::Example;

    use Acme::Beamerang::Logger;

    sub do_work {
        log_warn { "This is a warning" };
        log_trace { "This is a trace" };
    }
}

my $capture = '';
{
    my %old = %ENV;
    delete $old{$_} for grep /BEAMERANG/, keys %old;
    local (%ENV) = (%old);
    local $SIG{__WARN__} = sub { $capture .= colorstrip($_[0]) };
    KENTNL::Example->do_work;
}
like( $capture, qr/\[warn\s+KENT/, "warn level emitted by default" );
unlike( $capture, qr/\[trace\s+KENT/, "trace level not emitted by default" );

$capture = '';
{
    my %old = %ENV;
    delete $old{$_} for grep /BEAMERANG/, keys %old;
    local (%ENV) = (%old);
    $ENV{BEAMERANG_UPTO} = 'fatal';
    local $SIG{__WARN__} = sub { $capture .= colorstrip($_[0]) };
    KENTNL::Example->do_work;
}
unlike( $capture, qr/\[warn\s+KENT/, "warn level not emitted with UPTO=fatal" );
unlike( $capture, qr/\[trace\s+KENT/, "trace level not emitted with UPTO=fatal" );

$capture = '';
{
    my %old = %ENV;
    delete $old{$_} for grep /BEAMERANG/, keys %old;
    local (%ENV) = (%old);
    $ENV{BEAMERANG_UPTO} = 'trace';
    local $SIG{__WARN__} = sub { $capture .= colorstrip($_[0]) };
    KENTNL::Example->do_work;
}
like( $capture, qr/\[warn\s+KENT/, "warn level emitted with UPTO=trace" );
like( $capture, qr/\[trace\s+KENT/, "trace level emitted with UPTO=trace" );


done_testing;

t/basic-short.t  view on Meta::CPAN

use Test::More;
use Term::ANSIColor qw( colorstrip );

{
    package    # Hide from indexers
      Beamerang;

    use Acme::Beamerang::Logger;

    sub do_work {
        log_warn { "This is a warning" };
        log_trace { "This is a trace" };
    }
}

my $capture = '';
{
    my %old = %ENV;
    delete $old{$_} for grep /BEAMERANG/, keys %old;
    local (%ENV) = (%old);
    local $SIG{__WARN__} = sub { $capture .= colorstrip($_[0]) };
    Beamerang->do_work;
}
like( $capture, qr/\[warn\s+Beam/, "warn level emitted by default" );
unlike( $capture, qr/\[trace\s+Beame/, "trace level not emitted by default" );

$capture = '';
{
    my %old = %ENV;
    delete $old{$_} for grep /BEAMERANG/, keys %old;
    local (%ENV) = (%old);
    $ENV{BEAMERANG_UPTO} = 'fatal';
    local $SIG{__WARN__} = sub { $capture .= colorstrip($_[0]) };
    Beamerang->do_work;
}
unlike( $capture, qr/\[warn\s+Beam/, "warn level not emitted with UPTO=fatal" );
unlike( $capture, qr/\[trace\s+Beam/, "trace level not emitted with UPTO=fatal" );

$capture = '';
{
    my %old = %ENV;
    delete $old{$_} for grep /BEAMERANG/, keys %old;
    local (%ENV) = (%old);
    $ENV{BEAMERANG_UPTO} = 'trace';
    local $SIG{__WARN__} = sub { $capture .= colorstrip($_[0]) };
    Beamerang->do_work;
}
like( $capture, qr/\[warn\s+Beam/, "warn level emitted with UPTO=trace" );
like( $capture, qr/\[trace\s+Beam/, "trace level emitted with UPTO=trace" );


done_testing;

t/basic.t  view on Meta::CPAN

use Test::More;
use Term::ANSIColor qw( colorstrip );

{
    package    # Hide from indexers
      Acme::Beamerang::KENTNL::Example;

    use Acme::Beamerang::Logger;

    sub do_work {
        log_warn { "This is a warning" };
        log_trace { "This is a trace" };
    }
}

my $capture = '';
{
    my %old = %ENV;
    delete $old{$_} for grep /BEAMERANG/, keys %old;
    local (%ENV) = (%old);
    local $SIG{__WARN__} = sub { $capture .= colorstrip( $_[0] ) };
    Acme::Beamerang::KENTNL::Example->do_work;
}
like( $capture, qr/\[warn\s+Acme/, "warn level emitted by default" );
unlike( $capture, qr/\[trace\s+Acme/, "trace level not emitted by default" );

$capture = '';
{
    my %old = %ENV;
    delete $old{$_} for grep /BEAMERANG/, keys %old;
    local (%ENV) = (%old);
    $ENV{BEAMERANG_KENTNL_UPTO} = 'fatal';
    local $SIG{__WARN__} = sub { $capture .= colorstrip( $_[0] ) };
    Acme::Beamerang::KENTNL::Example->do_work;
}
unlike( $capture, qr/\[warn\s+Acme/, "warn level not emitted with UPTO=fatal" );
unlike( $capture, qr/\[trace\s+Acme/,
    "trace level not emitted with UPTO=fatal" );

$capture = '';
{
    my %old = %ENV;
    delete $old{$_} for grep /BEAMERANG/, keys %old;
    local (%ENV) = (%old);
    $ENV{BEAMERANG_KENTNL_EXAMPLE_UPTO} = 'trace';
    local $SIG{__WARN__} = sub { $capture .= colorstrip( $_[0] ) };
    Acme::Beamerang::KENTNL::Example->do_work;
}
like( $capture, qr/\[warn\s+Acme/,  "warn level emitted with UPTO=trace" );
like( $capture, qr/\[trace\s+Acme/, "trace level emitted with UPTO=trace" );

done_testing;