package Log::Any::Adapter::Tickit; $Log::Any::Adapter::Tickit::VERSION = '0.005'; use strict; use warnings; use parent qw(Log::Any::Adapter::Base); =head1 NAME Log::Any::Adapter::Tickit - Simple adapter for L logging from L =head1 VERSION version 0.005 =head1 SYNOPSIS TBD =head1 DESCRIPTION The C attribute may be set to define a minimum level to log. =cut use Adapter::Async::OrderedList::Array; use Time::HiRes; use Log::Any::Adapter::Util (); my $trace_level = Log::Any::Adapter::Util::numeric_level('trace'); sub init { my ($self) = @_; if ( exists $self->{log_level} ) { $self->{log_level} = Log::Any::Adapter::Util::numeric_level( $self->{log_level} ) unless $self->{log_level} =~ /^\d+$/; } else { $self->{log_level} = $trace_level; } } sub adapter { shift->{adapter} //= Adapter::Async::OrderedList::Array->new } sub stack_trace { my ($self, $level) = @_; my @trace; my $idx = $level || 0; while(my @details = caller($idx++)) { push @trace, { package => $details[0], filename => $details[1], line => $details[2], sub => $details[3], ctx => $details[5] ? 'list' : defined($details[5]) ? 'scalar' : 'void', } } \@trace } foreach my $method ( Log::Any::Adapter::Util::logging_methods() ) { no strict 'refs'; my $method_level = Log::Any::Adapter::Util::numeric_level($method); *{$method} = sub { my ( $self, $text ) = @_; return if $method_level > $self->{log_level}; $self->adapter->push([ { severity => $method, message => $text, category => $self->{category}, timestamp => Time::HiRes::time, stack => $self->stack_trace(2) } ]); }; } foreach my $method ( Log::Any::Adapter::Util::detection_methods() ) { no strict 'refs'; my $base = substr( $method, 3 ); my $method_level = Log::Any::Adapter::Util::numeric_level($base); *{$method} = sub { return !!( $method_level <= $_[0]->{log_level} ); }; } 1; __END__