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

Christian Fibich's avatar
Christian Fibich committed
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

29
30
31
32
33
34
35
36
package Log::Dispatch::QueueAppender;

use strict;
use warnings;

our $VERSION = '0.1';

use Log::Dispatch::Output;
37
use Log::Log4perl::Level;
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's avatar
Christian Fibich committed
45
Params::Validate::validation_options(allow_extra => 1);
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's avatar
Christian Fibich committed
56
            queue => {isa => "Thread::Queue"}
57
58
59
60
61
        }
    );

    my $self = bless \%p, $class;
    $self->_basic_init(%p);
62
    $self->{'min_level'} = $p{threshold};
63
64
65
66
67
68
69
70

    return $self;
}

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

71
    $self->{'queue'}->enqueue(\%p) if (!$self->{'queue'}->{'ENDED'});
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's avatar
Christian Fibich committed
84
Log::Dispatch::QueueAppender - Object for logging to a Thread::Queue