#!/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;