App-after
view release on metacpan or search on metacpan
### Log/Any/Adapter/Base.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Adapter::Base;
#
#our $VERSION = '1.040';
#
#use Log::Any::Adapter::Util qw/make_method dump_one_line/;
#
#sub new {
# my $class = shift;
# my $self = {@_};
# bless $self, $class;
# $self->init(@_);
# return $self;
#}
#
#sub init { }
#
#for my $method ( Log::Any::Adapter::Util::logging_and_detection_methods() ) {
# no strict 'refs';
# *$method = sub {
# my $class = ref( $_[0] ) || $_[0];
# die "$class does not implement $method";
# };
#}
#
#sub delegate_method_to_slot {
# my ( $class, $slot, $method, $adapter_method ) = @_;
#
# make_method( $method,
# sub { my $self = shift; return $self->{$slot}->$adapter_method(@_) },
# $class );
#}
#
#1;
### Log/Any/Adapter/File.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Adapter::File;
#
#our $VERSION = '1.040';
#
#use Config;
#use Fcntl qw/:flock/;
#use IO::File;
#use Log::Any::Adapter::Util ();
#
#use Log::Any::Adapter::Base;
#our @ISA = qw/Log::Any::Adapter::Base/;
#
#my $HAS_FLOCK = $Config{d_flock} || $Config{d_fcntl_can_lock} || $Config{d_lockf};
#
#my $trace_level = Log::Any::Adapter::Util::numeric_level('trace');
#sub new {
# my ( $class, $file, @args ) = @_;
# return $class->SUPER::new( file => $file, log_level => $trace_level, @args );
#}
#
#sub init {
# my $self = shift;
# 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;
# }
# my $file = $self->{file};
# my $binmode ||= ':utf8';
# $binmode = ":$binmode" unless substr($binmode,0,1) eq ':';
# open( $self->{fh}, ">>$binmode", $file )
# or die "cannot open '$file' for append: $!";
# $self->{fh}->autoflush(1);
#}
#
#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};
# my $msg = sprintf( "[%s] %s\n", scalar(localtime), $text );
# flock($self->{fh}, LOCK_EX) if $HAS_FLOCK;
# $self->{fh}->print($msg);
# flock($self->{fh}, LOCK_UN) if $HAS_FLOCK;
# }
#}
#
#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__
#
### Log/Any/Adapter/Null.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Adapter::Null;
#
#our $VERSION = '1.040';
#
#use Log::Any::Adapter::Base;
#our @ISA = qw/Log::Any::Adapter::Base/;
#
#use Log::Any::Adapter::Util ();
#
#
#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;
# }
#}
#
#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};
# print STDOUT "$text\n";
# };
#}
#
#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__
#
### Log/Any/Adapter/Test.pm ###
#use 5.008001;
#use strict;
#use warnings;
#
#package Log::Any::Adapter::Test;
#
#our $VERSION = '1.040';
#
#use Log::Any::Adapter::Util qw/dump_one_line/;
#use Test::Builder;
#
#use Log::Any::Adapter::Base;
#our @ISA = qw/Log::Any::Adapter::Base/;
#
#my $tb = Test::Builder->new();
#my @msgs;
#
#
#sub new {
# my $class = shift;
# if ( defined $Log::Any::OverrideDefaultAdapterClass
# && $Log::Any::OverrideDefaultAdapterClass eq __PACKAGE__ )
# {
# my $category = pop @_;
# return $class->SUPER::new( category => $category );
# }
# else {
# return $class->SUPER::new(@_);
# }
#}
#
#foreach my $method ( Log::Any::Adapter::Util::detection_methods() ) {
# no strict 'refs';
# *{$method} = sub { 1 };
#}
#
#foreach my $method ( Log::Any::Adapter::Util::logging_methods() ) {
# no strict 'refs';
# *{$method} = sub {
# my ( $self, $msg ) = @_;
# push(
# @msgs,
# {
# message => $msg,
# level => $method,
# category => $self->{category}
# }
# );
# };
#}
#
#
#sub msgs {
# my $self = shift;
#
# return \@msgs;
#}
#
#sub clear {
# my ($self) = @_;
#
# @msgs = ();
#}
#
#sub contains_ok {
# my ( $self, $regex, $test_name ) = @_;
#
# local $Test::Builder::Level = $Test::Builder::Level + 1;
#
# $test_name ||= "log contains '$regex'";
# my $found =
# _first_index( sub { $_->{message} =~ /$regex/ }, @{ $self->msgs } );
# if ( $found != -1 ) {
# splice( @{ $self->msgs }, $found, 1 );
# $tb->ok( 1, $test_name );
# }
# else {
# $tb->ok( 0, $test_name );
# $tb->diag( "could not find message matching $regex" );
# _diag_msgs();
# }
#}
#
#sub category_contains_ok {
# my ( $self, $category, $regex, $test_name ) = @_;
#
# local $Test::Builder::Level = $Test::Builder::Level + 1;
#
( run in 1.353 second using v1.01-cache-2.11-cpan-b9db842bd85 )