File Coverage

blib/lib/Log/Any.pm

Criterion	Covered	Total	%
statement	63	65	96.9
branch	18	20	90.0
condition	5	6	83.3
subroutine	15	15	100.0
pod	0	3	0.0
total	101	109	92.6

use 5.008001;
use strict;
use warnings;

package Log::Any;

# ABSTRACT: Bringing loggers and listeners together
our $VERSION = '1.717';

use Log::Any::Manager;
use Log::Any::Proxy::Null;
use Log::Any::Adapter::Util qw(
  require_dynamic
  detection_aliases
  detection_methods
  log_level_aliases
  logging_aliases
  logging_and_detection_methods
  logging_methods
);

# This is overridden in Log::Any::Test
our $OverrideDefaultAdapterClass;
our $OverrideDefaultProxyClass;

# singleton and accessor
{
    my $manager = Log::Any::Manager->new();
    sub _manager { return $manager }
    sub has_consumer { $manager->has_consumer }
}

sub import {
    my $class  = shift;
    my $caller = caller();

    my @export_params = ( $caller, @_ );
    $class->_export_to_caller(@export_params);
}

sub _export_to_caller {
    my $class  = shift;
    my $caller = shift;

    # Parse parameters passed to 'use Log::Any'
    my $saw_log_param;
    my @params;
    while ( my $param = shift @_ ) {
        if ( !$saw_log_param && $param =~ /^\$(\w+)/ ) {
            $saw_log_param = $1;   # defer until later
            next;                  # singular
        }
        else {
            push @params, $param, shift @_;    # pairwise
        }
    }

    unless ( @params % 2 == 0 ) {
        require Carp;
        Carp::croak("Argument list not balanced: @params");
    }

    # get logger if one was requested
    if ( defined $saw_log_param ) {
        no strict 'refs';
        my $proxy = $class->get_logger( category => $caller, @params );
        my $varname = "${caller}::${saw_log_param}";
        *$varname = \$proxy;
    }
}

sub get_logger {
    my ( $class, %params ) = @_;
    no warnings 'once';

    my $category =
      defined $params{category} ? delete $params{'category'} : caller;
    if ( my $default = delete $params{'default_adapter'} ) {
        my @default_adapter_params = ();
        if (ref $default eq 'ARRAY') {
            ($default, @default_adapter_params) = @{ $default };
        }
        # Every default adapter is set only for a given logger category.
        # When another adapter is configured (by using
        # Log::Any::Adapter->set) for this category, it takes
        # precedence, but if that adapter is later removed, the default
        # we set here takes over again.
        $class->_manager->set_default(
            $category, $default, @default_adapter_params
        );
    }

    my $proxy_class = $class->_get_proxy_class( delete $params{proxy_class} );

    my $adapter = $class->_manager->get_adapter( $category );
    my $context = $class->_manager->get_context();

    require_dynamic($proxy_class);
    return $proxy_class->new(
        %params, adapter => $adapter, category => $category, context => $context
    );
}

sub _get_proxy_class {
    my ( $self, $proxy_name ) = @_;
    return $Log::Any::OverrideDefaultProxyClass
      if $Log::Any::OverrideDefaultProxyClass;
    return "Log::Any::Proxy" if !$proxy_name && _manager->has_consumer;
    return "Log::Any::Proxy::Null" if !$proxy_name;
    my $proxy_class = (
          substr( $proxy_name, 0, 1 ) eq '+'
        ? substr( $proxy_name, 1 )
        : "Log::Any::Proxy::$proxy_name"
    );
    return $proxy_class;
}

# For backward compatibility
sub set_adapter {
    my $class = shift;
    Log::Any->_manager->set(@_);
}

1;

__END__