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