File Coverage

blib/lib/Log/Any/Manager.pm

Criterion	Covered	Total	%
statement	84	85	98.8
branch	21	24	87.5
condition	2	3	66.6
subroutine	15	15	100.0
pod	0	4	0.0
total	122	131	93.1

package Log::Any::Manager;
{
  $Log::Any::Manager::VERSION = '0.11';
}
use strict;
use warnings;
use Carp qw(croak);
use Devel::GlobalDestruction;
use Log::Any::Adapter::Util qw(require_dynamic);
use Guard;

sub new {
    my $class = shift;
    my $self = { entries => [] };
    bless $self, $class;

    # Create the initial Null entry (this is always present)
    #
    $self->set('Null');
    my $null_entry = $self->{entries}->[0];

    # Start our category cache with any null adapters already returned from raw Log::Any
    #
    $self->{category_cache} = {
        map {
            (
                $_ => {
                    adapter => $Log::Any::NullAdapters{$_},
                    entry   => $null_entry
                }
              )
        } keys(%Log::Any::NullAdapters)
    };

    return $self;
}

sub get_logger {
    my ( $self, $category ) = @_;

    # Create a new adapter for this category if it is not already in cache
    #
    my $category_cache = $self->{category_cache};
    if ( !defined( $category_cache->{$category} ) ) {
        my $entry = $self->_choose_entry_for_category($category);
        my $adapter = $self->_new_adapter_for_entry( $entry, $category );
        $category_cache->{$category} = { entry => $entry, adapter => $adapter };
    }
    return $category_cache->{$category}->{adapter};
}

sub _choose_entry_for_category {
    my ( $self, $category ) = @_;

    foreach my $entry ( @{ $self->{entries} } ) {
        if ( $category =~ $entry->{pattern} ) {
            return $entry;
        }
    }
    die "no entries matched '$category' - should not get here!";
}

sub _new_adapter_for_entry {
    my ( $self, $entry, $category ) = @_;

    return $entry->{adapter_class}
      ->new( @{ $entry->{adapter_params} }, category => $category );
}

sub set {
    my $self = shift;
    my $options;
    if ( ref( $_[0] ) eq 'HASH' ) {
        $options = shift(@_);
    }
    my ( $adapter_name, @adapter_params ) = @_;

    croak "expected adapter name"
      unless defined($adapter_name) && $adapter_name =~ /\S/;

    my $pattern = $options->{category};
    if ( !defined($pattern) ) {
        $pattern = qr/.*/;
    }
    elsif ( !ref($pattern) ) {
        $pattern = qr/^\Q$pattern\E$/;
    }

    $adapter_name =~ s/^Log:://;    # Log::Dispatch -> Dispatch, etc.
    my $adapter_class = (
          substr( $adapter_name, 0, 1 ) eq '+'
        ? substr( $adapter_name, 1 )
        : "Log::Any::Adapter::$adapter_name"
    );
    require_dynamic($adapter_class);

    my $entry = $self->_new_entry( $pattern, $adapter_class, \@adapter_params );
    unshift( @{ $self->{entries} }, $entry );

    $self->_reselect_matching_adapters($pattern);

    if ( my $lex_ref = $options->{lexically} ) {
        $$lex_ref =
          Guard::guard { $self->remove($entry) if !in_global_destruction };
    }

    return $entry;
}

sub remove {
    my ( $self, $entry ) = @_;

    my $pattern = $entry->{pattern};
    my $size    = scalar( @{ $self->{entries} } );
    die "cannot remove bottom entry"
      if $entry eq $self->{entries}->[ $size - 1 ];
    $self->{entries} = [ grep { $_ ne $entry } @{ $self->{entries} } ];
    $self->_reselect_matching_adapters($pattern);
}

sub _new_entry {
    my ( $self, $pattern, $adapter_class, $adapter_params ) = @_;

    return {
        pattern        => $pattern,
        adapter_class  => $adapter_class,
        adapter_params => $adapter_params,
    };
}

sub _reselect_matching_adapters {
    my ( $self, $pattern ) = @_;

    return if in_global_destruction;

    # Reselect adapter for each category matching $pattern
    #
    while ( my ( $category, $category_info ) =
        each( %{ $self->{category_cache} } ) )
    {
        my $new_entry = $self->_choose_entry_for_category($category);
        if ( $new_entry ne $category_info->{entry} ) {
            my $new_adapter =
              $self->_new_adapter_for_entry( $new_entry, $category );
            %{ $category_info->{adapter} } = %$new_adapter;
            bless( $category_info->{adapter}, ref($new_adapter) );
            $category_info->{entry} = $new_entry;
        }
    }
}

1;