Log-Dispatch-2.45HEADLog-Dispatch-2.45master

16 files changed, 2171 insertions, 0 deletions

diff --git a/lib/Log/Dispatch/ApacheLog.pm b/lib/Log/Dispatch/ApacheLog.pm
new file mode 100644
index 0000000..4c5ccb9
--- /dev/null
+++ b/lib/Log/Dispatch/ApacheLog.pm
@@ -0,0 +1,115 @@
+package Log::Dispatch::ApacheLog;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.45';
+
+use Log::Dispatch::Output;
+
+use base qw( Log::Dispatch::Output );
+
+use Params::Validate qw(validate);
+Params::Validate::validation_options( allow_extra => 1 );
+
+BEGIN {
+    if ( $ENV{MOD_PERL} && $ENV{MOD_PERL} =~ /2\./ ) {
+        require Apache2::Log;
+    }
+    else {
+        require Apache::Log;
+    }
+}
+
+sub new {
+    my $proto = shift;
+    my $class = ref $proto || $proto;
+
+    my %p = validate( @_, { apache => { can => 'log' } } );
+
+    my $self = bless {}, $class;
+
+    $self->_basic_init(%p);
+    $self->{apache_log} = $p{apache}->log;
+
+    return $self;
+}
+
+{
+    my %methods = (
+        emergency => 'emerg',
+        critical  => 'crit',
+        warning   => 'warn',
+    );
+
+    sub log_message {
+        my $self = shift;
+        my %p    = @_;
+
+        my $level = $self->_level_as_name( $p{level} );
+
+        my $method = $methods{$level} || $level;
+
+        $self->{apache_log}->$method( $p{message} );
+    }
+}
+
+1;
+
+# ABSTRACT: Object for logging to Apache::Log objects
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Log::Dispatch::ApacheLog - Object for logging to Apache::Log objects
+
+=head1 VERSION
+
+version 2.45
+
+=head1 SYNOPSIS
+
+  use Log::Dispatch;
+
+  my $log = Log::Dispatch->new(
+      outputs => [
+          [ 'ApacheLog', apache => $r ],
+      ],
+  );
+
+  $log->emerg('Kaboom');
+
+=head1 DESCRIPTION
+
+This module allows you to pass messages to Apache's log object,
+represented by the L<Apache::Log> class.
+
+=head1 CONSTRUCTOR
+
+The constructor takes the following parameters in addition to the standard
+parameters documented in L<Log::Dispatch::Output>:
+
+=over 4
+
+=item * apache ($)
+
+An object of either the L<Apache> or L<Apache::Server> classes. Required.
+
+=back
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2015 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+=cut
diff --git a/lib/Log/Dispatch/Base.pm b/lib/Log/Dispatch/Base.pm
new file mode 100644
index 0000000..368c6fa
--- /dev/null
+++ b/lib/Log/Dispatch/Base.pm
@@ -0,0 +1,91 @@
+package Log::Dispatch::Base;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.45';
+
+sub _get_callbacks {
+    shift;
+    my %p = @_;
+
+    return unless exists $p{callbacks};
+
+    return @{ $p{callbacks} }
+        if ref $p{callbacks} eq 'ARRAY';
+
+    return $p{callbacks}
+        if ref $p{callbacks} eq 'CODE';
+
+    return;
+}
+
+sub _apply_callbacks {
+    my $self = shift;
+    my %p    = @_;
+
+    my $msg = delete $p{message};
+    foreach my $cb ( @{ $self->{callbacks} } ) {
+        $msg = $cb->( message => $msg, %p );
+    }
+
+    return $msg;
+}
+
+sub add_callback {
+    my $self  = shift;
+    my $value = shift;
+
+    Carp::carp("given value $value is not a valid callback")
+        unless ref $value eq 'CODE';
+
+    $self->{callbacks} ||= [];
+    push @{ $self->{callbacks} }, $value;
+
+    return;
+}
+
+1;
+
+# ABSTRACT: Code shared by dispatch and output objects.
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Log::Dispatch::Base - Code shared by dispatch and output objects.
+
+=head1 VERSION
+
+version 2.45
+
+=head1 SYNOPSIS
+
+  use Log::Dispatch::Base;
+
+  ...
+
+  @ISA = qw(Log::Dispatch::Base);
+
+=head1 DESCRIPTION
+
+Unless you are me, you probably don't need to know what this class
+does.
+
+=for Pod::Coverage add_callback
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2015 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+=cut
diff --git a/lib/Log/Dispatch/Code.pm b/lib/Log/Dispatch/Code.pm
new file mode 100644
index 0000000..e06bbfd
--- /dev/null
+++ b/lib/Log/Dispatch/Code.pm
@@ -0,0 +1,122 @@
+package Log::Dispatch::Code;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.45';
+
+use Log::Dispatch::Output;
+
+use base qw( Log::Dispatch::Output );
+
+use Params::Validate qw(validate CODEREF);
+Params::Validate::validation_options( allow_extra => 1 );
+
+sub new {
+    my $proto = shift;
+    my $class = ref $proto || $proto;
+
+    my %p = validate( @_, { code => CODEREF } );
+
+    my $self = bless {}, $class;
+
+    $self->_basic_init(%p);
+    $self->{code} = $p{code};
+
+    return $self;
+}
+
+sub log_message {
+    my $self = shift;
+    my %p    = @_;
+
+    delete $p{name};
+
+    $self->{code}->(%p);
+}
+
+1;
+
+# ABSTRACT: Object for logging to a subroutine reference
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Log::Dispatch::Code - Object for logging to a subroutine reference
+
+=head1 VERSION
+
+version 2.45
+
+=head1 SYNOPSIS
+
+  use Log::Dispatch;
+
+  my $log = Log::Dispatch->new(
+      outputs => [
+          [
+              'Code',
+              min_level => 'emerg',
+              code      => \&_log_it,
+          ],
+      ]
+  );
+
+  sub _log_it {
+      my %p = @_;
+
+      warn $p{message};
+  }
+
+=head1 DESCRIPTION
+
+This module supplies a simple object for logging to a subroutine reference.
+
+=for Pod::Coverage new log_message
+
+=head1 CONSTRUCTOR
+
+The constructor takes the following parameters in addition to the standard
+parameters documented in L<Log::Dispatch::Output>:
+
+=over 4
+
+=item * code ($)
+
+The subroutine reference.
+
+=back
+
+=head1 HOW IT WORKS
+
+The subroutine you provide will be called with a hash of named arguments. The
+two arguments are:
+
+=over 4
+
+=item * level
+
+The log level of the message. This will be a string like "info" or "error".
+
+=item * message
+
+The message being logged.
+
+=back
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2015 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+=cut
diff --git a/lib/Log/Dispatch/Conflicts.pm b/lib/Log/Dispatch/Conflicts.pm
new file mode 100644
index 0000000..9f528e5
--- /dev/null
+++ b/lib/Log/Dispatch/Conflicts.pm
@@ -0,0 +1,33 @@
+package # hide from PAUSE
+    Log::Dispatch::Conflicts;
+
+use strict;
+use warnings;
+
+# this module was generated with Dist::Zilla::Plugin::Conflicts 0.17
+
+use Dist::CheckConflicts
+    -dist      => 'Log::Dispatch',
+    -conflicts => {
+        'Log::Dispatch::File::Stamped' => '0.10',
+    },
+    -also => [ qw(
+        Carp
+        Devel::GlobalDestruction
+        Dist::CheckConflicts
+        Fcntl
+        Module::Runtime
+        Params::Validate
+        Scalar::Util
+        Sys::Syslog
+        base
+        strict
+        warnings
+    ) ],
+
+;
+
+1;
+
+# ABSTRACT: Provide information on conflicts for Log::Dispatch
+# Dist::Zilla: -PodWeaver
diff --git a/lib/Log/Dispatch/Email.pm b/lib/Log/Dispatch/Email.pm
new file mode 100644
index 0000000..b10604a
--- /dev/null
+++ b/lib/Log/Dispatch/Email.pm
@@ -0,0 +1,207 @@
+package Log::Dispatch::Email;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.45';
+
+use Log::Dispatch::Output;
+
+use base qw( Log::Dispatch::Output );
+
+use Devel::GlobalDestruction qw( in_global_destruction );
+use Params::Validate qw(validate SCALAR ARRAYREF BOOLEAN);
+Params::Validate::validation_options( allow_extra => 1 );
+
+# need to untaint this value
+my ($program) = $0 =~ /(.+)/;
+
+sub new {
+    my $proto = shift;
+    my $class = ref $proto || $proto;
+
+    my %p = validate(
+        @_, {
+            subject => {
+                type    => SCALAR,
+                default => "$program: log email"
+            },
+            to   => { type => SCALAR | ARRAYREF },
+            from => {
+                type     => SCALAR,
+                optional => 1
+            },
+            buffered => {
+                type    => BOOLEAN,
+                default => 1
+            },
+        }
+    );
+
+    my $self = bless {}, $class;
+
+    $self->_basic_init(%p);
+
+    $self->{subject} = $p{subject} || "$0: log email";
+    $self->{to} = ref $p{to} ? $p{to} : [ $p{to} ];
+    $self->{from} = $p{from};
+
+    # Default to buffered for obvious reasons!
+    $self->{buffered} = $p{buffered};
+
+    $self->{buffer} = [] if $self->{buffered};
+
+    return $self;
+}
+
+sub log_message {
+    my $self = shift;
+    my %p    = @_;
+
+    if ( $self->{buffered} ) {
+        push @{ $self->{buffer} }, $p{message};
+    }
+    else {
+        $self->send_email(@_);
+    }
+}
+
+sub send_email {
+    my $self  = shift;
+    my $class = ref $self;
+
+    die "The send_email method must be overridden in the $class subclass";
+}
+
+sub flush {
+    my $self = shift;
+
+    if ( $self->{buffered} && @{ $self->{buffer} } ) {
+        my $message = join '', @{ $self->{buffer} };
+
+        $self->send_email( message => $message );
+        $self->{buffer} = [];
+    }
+}
+
+sub DESTROY {
+    my $self = shift;
+
+    if (   in_global_destruction()
+        && $self->{buffered}
+        && @{ $self->{buffer} } ) {
+
+        my $name  = $self->name();
+        my $class = ref $self;
+        my $message
+            = "Log messages for the $name output (a $class object) remain unsent but the program is terminating.\n";
+        $message .= "The messages are:\n";
+        $message .= "  $_\n" for @{ $self->{buffer} };
+    }
+    else {
+        $self->flush();
+    }
+}
+
+1;
+
+# ABSTRACT: Base class for objects that send log messages via email
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Log::Dispatch::Email - Base class for objects that send log messages via email
+
+=head1 VERSION
+
+version 2.45
+
+=head1 SYNOPSIS
+
+  package Log::Dispatch::Email::MySender;
+
+  use Log::Dispatch::Email;
+  use base qw( Log::Dispatch::Email );
+
+  sub send_email {
+      my $self = shift;
+      my %p    = @_;
+
+      # Send email somehow. Message is in $p{message}
+  }
+
+=head1 DESCRIPTION
+
+This module should be used as a base class to implement
+Log::Dispatch::* objects that send their log messages via email.
+Implementing a subclass simply requires the code shown in the
+L<SYNOPSIS> with a real implementation of the C<send_email()> method.
+
+=for Pod::Coverage new log_message
+
+=head1 CONSTRUCTOR
+
+The constructor takes the following parameters in addition to the standard
+parameters documented in L<Log::Dispatch::Output>:
+
+=over 4
+
+=item * subject ($)
+
+The subject of the email messages which are sent. Defaults to "$0:
+log email"
+
+=item * to ($ or \@)
+
+Either a string or a list reference of strings containing email
+addresses. Required.
+
+=item * from ($)
+
+A string containing an email address. This is optional and may not
+work with all mail sending methods.
+
+=item * buffered (0 or 1)
+
+This determines whether the object sends one email per message it is
+given or whether it stores them up and sends them all at once. The
+default is to buffer messages.
+
+=back
+
+=head1 METHODS
+
+This class provides the following methods:
+
+=head2 $email->send_email(%p)
+
+This is the method that must be subclassed. For now the only
+parameter in the hash is 'message'.
+
+=head2 $email->flush
+
+If the object is buffered, then this method will call the
+C<send_email()> method to send the contents of the buffer and then
+clear the buffer.
+
+=head2 $email->DESTROY
+
+On destruction, the object will call C<flush()> to send any pending
+email.
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2015 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+=cut
diff --git a/lib/Log/Dispatch/Email/MIMELite.pm b/lib/Log/Dispatch/Email/MIMELite.pm
new file mode 100644
index 0000000..aadf5de
--- /dev/null
+++ b/lib/Log/Dispatch/Email/MIMELite.pm
@@ -0,0 +1,83 @@
+package Log::Dispatch::Email::MIMELite;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.45';
+
+use Log::Dispatch::Email;
+
+use base qw( Log::Dispatch::Email );
+
+use MIME::Lite;
+
+sub send_email {
+    my $self = shift;
+    my %p    = @_;
+
+    my %mail = (
+        To      => ( join ',', @{ $self->{to} } ),
+        Subject => $self->{subject},
+        Type    => 'TEXT',
+        Data    => $p{message},
+    );
+
+    $mail{From} = $self->{from} if defined $self->{from};
+
+    local $?;
+    unless ( MIME::Lite->new(%mail)->send ) {
+        warn "Error sending mail with MIME::Lite";
+    }
+}
+
+1;
+
+# ABSTRACT: Subclass of Log::Dispatch::Email that uses the MIME::Lite module
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Log::Dispatch::Email::MIMELite - Subclass of Log::Dispatch::Email that uses the MIME::Lite module
+
+=head1 VERSION
+
+version 2.45
+
+=head1 SYNOPSIS
+
+  use Log::Dispatch;
+
+  my $log = Log::Dispatch->new(
+      outputs => [
+          [
+              'Email::MIMELite',
+              min_level => 'emerg',
+              to        => [qw( foo@example.com bar@example.org )],
+              subject   => 'Big error!'
+          ]
+      ],
+  );
+
+  $log->emerg("Something bad is happening");
+
+=head1 DESCRIPTION
+
+This is a subclass of L<Log::Dispatch::Email> that implements the
+send_email method using the L<MIME::Lite> module.
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2015 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+=cut
diff --git a/lib/Log/Dispatch/Email/MailSend.pm b/lib/Log/Dispatch/Email/MailSend.pm
new file mode 100644
index 0000000..10a7018
--- /dev/null
+++ b/lib/Log/Dispatch/Email/MailSend.pm
@@ -0,0 +1,102 @@
+package Log::Dispatch::Email::MailSend;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.45';
+
+use Log::Dispatch::Email;
+
+use base qw( Log::Dispatch::Email );
+
+use Mail::Send;
+
+sub send_email {
+    my $self = shift;
+    my %p    = @_;
+
+    my $msg = Mail::Send->new;
+
+    $msg->to( join ',', @{ $self->{to} } );
+    $msg->subject( $self->{subject} );
+
+    # Does this ever work for this module?
+    $msg->set( 'From', $self->{from} ) if $self->{from};
+
+    local $?;
+    eval {
+        my $fh = $msg->open
+            or die "Cannot open handle to mail program";
+
+        $fh->print( $p{message} )
+            or die "Cannot print message to mail program handle";
+
+        $fh->close
+            or die "Cannot close handle to mail program";
+    };
+
+    warn $@ if $@;
+}
+
+1;
+
+# ABSTRACT: Subclass of Log::Dispatch::Email that uses the Mail::Send module
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Log::Dispatch::Email::MailSend - Subclass of Log::Dispatch::Email that uses the Mail::Send module
+
+=head1 VERSION
+
+version 2.45
+
+=head1 SYNOPSIS
+
+  use Log::Dispatch;
+
+  my $log = Log::Dispatch->new(
+      outputs => [
+          [
+              'Email::MailSend',
+              min_level => 'emerg',
+              to        => [qw( foo@example.com bar@example.org )],
+              subject   => 'Big error!'
+          ]
+      ],
+  );
+
+  $log->emerg("Something bad is happening");
+
+=head1 DESCRIPTION
+
+This is a subclass of L<Log::Dispatch::Email> that implements the send_email
+method using the L<Mail::Send> module.
+
+=head1 CHANGING HOW MAIL IS SENT
+
+Since L<Mail::Send> is a subclass of L<Mail::Mailer>, you can change
+how mail is sent from this module by simply C<use>ing L<Mail::Mailer>
+in your code before mail is sent. For example, to send mail via smtp,
+you could do:
+
+  use Mail::Mailer 'smtp', Server => 'foo.example.com';
+
+For more details, see the L<Mail::Mailer> docs.
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2015 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+=cut
diff --git a/lib/Log/Dispatch/Email/MailSender.pm b/lib/Log/Dispatch/Email/MailSender.pm
new file mode 100644
index 0000000..8d561c7
--- /dev/null
+++ b/lib/Log/Dispatch/Email/MailSender.pm
@@ -0,0 +1,130 @@
+package Log::Dispatch::Email::MailSender;
+
+# By: Joseph Annino
+# (c) 2002
+# Licensed under the same terms as Perl
+#
+
+use strict;
+use warnings;
+
+our $VERSION = '2.45';
+
+use Log::Dispatch::Email;
+
+use base qw( Log::Dispatch::Email );
+
+use Mail::Sender ();
+
+sub new {
+    my $proto = shift;
+    my $class = ref $proto || $proto;
+
+    my %p = @_;
+
+    my $smtp = delete $p{smtp} || 'localhost';
+    my $port = delete $p{port} || '25';
+
+    my $self = $class->SUPER::new(%p);
+
+    $self->{smtp} = $smtp;
+    $self->{port} = $port;
+
+    return $self;
+}
+
+sub send_email {
+    my $self = shift;
+    my %p    = @_;
+
+    local $?;
+    eval {
+        my $sender = Mail::Sender->new(
+            {
+                from    => $self->{from} || 'LogDispatch@foo.bar',
+                replyto => $self->{from} || 'LogDispatch@foo.bar',
+                to      => ( join ',', @{ $self->{to} } ),
+                subject => $self->{subject},
+                smtp    => $self->{smtp},
+                port    => $self->{port},
+            }
+        );
+
+        die "Error sending mail ($sender): $Mail::Sender::Error"
+            unless ref $sender;
+
+        ref $sender->MailMsg( { msg => $p{message} } )
+            or die "Error sending mail: $Mail::Sender::Error";
+    };
+
+    warn $@ if $@;
+}
+
+1;
+
+# ABSTRACT: Subclass of Log::Dispatch::Email that uses the Mail::Sender module
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Log::Dispatch::Email::MailSender - Subclass of Log::Dispatch::Email that uses the Mail::Sender module
+
+=head1 VERSION
+
+version 2.45
+
+=head1 SYNOPSIS
+
+  use Log::Dispatch;
+
+  my $log = Log::Dispatch->new(
+      outputs => [
+          [
+              'Email::MailSender',
+              min_level => 'emerg',
+              to        => [qw( foo@example.com bar@example.org )],
+              subject   => 'Big error!'
+          ]
+      ],
+  );
+
+  $log->emerg("Something bad is happening");
+
+=head1 DESCRIPTION
+
+This is a subclass of L<Log::Dispatch::Email> that implements the send_email
+method using the L<Mail::Sender> module.
+
+=head1 CONSTRUCTOR
+
+The constructor takes the following parameters in addition to the parameters
+documented in L<Log::Dispatch::Output> and L<Log::Dispatch::Email>:
+
+=over 4
+
+=item * smtp ($)
+
+The smtp server to connect to. This defaults to "localhost".
+
+=item * port ($)
+
+The port to use when connecting. This defaults to 25.
+
+=back
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2015 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+=cut
diff --git a/lib/Log/Dispatch/Email/MailSendmail.pm b/lib/Log/Dispatch/Email/MailSendmail.pm
new file mode 100644
index 0000000..c00f8c4
--- /dev/null
+++ b/lib/Log/Dispatch/Email/MailSendmail.pm
@@ -0,0 +1,83 @@
+package Log::Dispatch::Email::MailSendmail;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.45';
+
+use Log::Dispatch::Email;
+
+use base qw( Log::Dispatch::Email );
+
+use Mail::Sendmail ();
+
+sub send_email {
+    my $self = shift;
+    my %p    = @_;
+
+    my %mail = (
+        To      => ( join ',', @{ $self->{to} } ),
+        Subject => $self->{subject},
+        Message => $p{message},
+
+        # Mail::Sendmail insists on having this parameter.
+        From => $self->{from} || 'LogDispatch@foo.bar',
+    );
+
+    local $?;
+    unless ( Mail::Sendmail::sendmail(%mail) ) {
+        warn "Error sending mail: $Mail::Sendmail::error";
+    }
+}
+
+1;
+
+# ABSTRACT: Subclass of Log::Dispatch::Email that uses the Mail::Sendmail module
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Log::Dispatch::Email::MailSendmail - Subclass of Log::Dispatch::Email that uses the Mail::Sendmail module
+
+=head1 VERSION
+
+version 2.45
+
+=head1 SYNOPSIS
+
+  use Log::Dispatch;
+
+  my $log = Log::Dispatch->new(
+      outputs => [
+          [
+              'Email::MailSendmail',
+              min_level => 'emerg',
+              to        => [qw( foo@example.com bar@example.org )],
+              subject   => 'Big error!'
+          ]
+      ],
+  );
+
+  $log->emerg("Something bad is happening");
+
+=head1 DESCRIPTION
+
+This is a subclass of L<Log::Dispatch::Email> that implements the
+send_email method using the L<Mail::Sendmail> module.
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2015 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+=cut
diff --git a/lib/Log/Dispatch/File.pm b/lib/Log/Dispatch/File.pm
new file mode 100644
index 0000000..4b39ecb
--- /dev/null
+++ b/lib/Log/Dispatch/File.pm
@@ -0,0 +1,285 @@
+package Log::Dispatch::File;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.45';
+
+use Log::Dispatch::Output;
+
+use base qw( Log::Dispatch::Output );
+
+use Params::Validate qw(validate SCALAR BOOLEAN);
+Params::Validate::validation_options( allow_extra => 1 );
+
+use Scalar::Util qw( openhandle );
+
+# Prevents death later on if IO::File can't export this constant.
+*O_APPEND = \&APPEND unless defined &O_APPEND;
+
+sub APPEND {0}
+
+sub new {
+    my $proto = shift;
+    my $class = ref $proto || $proto;
+
+    my %p = @_;
+
+    my $self = bless {}, $class;
+
+    $self->_basic_init(%p);
+    $self->_make_handle;
+
+    return $self;
+}
+
+sub _basic_init {
+    my $self = shift;
+
+    $self->SUPER::_basic_init(@_);
+
+    my %p = validate(
+        @_, {
+            filename => { type => SCALAR },
+            mode     => {
+                type    => SCALAR,
+                default => '>'
+            },
+            binmode => {
+                type    => SCALAR,
+                default => undef
+            },
+            autoflush => {
+                type    => BOOLEAN,
+                default => 1
+            },
+            close_after_write => {
+                type    => BOOLEAN,
+                default => 0
+            },
+            permissions => {
+                type     => SCALAR,
+                optional => 1
+            },
+            syswrite => {
+                type    => BOOLEAN,
+                default => 0
+            },
+        }
+    );
+
+    $self->{filename}    = $p{filename};
+    $self->{binmode}     = $p{binmode};
+    $self->{autoflush}   = $p{autoflush};
+    $self->{close}       = $p{close_after_write};
+    $self->{permissions} = $p{permissions};
+    $self->{syswrite}    = $p{syswrite};
+
+    if ( $self->{close} ) {
+        $self->{mode} = '>>';
+    }
+    elsif (
+           exists $p{mode}
+        && defined $p{mode}
+        && (
+            $p{mode} =~ /^(?:>>|append)$/
+            || (   $p{mode} =~ /^\d+$/
+                && $p{mode} == O_APPEND() )
+        )
+        ) {
+        $self->{mode} = '>>';
+    }
+    else {
+        $self->{mode} = '>';
+    }
+
+}
+
+sub _make_handle {
+    my $self = shift;
+
+    $self->_open_file() unless $self->{close};
+}
+
+sub _open_file {
+    my $self = shift;
+
+    open my $fh, $self->{mode}, $self->{filename}
+        or die "Cannot write to '$self->{filename}': $!";
+
+    if ( $self->{autoflush} ) {
+        my $oldfh = select $fh;
+        $| = 1;
+        select $oldfh;
+    }
+
+    if ( $self->{permissions}
+        && !$self->{chmodded} ) {
+        my $current_mode = ( stat $self->{filename} )[2] & 07777;
+        if ( $current_mode ne $self->{permissions} ) {
+            chmod $self->{permissions}, $self->{filename}
+                or die
+                "Cannot chmod $self->{filename} to $self->{permissions}: $!";
+        }
+
+        $self->{chmodded} = 1;
+    }
+
+    if ( $self->{binmode} ) {
+        binmode $fh, $self->{binmode};
+    }
+
+    $self->{fh} = $fh;
+}
+
+sub log_message {
+    my $self = shift;
+    my %p    = @_;
+
+    if ( $self->{close} ) {
+        $self->_open_file;
+    }
+
+    my $fh = $self->{fh};
+
+    if ( $self->{syswrite} ) {
+        defined syswrite( $fh, $p{message} )
+            or die "Cannot write to '$self->{filename}': $!";
+    }
+    else {
+        print $fh $p{message}
+            or die "Cannot write to '$self->{filename}': $!";
+    }
+
+    if ( $self->{close} ) {
+        close $fh
+            or die "Cannot close '$self->{filename}': $!";
+    }
+}
+
+sub DESTROY {
+    my $self = shift;
+
+    if ( $self->{fh} ) {
+        my $fh = $self->{fh};
+        close $fh if openhandle($fh);
+    }
+}
+
+1;
+
+# ABSTRACT: Object for logging to files
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Log::Dispatch::File - Object for logging to files
+
+=head1 VERSION
+
+version 2.45
+
+=head1 SYNOPSIS
+
+  use Log::Dispatch;
+
+  my $log = Log::Dispatch->new(
+      outputs => [
+          [
+              'File',
+              min_level => 'info',
+              filename  => 'Somefile.log',
+              mode      => '>>',
+              newline   => 1
+          ]
+      ],
+  );
+
+  $log->emerg("I've fallen and I can't get up");
+
+=head1 DESCRIPTION
+
+This module provides a simple object for logging to files under the
+Log::Dispatch::* system.
+
+Note that a newline will I<not> be added automatically at the end of a message
+by default. To do that, pass C<< newline => 1 >>.
+
+=for Pod::Coverage new log_message
+
+=head1 CONSTRUCTOR
+
+The constructor takes the following parameters in addition to the standard
+parameters documented in L<Log::Dispatch::Output>:
+
+=over 4
+
+=item * filename ($)
+
+The filename to be opened for writing.
+
+=item * mode ($)
+
+The mode the file should be opened with. Valid options are 'write',
+'>', 'append', '>>', or the relevant constants from Fcntl. The
+default is 'write'.
+
+=item * binmode ($)
+
+A layer name to be passed to binmode, like ":encoding(UTF-8)" or ":raw".
+
+=item * close_after_write ($)
+
+Whether or not the file should be closed after each write. This
+defaults to false.
+
+If this is true, then the mode will always be append, so that the file is not
+re-written for each new message.
+
+=item * autoflush ($)
+
+Whether or not the file should be autoflushed. This defaults to true.
+
+=item * syswrite ($)
+
+Whether or not to perform the write using L<perlfunc/syswrite>(),
+as opposed to L<perlfunc/print>(). This defaults to false.
+The usual caveats and warnings as documented in L<perlfunc/syswrite> apply.
+
+=item * permissions ($)
+
+If the file does not already exist, the permissions that it should
+be created with. Optional. The argument passed must be a valid
+octal value, such as 0600 or the constants available from Fcntl, like
+S_IRUSR|S_IWUSR.
+
+See L<perlfunc/chmod> for more on potential traps when passing octal
+values around. Most importantly, remember that if you pass a string
+that looks like an octal value, like this:
+
+ my $mode = '0644';
+
+Then the resulting file will end up with permissions like this:
+
+ --w----r-T
+
+which is probably not what you want.
+
+=back
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2015 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+=cut
diff --git a/lib/Log/Dispatch/File/Locked.pm b/lib/Log/Dispatch/File/Locked.pm
new file mode 100644
index 0000000..aac9496
--- /dev/null
+++ b/lib/Log/Dispatch/File/Locked.pm
@@ -0,0 +1,96 @@
+package Log::Dispatch::File::Locked;
+
+use strict;
+use warnings;
+
+use base qw( Log::Dispatch::File );
+
+our $VERSION = '2.45';
+
+use Fcntl qw(:DEFAULT :flock);
+
+sub _open_file {
+    my $self = shift;
+
+    $self->SUPER::_open_file();
+
+    my $fh = $self->{fh};
+
+    flock( $fh, LOCK_EX )
+        or die "Cannot lock '$self->{filename}' for writing: $!";
+
+    # just in case there was an append while we waited for the lock
+    seek( $fh, 0, 2 )
+        or die "Cannot seek to end of '$self->{filename}': $!";
+}
+
+1;
+
+# ABSTRACT: Subclass of Log::Dispatch::File to facilitate locking
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Log::Dispatch::File::Locked - Subclass of Log::Dispatch::File to facilitate locking
+
+=head1 VERSION
+
+version 2.45
+
+=head1 SYNOPSIS
+
+  use Log::Dispatch;
+
+  my $log = Log::Dispatch->new(
+      outputs => [
+          [
+              'File::Locked',
+              min_level => 'info',
+              filename  => 'Somefile.log',
+              mode      => '>>',
+              newline   => 1
+          ]
+      ],
+  );
+
+  $log->emerg("I've fallen and I can't get up");
+
+=head1 DESCRIPTION
+
+This module acts exactly like L<Log::Dispatch::File> except that it
+obtains an exclusive lock on the file while opening it.
+
+=head1 CAVEATS
+
+B<DANGER!> Use very carefully in multi-process environments. Because the lock
+is obtained at file open time, not at write time, you may experience deadlocks
+in your system.
+
+You can partially work around this by using the C<close_after_write> option,
+which causes the file to be re-opened every time a log message is written.
+
+Alternatively, the C<syswrite> option does atomic writes, which may mean that
+you don't need locking at all.
+
+See  L<Log::Dispatch::File>) for details on these options.
+
+=head1 SEE ALSO
+
+L<perlfunc/flock>
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2015 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+=cut
diff --git a/lib/Log/Dispatch/Handle.pm b/lib/Log/Dispatch/Handle.pm
new file mode 100644
index 0000000..3e3ed45
--- /dev/null
+++ b/lib/Log/Dispatch/Handle.pm
@@ -0,0 +1,102 @@
+package Log::Dispatch::Handle;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.45';
+
+use Log::Dispatch::Output;
+
+use base qw( Log::Dispatch::Output );
+
+use Params::Validate qw(validate SCALAR ARRAYREF BOOLEAN);
+Params::Validate::validation_options( allow_extra => 1 );
+
+sub new {
+    my $proto = shift;
+    my $class = ref $proto || $proto;
+
+    my %p = validate( @_, { handle => { can => 'print' } } );
+
+    my $self = bless {}, $class;
+
+    $self->_basic_init(%p);
+    $self->{handle} = $p{handle};
+
+    return $self;
+}
+
+sub log_message {
+    my $self = shift;
+    my %p    = @_;
+
+    $self->{handle}->print( $p{message} )
+        or die "Cannot write to handle: $!";
+}
+
+1;
+
+# ABSTRACT: Object for logging to IO::Handle classes
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Log::Dispatch::Handle - Object for logging to IO::Handle classes
+
+=head1 VERSION
+
+version 2.45
+
+=head1 SYNOPSIS
+
+  use Log::Dispatch;
+
+  my $log = Log::Dispatch->new(
+      outputs => [
+          [
+              'Handle',
+              min_level => 'emerg',
+              handle    => $io_socket_object,
+          ],
+      ]
+  );
+
+  $log->emerg('I am the Lizard King!');
+
+=head1 DESCRIPTION
+
+This module supplies a very simple object for logging to some sort of
+handle object. Basically, anything that implements a C<print()>
+method can be passed the object constructor and it should work.
+
+=for Pod::Coverage new log_message
+
+=head1 CONSTRUCTOR
+
+The constructor takes the following parameters in addition to the standard
+parameters documented in L<Log::Dispatch::Output>:
+
+=over 4
+
+=item * handle ($)
+
+The handle object. This object must implement a C<print()> method.
+
+=back
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2015 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+=cut
diff --git a/lib/Log/Dispatch/Null.pm b/lib/Log/Dispatch/Null.pm
new file mode 100644
index 0000000..09495b7
--- /dev/null
+++ b/lib/Log/Dispatch/Null.pm
@@ -0,0 +1,69 @@
+package Log::Dispatch::Null;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.45';
+
+use Log::Dispatch::Output;
+
+use base qw( Log::Dispatch::Output );
+
+sub new {
+    my $proto = shift;
+    my $class = ref $proto || $proto;
+
+    my $self = bless {}, $class;
+
+    $self->_basic_init(@_);
+
+    return $self;
+}
+
+sub log_message { }
+
+1;
+
+# ABSTRACT: Object that accepts messages and does nothing
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Log::Dispatch::Null - Object that accepts messages and does nothing
+
+=head1 VERSION
+
+version 2.45
+
+=head1 SYNOPSIS
+
+  use Log::Dispatch;
+
+  my $null
+      = Log::Dispatch->new( outputs => [ [ 'Null', min_level => 'debug' ] ] );
+
+  $null->emerg( "I've fallen and I can't get up" );
+
+=head1 DESCRIPTION
+
+This class provides a null logging object. Messages can be sent to the
+object but it does nothing with them.
+
+=for Pod::Coverage new log_message
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2015 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+=cut
diff --git a/lib/Log/Dispatch/Output.pm b/lib/Log/Dispatch/Output.pm
new file mode 100644
index 0000000..7c6ca09
--- /dev/null
+++ b/lib/Log/Dispatch/Output.pm
@@ -0,0 +1,315 @@
+package Log::Dispatch::Output;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.45';
+
+use Log::Dispatch;
+
+use base qw( Log::Dispatch::Base );
+
+use Params::Validate qw(validate SCALAR ARRAYREF CODEREF BOOLEAN);
+Params::Validate::validation_options( allow_extra => 1 );
+
+use Carp ();
+
+my $level_names
+    = [qw( debug info notice warning error critical alert emergency )];
+my $ln            = 0;
+my $level_numbers = {
+    ( map { $_ => $ln++ } @{$level_names} ),
+    warn  => 3,
+    err   => 4,
+    crit  => 5,
+    emerg => 7
+};
+
+sub new {
+    my $proto = shift;
+    my $class = ref $proto || $proto;
+
+    die "The new method must be overridden in the $class subclass";
+}
+
+sub log {
+    my $self = shift;
+
+    my %p = validate(
+        @_, {
+            level   => { type => SCALAR },
+            message => { type => SCALAR },
+        }
+    );
+
+    return unless $self->_should_log( $p{level} );
+
+    $p{message} = $self->_apply_callbacks(%p)
+        if $self->{callbacks};
+
+    $self->log_message(%p);
+}
+
+sub _basic_init {
+    my $self = shift;
+
+    my %p = validate(
+        @_, {
+            name      => { type => SCALAR, optional => 1 },
+            min_level => { type => SCALAR, required => 1 },
+            max_level => {
+                type     => SCALAR,
+                optional => 1
+            },
+            callbacks => {
+                type     => ARRAYREF | CODEREF,
+                optional => 1
+            },
+            newline => { type => BOOLEAN, optional => 1 },
+        }
+    );
+
+    $self->{level_names}   = $level_names;
+    $self->{level_numbers} = $level_numbers;
+
+    $self->{name} = $p{name} || $self->_unique_name();
+
+    $self->{min_level} = $self->_level_as_number( $p{min_level} );
+    die "Invalid level specified for min_level"
+        unless defined $self->{min_level};
+
+    # Either use the parameter supplied or just the highest possible level.
+    $self->{max_level} = (
+        exists $p{max_level}
+        ? $self->_level_as_number( $p{max_level} )
+        : $#{ $self->{level_names} }
+    );
+
+    die "Invalid level specified for max_level"
+        unless defined $self->{max_level};
+
+    my @cb = $self->_get_callbacks(%p);
+    $self->{callbacks} = \@cb if @cb;
+
+    if ( $p{newline} ) {
+        push @{ $self->{callbacks} }, \&_add_newline_callback;
+    }
+}
+
+sub name {
+    my $self = shift;
+
+    return $self->{name};
+}
+
+sub min_level {
+    my $self = shift;
+
+    return $self->{level_names}[ $self->{min_level} ];
+}
+
+sub max_level {
+    my $self = shift;
+
+    return $self->{level_names}[ $self->{max_level} ];
+}
+
+sub accepted_levels {
+    my $self = shift;
+
+    return @{ $self->{level_names} }
+        [ $self->{min_level} .. $self->{max_level} ];
+}
+
+sub _should_log {
+    my $self = shift;
+
+    my $msg_level = $self->_level_as_number(shift);
+    return (   ( $msg_level >= $self->{min_level} )
+            && ( $msg_level <= $self->{max_level} ) );
+}
+
+sub _level_as_number {
+    my $self  = shift;
+    my $level = shift;
+
+    unless ( defined $level ) {
+        Carp::croak "undefined value provided for log level";
+    }
+
+    return $level if $level =~ /^\d$/;
+
+    unless ( Log::Dispatch->level_is_valid($level) ) {
+        Carp::croak "$level is not a valid Log::Dispatch log level";
+    }
+
+    return $self->{level_numbers}{$level};
+}
+
+sub _level_as_name {
+    my $self  = shift;
+    my $level = shift;
+
+    unless ( defined $level ) {
+        Carp::croak "undefined value provided for log level";
+    }
+
+    return $level unless $level =~ /^\d$/;
+
+    return $self->{level_names}[$level];
+}
+
+my $_unique_name_counter = 0;
+
+sub _unique_name {
+    my $self = shift;
+
+    return '_anon_' . $_unique_name_counter++;
+}
+
+sub _add_newline_callback {
+
+    # This weird construct is an optimization since this might be called a lot
+    # - see https://github.com/autarch/Log-Dispatch/pull/7
+    +{@_}->{message} . "\n";
+}
+
+1;
+
+# ABSTRACT: Base class for all Log::Dispatch::* objects
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Log::Dispatch::Output - Base class for all Log::Dispatch::* objects
+
+=head1 VERSION
+
+version 2.45
+
+=head1 SYNOPSIS
+
+  package Log::Dispatch::MySubclass;
+
+  use Log::Dispatch::Output;
+  use base qw( Log::Dispatch::Output );
+
+  sub new {
+      my $proto = shift;
+      my $class = ref $proto || $proto;
+
+      my %p = @_;
+
+      my $self = bless {}, $class;
+
+      $self->_basic_init(%p);
+
+      # Do more if you like
+
+      return $self;
+  }
+
+  sub log_message {
+      my $self = shift;
+      my %p    = @_;
+
+      # Do something with message in $p{message}
+  }
+
+  1;
+
+=head1 DESCRIPTION
+
+This module is the base class from which all Log::Dispatch::* objects
+should be derived.
+
+=head1 CONSTRUCTOR
+
+The constructor, C<new>, must be overridden in a subclass. See L<Output
+Classes|Log::Dispatch/OUTPUT CLASSES> for a description of the common
+parameters accepted by this constructor.
+
+=head1 METHODS
+
+This class provides the following methods:
+
+=head2 $output->_basic_init(%p)
+
+This should be called from a subclass's constructor. Make sure to
+pass the arguments in @_ to it. It sets the object's name and minimum
+level from the passed parameters  It also sets up two other attributes which
+are used by other Log::Dispatch::Output methods, level_names and level_numbers.
+Subclasses will perform parameter validation in this method, and must also call
+the superclass's method.
+
+=head2 $output->name
+
+Returns the object's name.
+
+=head2 $output->min_level
+
+Returns the object's minimum log level.
+
+=head2 $output->max_level
+
+Returns the object's maximum log level.
+
+=head2 $output->accepted_levels
+
+Returns a list of the object's accepted levels (by name) from minimum
+to maximum.
+
+=head2 $output->log( level => $, message => $ )
+
+Sends a message if the level is greater than or equal to the object's
+minimum level. This method applies any message formatting callbacks
+that the object may have.
+
+=head2 $output->_should_log ($)
+
+This method is called from the C<log()> method with the log level of
+the message to be logged as an argument. It returns a boolean value
+indicating whether or not the message should be logged by this
+particular object. The C<log()> method will not process the message
+if the return value is false.
+
+=head2 $output->_level_as_number ($)
+
+This method will take a log level as a string (or a number) and return
+the number of that log level. If not given an argument, it returns
+the calling object's log level instead. If it cannot determine the
+level then it will croak.
+
+=head2 $output->add_callback( $code )
+
+Adds a callback (like those given during construction). It is added to the end
+of the list of callbacks.
+
+=head1 SUBCLASSING
+
+This class should be used as the base class for all logging objects
+you create that you would like to work under the Log::Dispatch
+architecture. Subclassing is fairly trivial. For most subclasses, if
+you simply copy the code in the SYNOPSIS and then put some
+functionality into the C<log_message> method then you should be all
+set. Please make sure to use the C<_basic_init> method as described above.
+
+The actual logging implementation should be done in a C<log_message>
+method that you write. B<Do not override C<log>!>.
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2015 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+=cut
diff --git a/lib/Log/Dispatch/Screen.pm b/lib/Log/Dispatch/Screen.pm
new file mode 100644
index 0000000..4b93464
--- /dev/null
+++ b/lib/Log/Dispatch/Screen.pm
@@ -0,0 +1,118 @@
+package Log::Dispatch::Screen;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.45';
+
+use Log::Dispatch::Output;
+
+use base qw( Log::Dispatch::Output );
+
+use Params::Validate qw(validate BOOLEAN);
+Params::Validate::validation_options( allow_extra => 1 );
+
+sub new {
+    my $proto = shift;
+    my $class = ref $proto || $proto;
+
+    my %p = validate(
+        @_, {
+            stderr => {
+                type    => BOOLEAN,
+                default => 1
+            },
+        }
+    );
+
+    my $self = bless {}, $class;
+
+    $self->_basic_init(%p);
+    $self->{stderr} = exists $p{stderr} ? $p{stderr} : 1;
+
+    return $self;
+}
+
+sub log_message {
+    my $self = shift;
+    my %p    = @_;
+
+    if ( $self->{stderr} ) {
+        print STDERR $p{message};
+    }
+    else {
+        print STDOUT $p{message};
+    }
+}
+
+1;
+
+# ABSTRACT: Object for logging to the screen
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Log::Dispatch::Screen - Object for logging to the screen
+
+=head1 VERSION
+
+version 2.45
+
+=head1 SYNOPSIS
+
+  use Log::Dispatch;
+
+  my $log = Log::Dispatch->new(
+      outputs => [
+          [
+              'Screen',
+              min_level => 'debug',
+              stderr    => 1,
+              newline   => 1
+          ]
+      ],
+  );
+
+  $log->alert("I'm searching the city for sci-fi wasabi");
+
+=head1 DESCRIPTION
+
+This module provides an object for logging to the screen (really
+STDOUT or STDERR).
+
+Note that a newline will I<not> be added automatically at the end of a
+message by default. To do that, pass C<< newline => 1 >>.
+
+=for Pod::Coverage new log_message
+
+=head1 CONSTRUCTOR
+
+The constructor takes the following parameters in addition to the standard
+parameters documented in L<Log::Dispatch::Output>:
+
+=over 4
+
+=item * stderr (0 or 1)
+
+Indicates whether or not logging information should go to STDERR. If
+false, logging information is printed to STDOUT instead. This
+defaults to true.
+
+=back
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2015 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+=cut
diff --git a/lib/Log/Dispatch/Syslog.pm b/lib/Log/Dispatch/Syslog.pm
new file mode 100644
index 0000000..6084025
--- /dev/null
+++ b/lib/Log/Dispatch/Syslog.pm
@@ -0,0 +1,220 @@
+package Log::Dispatch::Syslog;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.45';
+
+use Log::Dispatch::Output;
+
+use base qw( Log::Dispatch::Output );
+
+use Params::Validate qw(validate ARRAYREF BOOLEAN HASHREF SCALAR);
+Params::Validate::validation_options( allow_extra => 1 );
+
+use Scalar::Util qw( reftype );
+use Sys::Syslog 0.28 ();
+
+sub new {
+    my $proto = shift;
+    my $class = ref $proto || $proto;
+
+    my %p = @_;
+
+    my $self = bless {}, $class;
+
+    $self->_basic_init(%p);
+    $self->_init(%p);
+
+    return $self;
+}
+
+my ($Ident) = $0 =~ /(.+)/;
+
+sub _init {
+    my $self = shift;
+
+    my %p = validate(
+        @_, {
+            ident => {
+                type    => SCALAR,
+                default => $Ident
+            },
+            logopt => {
+                type    => SCALAR,
+                default => ''
+            },
+            facility => {
+                type    => SCALAR,
+                default => 'user'
+            },
+            socket => {
+                type    => SCALAR | ARRAYREF | HASHREF,
+                default => undef
+            },
+            lock => {
+                type    => BOOLEAN,
+                default => 0,
+            },
+        }
+    );
+
+    $self->{$_} = $p{$_} for qw( ident logopt facility socket lock );
+    if ( $self->{lock} ) {
+        require threads;
+        require threads::shared;
+    }
+
+    $self->{priorities} = [
+        'DEBUG',
+        'INFO',
+        'NOTICE',
+        'WARNING',
+        'ERR',
+        'CRIT',
+        'ALERT',
+        'EMERG'
+    ];
+}
+
+my $thread_lock : shared = 0;
+
+sub log_message {
+    my $self = shift;
+    my %p    = @_;
+
+    my $pri = $self->_level_as_number( $p{level} );
+
+    lock($thread_lock) if $self->{lock};
+
+    eval {
+        if ( defined $self->{socket} ) {
+            Sys::Syslog::setlogsock(
+                ref $self->{socket} && reftype( $self->{socket} ) eq 'ARRAY'
+                ? @{ $self->{socket} }
+                : $self->{socket}
+            );
+        }
+
+        Sys::Syslog::openlog(
+            $self->{ident},
+            $self->{logopt},
+            $self->{facility}
+        );
+        Sys::Syslog::syslog( $self->{priorities}[$pri], $p{message} );
+        Sys::Syslog::closelog;
+    };
+
+    warn $@ if $@ and $^W;
+}
+
+1;
+
+# ABSTRACT: Object for logging to system log.
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Log::Dispatch::Syslog - Object for logging to system log.
+
+=head1 VERSION
+
+version 2.45
+
+=head1 SYNOPSIS
+
+  use Log::Dispatch;
+
+  my $log = Log::Dispatch->new(
+      outputs => [
+          [
+              'Syslog',
+              min_level => 'info',
+              ident     => 'Yadda yadda'
+          ]
+      ]
+  );
+
+  $log->emerg("Time to die.");
+
+=head1 DESCRIPTION
+
+This module provides a simple object for sending messages to the
+system log (via UNIX syslog calls).
+
+Note that logging may fail if you try to pass UTF-8 characters in the
+log message. If logging fails and warnings are enabled, the error
+message will be output using Perl's C<warn>.
+
+=for Pod::Coverage new log_message
+
+=head1 CONSTRUCTOR
+
+The constructor takes the following parameters in addition to the standard
+parameters documented in L<Log::Dispatch::Output>:
+
+=over 4
+
+=item * ident ($)
+
+This string will be prepended to all messages in the system log.
+Defaults to $0.
+
+=item * logopt ($)
+
+A string containing the log options (separated by any separator you
+like). See the openlog(3) and Sys::Syslog docs for more details.
+Defaults to ''.
+
+=item * facility ($)
+
+Specifies what type of program is doing the logging to the system log.
+Valid options are 'auth', 'authpriv', 'cron', 'daemon', 'kern',
+'local0' through 'local7', 'mail, 'news', 'syslog', 'user',
+'uucp'. Defaults to 'user'
+
+=item * socket ($, \@, or \%)
+
+Tells what type of socket to use for sending syslog messages. Valid
+options are listed in C<Sys::Syslog>.
+
+If you don't provide this, then we let C<Sys::Syslog> simply pick one
+that works, which is the preferred option, as it makes your code more
+portable.
+
+If you pass an array reference, it is dereferenced and passed to
+C<Sys::Syslog::setlogsock()>.
+
+If you pass a hash reference, it is passed to C<Sys::Syslog::setlogsock()> as
+is.
+
+=item * lock ($)
+
+If this is set to a true value, then the calls to C<setlogsock()>,
+C<openlog()>, C<syslog()>, and C<closelog()> will all be guarded by a
+thread-locked variable.
+
+This is only relevant when running you are using Perl threads in your
+application. Setting this to a true value will cause the L<threads> and
+L<threads::shared> modules to be loaded.
+
+This defaults to false.
+
+=back
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2015 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+=cut