QueueAppender.pm 1.9 KB
Newer Older
1
2
3
#-----------------------------------------------------------------------
# Fault InJection Instrumenter (FIJI)
# https://embsys.technikum-wien.at/projects/vecs/fiji
4
#
5
6
# Copyright (C) 2017 Christian Fibich <fibich@technikum-wien.at>
# Copyright (C) 2017 Stefan Tauner <tauner@technikum-wien.at>
7
#
8
9
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
10
#
11
12
13
# 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.
14
#
15
16
# See the LICENSE file for more details.
#-----------------------------------------------------------------------
17

Christian Fibich's avatar
Christian Fibich committed
18
19
20
21
22
23
## @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

24
25
26
27
28
29
30
31
package Log::Dispatch::QueueAppender;

use strict;
use warnings;

our $VERSION = '0.1';

use Log::Dispatch::Output;
32
use Log::Log4perl::Level;
33
34
35
36
37
38
39

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's avatar
Christian Fibich committed
40
Params::Validate::validation_options(allow_extra => 1);
41
42
43
44
45
46
47
48
49
50

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;

    my %p = validate(
        @_, {
            threshold => {
                default => "trace",
            },
Christian Fibich's avatar
Christian Fibich committed
51
            queue => {isa => "Thread::Queue"}
52
53
54
55
56
        }
    );

    my $self = bless \%p, $class;
    $self->_basic_init(%p);
57
    $self->{'min_level'} = $p{threshold};
58
59
60
61
62
63
64
65

    return $self;
}

sub log_message {
    my $self = shift;
    my %p    = @_;

66
    $self->{'queue'}->enqueue(\%p) if (!$self->{'queue'}->{'ENDED'});
67
68
69
70
71
72
73
74
75
76
77
78
}

1;

# ABSTRACT: Object for logging to the specified Tk::Text widget

__END__

=pod

=head1 NAME

Christian Fibich's avatar
Christian Fibich committed
79
Log::Dispatch::QueueAppender - Object for logging to a Thread::Queue