package Leyland::Logger;

# ABSTARCT: Logging facilities for Leyland applications

use Moose::Role;
use namespace::autoclean;

=head1 NAME

Leyland::Logger - Logging facilities for Leyland application

=head1 VERSION

version 0.001007

=head1 SYNOPSIS

	# if you're planning on creating a new Leyland logger class,
	# then do something like this:

	package Leyland::Logger::SomeLogger;

	use Moose;
	use namespace::autoclean;
	use SomeLogger;

	has 'obj' => (is => 'ro', isa => 'SomeLogger', writer => '_set_obj');

	with 'Leyland::Logger';

	sub init {
		my ($self, $opts) = @_;

		$self->_set_obj(SomeLogger->new(%$opts));
	}

	sub log {
		my ($self, $msg) = @_;

		$self->obj->log(level => $msg->{level}, message => $msg->{message});
	}

	__PACKAGE__->meta->make_immutable;

=head1 DESCRIPTION

This L<Moose role|Moose::Role> describes how Leyland logger classes, used
to log messages generated by the application, are to be built. A logger
class will probably use a logger engine, like <Log::Dispatch>, to log
messages.

Leyland's default logger class is L<Leyland::Logger::STDERR>, which simply
logs messages to the standard error output stream.

=head1 ATTRIBUTES

=head2 exec

A subroutine reference to be automatically called before printing a log
message. This subroutine will receive anything in the "args" attribute,
plus the message to log. Not used by default.

=head2 args

An array refernce of arguments to pass to the "exec" subroutine.

=head1 REQUIRED METHODS

Consuming classes must implement the following methods:

=head2 init( \%opts )

Receives whatever options where defined for the logger in the application's
configuration hash-ref, and initializes a logger object for usage by
the logger class. If initialization is not needed, you can define a method
that doesn't do anything.

=head2 log( { level => $level, message => $msg } )

Receives a hash-ref with a level string and a message to log, and prints
the message to the log, possibly using the object created by the C<init()>
method.

=cut

requires 'init';

requires 'log';

has 'exec' => (is => 'ro', isa => 'CodeRef', writer => '_set_exec', predicate => 'has_exec', clearer => 'clear_exec');

has 'args' => (is => 'rw', isa => 'ArrayRef', writer => '_set_args', predicate => 'has_args', clearer => 'clear_args');

=head1 METHODS

=head2 debug( $msg )

Generates a debug message.

=cut

sub debug {
	$_[0]->log({ level => 'debug', message => $_[1] });
}

=head2 info( $msg )

Generates an info message.

=cut

sub info {
	$_[0]->log({ level => 'info', message => $_[1] });
}

=head2 warn( $msg )

Generates a warning message.

=cut

sub warn {
	$_[0]->log({ level => 'warn', message => $_[1] });
}

=head2 error( $msg )

Generates an error message.

=cut

sub error {
	$_[0]->log({ level => 'error', message => $_[1] });
}

=head2 set_exec( \&sub, [ @args ] )

Receives a reference to a subroutine and possibly a list of arguments,
saves the subroutine as the "exec" attribute and the arguments as the
"args" attribute.

=head2 has_exec()

Returns a true value if the "exec" attribute has a subroutine reference in it.

=head2 clear_exec()

Removes the current value of the "exec" attribute (if any).

=head2 has_args()

Returns a true value if the "args" attribute has an array-reference in it.

=head2 clear_args()

Removes the current value of the "args" attribute (if any).

=cut

sub set_exec {
	my ($self, $sub) = (shift, shift);

	$self->_set_exec($sub);
	$self->_set_args(\@_) if scalar @_;
}

around [qw/debug info warn error/] => sub {
	my ($orig, $self, $msg) = @_;

	if ($self->has_exec) {
		my @args = ($msg);
		unshift(@args, @{$self->args}) if $self->has_args;
		$msg = $self->exec->(@args);
		chomp($msg);
	}

	return $self->$orig($msg);
};

=head1 AUTHOR

Ido Perlmuter, C<< <ido at ido50.net> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-Leyland at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Leyland>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

	perldoc Leyland::Logger

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Leyland>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Leyland>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Leyland>

=item * Search CPAN

L<http://search.cpan.org/dist/Leyland/>

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2010-2011 Ido Perlmuter.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut

1;
