percona-toolkit/lib/Percona/Agent/Logger.pm

# This program is copyright 2013 Percona Ireland Ltd.
# Feedback and improvements are welcome.
#
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation, version 2; OR the Perl Artistic License.  On UNIX and similar
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
# licenses.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
# Place, Suite 330, Boston, MA  02111-1307  USA.
# ###########################################################################
# Percona::Agent::Logger package
# ###########################################################################
package Percona::Agent::Logger;

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);

use constant PTDEBUG => $ENV{PTDEBUG} || 0;

use JSON;
use threads;
use Thread::Queue;

use Lmo;
use Transformers;
use Percona::WebAPI::Resource::LogEntry;

Transformers->import(qw(ts));

has 'level' => (
   is       => 'rw',
   isa      => 'Int',
   required => 0,
   default  => sub { return 1; },  # info
);

has 'client' => (
   is       => 'rw',
   isa      => 'Object',
   required => 0,
);

has 'log_link' => (
   is       => 'rw',
   isa      => 'Str',
   required => 0,
);

has 'exit_status' => (
   is       => 'rw',
   isa      => 'ScalarRef',
   required => 1,
);

has '_message_queue' => (
   is       => 'rw',
   isa      => 'Object',
   required => 0,
);

has '_thread' => (
   is       => 'rw',
   isa      => 'Object',
   required => 0,
);

has 'online_logging' => (
   is       => 'rw',
   isa      => 'Bool',
   required => 0,
   default  => sub { return 0 },
);

sub enable_online_logging {
   my ($self, %args) = @_;
   my $client   = $args{client};
   my $log_link = $args{log_link};

   $self->_message_queue(Thread::Queue->new());

   $self->_thread(
      threads::async {
         my @log_entries;
         my $oktorun = 1;
         QUEUE:
         while ( $oktorun ) {
            my $max_log_entries = 1_000;  # for each POST + backlog
            while (    $self->_message_queue
                    && $self->_message_queue->pending()
                    && $max_log_entries--
                    && (my $entry = $self->_message_queue->dequeue()) )
            {
               $oktorun = 0 if !defined $entry;
               # $event = [ level, "message" ]
               push @log_entries, Percona::WebAPI::Resource::LogEntry->new(
                  log_level => $entry->[0],
                  message   => $entry->[1],
               );
            }
            if ( scalar @log_entries ) { 
               eval {
                  $client->post(
                     link      => $log_link,
                     resources => \@log_entries,
                  );
               };
               if ( my $e = $EVAL_ERROR ) {
                  warn "$e";
               }
               else {
                  @log_entries = ();
               }
            }  # have log entries
            sleep ($self->_message_queue ? 3 : 5);
         }  # QUEUE
      }  # threads::async
   );

   $self->online_logging(1);

   return;
}

sub level_number {
   my $name = shift;
   die "No log level name given" unless $name;
   my $number = $name eq 'DEBUG'   ? 1
              : $name eq 'INFO'    ? 2
              : $name eq 'WARNING' ? 3
              : $name eq 'ERROR'   ? 4
              : $name eq 'FATAL'   ? 5
              : die "Invalid log level name: $name";
}

sub debug {
   my $self = shift;
   return unless $self->level >= 1;
   return $self->_log('DEBUG', @_);
}

sub info {
   my $self = shift;
   return unless $self->level >= 2;
   return $self->_log('INFO', @_);
}

sub warn {
   my $self = shift;
   $self->_set_exit_status();
   return unless $self->level >= 3;
   return $self->_log('WARNING', @_);
}

sub error {
   my $self = shift;
   $self->_set_exit_status();
   return unless $self->level >= 4;
   return $self->_log('ERROR', @_);
}

sub fatal {
   my $self = shift;
   $self->_set_exit_status();
   $self->_log('FATAL', @_);
   exit $self->exit_status;
}

sub _set_exit_status {
   my $self = shift;
   # exit_status is a scalar ref
   my $exit_status = $self->exit_status;  # get ref
   $$exit_status |= 1;                    # deref to set
   $self->exit_status($exit_status);      # save back ref
   return;
}

sub _log {
   my ($self, $level, $msg) = @_;
   chomp($msg);
   my $ts = ts(time, 1);  # 1=UTC
   my $level_number = level_number($level);
   if ( $level_number >= 3 ) {  # warning
      print STDERR "$ts $level $msg\n";
   }
   else {
      print "$ts $level $msg\n";
   }
   if ( $self->online_logging ) {
      my @event :shared = ($level_number, $msg);
      $self->_message_queue->enqueue(\@event);
   }
   return;
}

sub DESTROY {
   my $self = shift;
   if ( $self->_message_queue ) {
      $self->_message_queue->enqueue(undef);  # stop thread's while loop
      $self->_thread->join();
   }
   return;
}

sub _d {
   my ($package, undef, $line) = caller 0;
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
        map { defined $_ ? $_ : 'undef' }
        @_;
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}

no Lmo;
1;
# ###########################################################################
# End Percona::Agent::Logger package
# ###########################################################################