1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
#!/usr/bin/perl
package Log::Dispatch::Channels;
use strict;
use warnings;
use Log::Dispatch;
use Carp;
sub new {
my $class = shift;
my $self = bless {
channels => {},
outputs => {},
}, $class;
return $self;
}
sub new_channel {
my $self = shift;
my $channel = shift;
carp "Channel $channel already exists!"
if exists $self->{channels}{$channel};
$self->{channels}{$channel} = Log::Dispatch->new(@_);
}
sub _forward_to_channels {
my $self = shift;
my $channels = shift || [keys $self->{channels}];
my $method = shift;
# XXX: sort of a hack - the return value is only used by would_log, which
# just wants a boolean
my $ret = 0;
for my $channel (@$channels) {
$ret ||= $self->{channels}{$channel}->$method(@_);
}
return $ret;
}
sub add {
my $self = shift;
my $output = shift;
my %args = @_;
carp "Output " . $output->name . " already exists!"
if exists $self->{outputs}{$output->name};
$self->_forward_to_channels($args{channels}, 'add', $output);
$self->{outputs}{$output->name} = $output;
}
sub remove {
my $self = shift;
my $output = shift;
my %args = @_;
$self->_forward_to_channels($args{channels}, 'remove', $output);
return delete $self->{outputs}{$output};
}
sub log {
my $self = shift;
my %args = @_;
my $channels = delete $args{channels};
$self->_forward_to_channels($channels, 'log', %args);
}
sub log_and_die {
my $self = shift;
my %args = @_;
my $channels = delete $args{channels};
$self->_forward_to_channels($channels, 'log_and_die', %args);
}
sub log_and_croak {
my $self = shift;
my %args = @_;
my $channels = delete $args{channels};
$self->_forward_to_channels($channels, 'log_and_croak', %args);
}
sub log_to {
my $self = shift;
my %args = @_;
my $output = delete $args{name};
$self->{outputs}{$output}->log(%args);
}
sub would_log {
my $self = shift;
my $level = shift;
my %args = @_;
my $channels = delete $args{channels};
return $self->_forward_to_channels($channels, 'would_log', $level);
}
sub output {
my $self = shift;
my $output = shift;
return $self->{outputs}{$output} if exists $self->{outputs}{$output};
}
sub channel {
my $self = shift;
my $channel = shift;
return $self->{channels}{$channel} if exists $self->{channels}{$channel};
}
1;
|