#!/usr/bin/perl
=head1 AUTHOR
Jonny Schulz <jschulz.cpan(at)bloonix.de>
=head1 DESCRIPTION
Benchmarks... what else could I say...
=head1 POWERED BY
_ __ _____ _____ __ __ __ __ __
| |__| | | | \| |__|\ \/ /
| . | | | | | | | | > <
|____|__|_____|_____|__|\__|__|/__/\__\
=head1 COPYRIGHT
Copyright (C) 2007-2009 by Jonny Schulz. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
use strict;
use warnings;
use Log::Handler;
use Benchmark;
sub buffer { }
my $log1 = Log::Handler->new(); # simple pattern
my $log2 = Log::Handler->new(); # default pattern & suppressed
my $log3 = Log::Handler->new(); # complex pattern
my $log4 = Log::Handler->new(); # message pattern
my $log5 = Log::Handler->new(); # filtered caller
my $log6 = Log::Handler->new(); # filtered message
my $log7 = Log::Handler->new(); # categories
$log1->add(
forward => {
alias => 'simple pattern',
maxlevel => 'notice',
minlevel => 'notice',
forward_to => \&buffer,
message_layout => '%L - %m',
}
);
$log2->add(
forward => {
alias => 'default pattern & suppressed',
maxlevel => 'warning',
minlevel => 'warning',
forward_to => \&buffer,
}
);
$log3->add(
forward => {
alias => 'complex pattern',
maxlevel => 'info',
minlevel => 'info',
forward_to => \&buffer,
message_layout => '%T [%L] %H(%P) %m (%C)%N',
}
);
$log4->add(
forward => {
alias => 'message pattern',
maxlevel => 'error',
minlevel => 'error',
forward_to => \&buffer,
message_layout => '%m',
message_pattern => [qw/%T %L %P/],
}
);
$log5->add(
forward => {
alias => 'filtered caller',
maxlevel => 'emerg',
minlevel => 'emerg',
forward_to => \&buffer,
filter_caller => qr/^Foo\z/,
}
);
$log5->add(
forward => {
alias => 'filtered caller',
maxlevel => 'emerg',
minlevel => 'emerg',
forward_to => \&buffer,
filter_caller => qr/^Bar\z/,
}
);
$log5->add(
forward => {
alias => 'filtered caller',
maxlevel => 'emerg',
minlevel => 'emerg',
forward_to => \&buffer,
filter_caller => qr/^Baz\z/,
}
);
$log6->add(
forward => {
alias => 'filtered message',
maxlevel => 'alert',
minlevel => 'alert',
forward_to => \&buffer,
filter_message => qr/bar/,
}
);
$log6->add(
forward => {
alias => 'filtered message',
maxlevel => 'alert',
minlevel => 'alert',
forward_to => \&buffer,
filter_message => qr/bar/,
}
);
$log7->add(
forward => {
alias => 'categories',
maxlevel => 'alert',
minlevel => 'alert',
forward_to => \&buffer,
category => "Cat::Foo",
}
);
my $count = 100_000;
my $message = 'foo bar baz';
run("simple pattern output took", $count, sub { $log1->notice($message) } );
run("default pattern output took", $count, sub { $log2->warning($message) } );
run("complex pattern output took", $count, sub { $log3->info($message) } );
run("message pattern output took", $count, sub { $log4->error($message) } );
run("suppressed output took", $count, sub { $log2->debug($message) } );
run("filtered caller output took", $count, \&Foo::emerg );
run("suppressed caller output took", $count, \&Foo::Bar::emerg );
run("filtered messages output took", $count, sub { $log6->alert($message) } );
run("categorized messages output took", $count, \&Cat::Foo::Bar::alert );
run("suppressed categories output took", $count, \&Cat::Bar::Baz::alert );
sub run {
my ($desc, $count, $bench) = @_;
my $time = timeit($count, $bench);
print sprintf('%-30s', $desc), ' : ', timestr($time), "\n";
}
# Filter messages by caller
package Foo;
sub emerg { $log5->emerg($message) }
# Suppressed messages by caller
package Foo::Bar;
sub emerg { $log5->emerg($message) }
package Cat::Foo::Bar;
sub alert { $log7->alert($message) }
package Cat::Bar::Baz;
sub alert { $log7->alert($message) }
1;