1#!/usr/bin/perl 2 3=head1 AUTHOR 4 5Jonny Schulz <jschulz.cpan(at)bloonix.de> 6 7=head1 DESCRIPTION 8 9Benchmarks... what else could I say... 10 11=head1 POWERED BY 12 13 _ __ _____ _____ __ __ __ __ __ 14 | |__| | | | \| |__|\ \/ / 15 | . | | | | | | | | > < 16 |____|__|_____|_____|__|\__|__|/__/\__\ 17 18=head1 COPYRIGHT 19 20Copyright (C) 2007-2009 by Jonny Schulz. All rights reserved. 21 22This program is free software; you can redistribute it and/or 23modify it under the same terms as Perl itself. 24 25=cut 26 27use strict; 28use warnings; 29use Log::Handler; 30use Benchmark; 31 32sub buffer { } 33my $log1 = Log::Handler->new(); # simple pattern 34my $log2 = Log::Handler->new(); # default pattern & suppressed 35my $log3 = Log::Handler->new(); # complex pattern 36my $log4 = Log::Handler->new(); # message pattern 37my $log5 = Log::Handler->new(); # filtered caller 38my $log6 = Log::Handler->new(); # filtered message 39my $log7 = Log::Handler->new(); # categories 40 41$log1->add( 42 forward => { 43 alias => 'simple pattern', 44 maxlevel => 'notice', 45 minlevel => 'notice', 46 forward_to => \&buffer, 47 message_layout => '%L - %m', 48 } 49); 50 51$log2->add( 52 forward => { 53 alias => 'default pattern & suppressed', 54 maxlevel => 'warning', 55 minlevel => 'warning', 56 forward_to => \&buffer, 57 } 58); 59 60$log3->add( 61 forward => { 62 alias => 'complex pattern', 63 maxlevel => 'info', 64 minlevel => 'info', 65 forward_to => \&buffer, 66 message_layout => '%T [%L] %H(%P) %m (%C)%N', 67 } 68); 69 70$log4->add( 71 forward => { 72 alias => 'message pattern', 73 maxlevel => 'error', 74 minlevel => 'error', 75 forward_to => \&buffer, 76 message_layout => '%m', 77 message_pattern => [qw/%T %L %P/], 78 } 79); 80 81$log5->add( 82 forward => { 83 alias => 'filtered caller', 84 maxlevel => 'emerg', 85 minlevel => 'emerg', 86 forward_to => \&buffer, 87 filter_caller => qr/^Foo\z/, 88 } 89); 90 91$log5->add( 92 forward => { 93 alias => 'filtered caller', 94 maxlevel => 'emerg', 95 minlevel => 'emerg', 96 forward_to => \&buffer, 97 filter_caller => qr/^Bar\z/, 98 } 99); 100 101$log5->add( 102 forward => { 103 alias => 'filtered caller', 104 maxlevel => 'emerg', 105 minlevel => 'emerg', 106 forward_to => \&buffer, 107 filter_caller => qr/^Baz\z/, 108 } 109); 110 111$log6->add( 112 forward => { 113 alias => 'filtered message', 114 maxlevel => 'alert', 115 minlevel => 'alert', 116 forward_to => \&buffer, 117 filter_message => qr/bar/, 118 } 119); 120 121$log6->add( 122 forward => { 123 alias => 'filtered message', 124 maxlevel => 'alert', 125 minlevel => 'alert', 126 forward_to => \&buffer, 127 filter_message => qr/bar/, 128 } 129); 130 131$log7->add( 132 forward => { 133 alias => 'categories', 134 maxlevel => 'alert', 135 minlevel => 'alert', 136 forward_to => \&buffer, 137 category => "Cat::Foo", 138 } 139); 140 141my $count = 100_000; 142my $message = 'foo bar baz'; 143 144run("simple pattern output took", $count, sub { $log1->notice($message) } ); 145run("default pattern output took", $count, sub { $log2->warning($message) } ); 146run("complex pattern output took", $count, sub { $log3->info($message) } ); 147run("message pattern output took", $count, sub { $log4->error($message) } ); 148run("suppressed output took", $count, sub { $log2->debug($message) } ); 149run("filtered caller output took", $count, \&Foo::emerg ); 150run("suppressed caller output took", $count, \&Foo::Bar::emerg ); 151run("filtered messages output took", $count, sub { $log6->alert($message) } ); 152run("categorized messages output took", $count, \&Cat::Foo::Bar::alert ); 153run("suppressed categories output took", $count, \&Cat::Bar::Baz::alert ); 154 155sub run { 156 my ($desc, $count, $bench) = @_; 157 my $time = timeit($count, $bench); 158 print sprintf('%-30s', $desc), ' : ', timestr($time), "\n"; 159} 160 161# Filter messages by caller 162package Foo; 163sub emerg { $log5->emerg($message) } 164 165# Suppressed messages by caller 166package Foo::Bar; 167sub emerg { $log5->emerg($message) } 168 169package Cat::Foo::Bar; 170sub alert { $log7->alert($message) } 171 172package Cat::Bar::Baz; 173sub alert { $log7->alert($message) } 174 1751; 176