File Coverage

blib/lib/XAS/Lib/Log.pm

Criterion	Covered	Total	%
statement	9	42	21.4
branch	0	12	0.0
condition			n/a
subroutine	3	10	30.0
pod	2	4	50.0
total	14	68	20.5

package XAS::Lib::Log;

our $VERSION = '0.03';

use DateTime;
use XAS::Constants ':logging HASHREF';

use XAS::Class
  version    => $VERSION,
  base       => 'XAS::Singleton',
  accessors  => 'logger',
  filesystem => 'File',
  utils      => ':boolean :validation load_module',
  vars => {
    LEVELS => {
      trace => 0,
      debug => 0,
      info  => 1,
      warn  => 1,
      error => 1,
      fatal => 1,
    }
  }
;

#use Data::Dumper;

# ------------------------------------------------------------------------
# Public Methods
# ------------------------------------------------------------------------

sub level {
    my $self  = shift;
    my ($level, $action) = validate_params(\@_, [
        { regex => LOG_LEVELS },
        { optional => 1, default => undef ,
          callbacks => {
              'must be a boolean value or undef' => sub {
                  my $param = shift;
                  return 1 unless (defined($param));
                  return 1 if (is_truthy($param));
                  return 1 if (is_falsey($param));
              }
          }
        },
    ]);

    $self->{$level} = $action if (defined($action));

    return $self->{$level};

}

sub build {
    my $self = shift;
    my ($level, $message) = validate_params(\@_, [
        { regex => LOG_LEVELS },
        1
    ]);

    return {
        hostname => $self->env->host,
        datetime => DateTime->now(time_zone => 'local'),
        process  => $self->env->script,
        pid      => $$,
        msgid    => 0,
        facility => $self->env->log_facility,
        priority => $level,
        message  => $message,
    };

}

sub activate {
    my $self = shift;

    my $type = $self->env->log_type;
    my $logger = 'XAS::Lib::Log::' . ucfirst($type);

    load_module($logger);

    $self->{'logger'} = $logger->new();

}

# ------------------------------------------------------------------------
# Private Methods
# ------------------------------------------------------------------------

sub init {
    my $class = shift;

    my $self = $class->SUPER::init(@_);

    # populate $self for each level using the
    # value in $LEVELS

    my $levels = $self->class->hash_vars('LEVELS');

    while (my ($level, $default) = each %$levels) {

        # set defined levels

        $self->level($level, $default);

        # autogenerate some methods, saves typing

        $self->class->methods($level => sub {
            my $self = shift;

            if ($self->{$level}) {

                my $args = $self->build($level, join(" ", @_));
                $self->logger->output($args);

            }

        });

        $self->class->methods($level . '_msg' => sub {
            my $self = shift;

            if ($self->{$level}) {

                my $args = $self->build($level, $self->message(@_));
                $self->logger->output($args);

            }

        });

    }

    # load and initialize our output mixin

    $self->activate();

    return $self;

}

1;

__END__

=head1 NAME

XAS::Lib::Log - A class for logging in the XAS Environment

=head1 SYNOPSIS

    use XAS::Lib::Log;

    my $log = XAS::Lib::Log->new();

    $log->debug('a debug message');
    $log->info('an info message');
    $log->warn('a warning message');
    $log->error('an error message');
    $log->fatal('a fatal error message');
    $log->trace('a tracing message');

=head1 DESCRIPTION

This module defines a simple logger for  messages
generated by an application.  It is intentionally very simple in design,
providing the bare minimum in functionality with the possibility for
extension by sub-classing.

=head1 METHODS

=head2 new

This will initialize the base object.

=head2 level($level, $boolean)

This will query or toggle the log level. When toggled that particular level is set.
There is no hierarchy of log levels.

=over 4

=item B<$level>

The log level to toggle. This can be one of the following:

 info, warn, error, fatal, debug, trace

=item B<$boolean>

An optional valve. It needs to be 0 or 1 to set the level.

=back

=head2 info($line)

This method will log an entry with an level of "info".

=over 4

=item B<$line>

The message to write out. This can be an array which will be joined with a
"space" separator.

=back

=head2 warn($line)

This method will log an entry with an level of "warn".

=over 4

=item B<$line>

The message to write out. This can be an array which will be joined with a
"space" separator.

=back

=head2 error($line)

This method will log an entry with an level of "error".

=over 4

=item B<$line>

The message to write out. This can be an array which will be joined with a
"space" separator.

=back

=head2 fatal($line)

This method will log an entry with an level of "fatal".

=over 4

=item B<$line>

The message to write out. This can be an array which will be joined with a
"space" separator.

=back

=head2 debug($line)

This method will log an entry with an level of "debug". By default this level
is turned off.

=over 4

=item B<$line>

The message to write out. This can be an array which will be joined with a
"space" separator.

=back

=head2 trace($line)

This method will log an entry with an level of "trace".

=over 4

=item B<$line>

The line to write out. This can be an array which will be joined with a
"space" separator.

=back

=head2 info_msg($message, ...)

This method will log an entry with an level of "info".

=over 4

=item B<$message>

The pre-defined message string. Usually in a message file.

=item B<...>

The items to be used in the pre-defined message.

=back

=head2 warn_msg($message, ...)

This method will log an entry with an level of "warn".

=over 4

=item B<$message>

The pre-defined message string. Usually in a message file.

=item B<...>

The items to be used in the pre-defined message.

=back

=head2 error_msg($message, ...)

This method will log an entry with an level of "error".

=over 4

=item B<$message>

The pre-defined message string. Usually in a message file.

=item B<...>

The items to be used in the pre-defined message.

=back

=head2 fatal_msg($message, ...)

This method will log an entry with an level of "fatal".

=over 4

=item B<$message>

The pre-defined message string. Usually in a message file.

=item B<...>

The items to be used in the pre-defined message.

=back

=head2 debug_msg($message, ...)

This method will log an entry with an level of "debug".

=over 4

=item B<$message>

The pre-defined message string. Usually in a message file.

=item B<...>

The items to be used in the pre-defined message.

=back

=head2 trace_msg($message, ...)

This method will log an entry with an level of "trace".

=over 4

=item B<$message>

The pre-defined message string. Usually in a message file.

=item B<...>

The items to be used in the pre-defined message.

=back

=head1 SEE ALSO

=over 4

=item L<XAS::Lib::Log::Console|XAS::Lib::Log::Console>

=item L<XAS::Lib::Log::File|XAS::Lib::Log::File>

=item L<XAS::Lib::Log::Json|XAS::Lib::Log::Json>

=item L<XAS::Lib::Log::Syslog|XAS::Lib::Log::Syslog>

=item L<XAS|XAS>

=back

=head1 AUTHOR

Kevin L. Esteb, E<lt>[e-mail]<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2012-2015 Kevin L. Esteb

This is free software; you can redistribute it and/or modify it under
the terms of the Artistic License 2.0. For details, see the full text
of the license at http://www.perlfoundation.org/artistic_license_2_0.

=cut