QueueAppender.pm 2.08 KB
 Stefan Tauner committed May 04, 2018 1 2 3 #----------------------------------------------------------------------- # Fault InJection Instrumenter (FIJI) # https://embsys.technikum-wien.at/projects/vecs/fiji  Christian Fibich committed May 04, 2018 4 #  Stefan Tauner committed May 04, 2018 5 6 7 8 # The creation of this file has been supported by the publicly funded # R&D project Josef Ressel Center for Verification of Embedded Computing # Systems (VECS) managed by the Christian Doppler Gesellschaft (CDG). #  Stefan Tauner committed May 04, 2018 9 10 11 # Authors: # Christian Fibich # Stefan Tauner  Christian Fibich committed May 04, 2018 12 #  Stefan Tauner committed May 04, 2018 13 14 # This module is free software; you can redistribute it and/or modify # it under the same terms as Perl itself.  Christian Fibich committed May 04, 2018 15 #  Stefan Tauner committed May 04, 2018 16 17 18 # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  Christian Fibich committed May 04, 2018 19 #  Stefan Tauner committed May 04, 2018 20 21 # See the LICENSE file for more details. #-----------------------------------------------------------------------  Christian Fibich committed May 04, 2018 22   Christian Fibich committed May 04, 2018 23 24 25 26 27 28 ## @file QueueAppender.pm # @brief Contains class \ref Log::Dispatch::QueueAppender ## @class Log::Dispatch::QueueAppender # @brief Stub Log Appender which just forwards log entries to a Thread::Queue  Christian Fibich committed May 04, 2018 29 30 31 32 33 34 35 36 package Log::Dispatch::QueueAppender; use strict; use warnings; our $VERSION = '0.1'; use Log::Dispatch::Output;  Christian Fibich committed May 04, 2018 37 use Log::Log4perl::Level;  Christian Fibich committed May 04, 2018 38 39 40 41 42 43 44  use base qw( Log::Dispatch::Output ); use threads; use Thread::Queue; use Encode qw( encode ); use IO::Handle; use Params::Validate qw(validate BOOLEAN);  Christian Fibich committed May 04, 2018 45 Params::Validate::validation_options(allow_extra => 1);  Christian Fibich committed May 04, 2018 46 47 48 49 50 51 52 53 54 55  sub new { my$proto = shift; my $class = ref$proto || $proto; my %p = validate( @_, { threshold => { default => "trace", },  Christian Fibich committed May 04, 2018 56  queue => {isa => "Thread::Queue"}  Christian Fibich committed May 04, 2018 57 58 59 60 61  } ); my$self = bless \%p, $class;$self->_basic_init(%p);  Christian Fibich committed May 04, 2018 62  $self->{'min_level'} =$p{threshold};  Christian Fibich committed May 04, 2018 63 64 65 66 67 68 69 70  return $self; } sub log_message { my$self = shift; my %p = @_;  Christian Fibich committed May 04, 2018 71  $self->{'queue'}->enqueue(\%p) if (!$self->{'queue'}->{'ENDED'});  Christian Fibich committed May 04, 2018 72 73 74 75 76 77 78 79 80 81 82 83 } 1; # ABSTRACT: Object for logging to the specified Tk::Text widget __END__ =pod =head1 NAME  Christian Fibich committed May 04, 2018 84 Log::Dispatch::QueueAppender - Object for logging to a Thread::Queue