initial implementation of LDC

1 files changed, 119 insertions, 0 deletions

diff --git a/lib/Log/Dispatch/Channels.pm b/lib/Log/Dispatch/Channels.pm
new file mode 100644
index 0000000..aa0fd23
--- /dev/null
+++ b/lib/Log/Dispatch/Channels.pm
@@ -0,0 +1,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;