Refactor ::Fast-specific constants and tests

.gitignore

@@ -13,3 +13,4 @@ MYMETA.*
 *.old
 Fast.c
 const-*.inc
+*.swp

MANIFEST

@@ -15,8 +15,9 @@ t/06-large-strings.t
 t/07-Log-Syslog-Fast-PP.t
 t/08-fd-leak.t
 t/09-undef-strings.t
-t/lib/LSFServer.pm
+t/lib/LSF.pm
 lib/Log/Syslog/Fast.pm
+lib/Log/Syslog/Fast/Constants.pm
 lib/Log/Syslog/Fast/PP.pm
 lib/Log/Syslog/Fast/Simple.pm
 LogSyslogFast.c

lib/Log/Syslog/Fast.pm

@@ -4,41 +4,14 @@ use 5.006002;
 use strict;
 use warnings;
 
-require Exporter;
-use Log::Syslog::Constants ();
-use Carp 'croak';
-
 our $VERSION = '0.61';
 
-our @ISA = qw(Log::Syslog::Constants Exporter);
-
-# protocols
-use constant LOG_UDP    => 0; # UDP
-use constant LOG_TCP    => 1; # TCP
-use constant LOG_UNIX   => 2; # UNIX socket
-
-# formats
-use constant LOG_RFC3164 => 0;
-use constant LOG_RFC5424 => 1;
-
-our %EXPORT_TAGS = (
-    protos => [qw/ LOG_TCP LOG_UDP LOG_UNIX /],
-    formats => [qw/ LOG_RFC3164 LOG_RFC5424 /],
-    %Log::Syslog::Constants::EXPORT_TAGS,
-);
-push @{ $EXPORT_TAGS{'all'} }, @{ $EXPORT_TAGS{'protos'} };
-push @{ $EXPORT_TAGS{'all'} }, @{ $EXPORT_TAGS{'formats'} };
-
-our @EXPORT_OK = @{ $EXPORT_TAGS{'all'} };
+use Log::Syslog::Fast::Constants ':all';
+require Exporter;
+our @ISA = qw(Exporter);
 our @EXPORT = qw();
-
-sub AUTOLOAD {
-    (my $meth = our $AUTOLOAD) =~ s/.*:://;
-    if (Log::Syslog::Constants->can($meth)) {
-        return Log::Syslog::Constants->$meth(@_);
-    }
-    croak "Undefined subroutine $AUTOLOAD";
-}
+our %EXPORT_TAGS = %Log::Syslog::Fast::Constants::EXPORT_TAGS;
+our @EXPORT_OK = @Log::Syslog::Fast::Constants::EXPORT_OK;
 
 require XSLoader;
 XSLoader::load('Log::Syslog::Fast', $VERSION);

lib/Log/Syslog/Fast/Constants.pm

@@ -0,0 +1,38 @@
+package Log::Syslog::Fast::Constants;
+
+use strict;
+use warnings;
+
+use Log::Syslog::Constants ();
+use Carp 'croak';
+
+require Exporter;
+our @ISA = qw(Exporter);
+
+# protocols
+use constant LOG_UDP    => 0; # UDP
+use constant LOG_TCP    => 1; # TCP
+use constant LOG_UNIX   => 2; # UNIX socket
+
+# formats
+use constant LOG_RFC3164 => 0;
+use constant LOG_RFC5424 => 1;
+
+our @EXPORT = ();
+our %EXPORT_TAGS = (
+    protos =>  [qw/ LOG_TCP LOG_UDP LOG_UNIX /],
+    formats => [qw/ LOG_RFC3164 LOG_RFC5424 /],
+);
+$EXPORT_TAGS{$_} = $Log::Syslog::Constants::EXPORT_TAGS{$_}
+    for qw(facilities severities);
+our @EXPORT_OK = @{ $EXPORT_TAGS{all} } = map {@$_} values %EXPORT_TAGS;
+
+sub AUTOLOAD {
+    (my $meth = our $AUTOLOAD) =~ s/.*:://;
+    if (Log::Syslog::Constants->can($meth)) {
+        return Log::Syslog::Constants->$meth(@_);
+    }
+    croak "Undefined subroutine $AUTOLOAD";
+}
+
+1;

lib/Log/Syslog/Fast/PP.pm

@@ -4,47 +4,21 @@ use 5.006002;
 use strict;
 use warnings;
 
+use Log::Syslog::Fast::Constants ':all';
 require Exporter;
-use Log::Syslog::Constants ();
-use Carp qw(croak confess cluck);
-
-our @ISA = qw(Log::Syslog::Constants Exporter);
+our @ISA = qw(Exporter);
+our @EXPORT = qw();
+our %EXPORT_TAGS = %Log::Syslog::Fast::Constants::EXPORT_TAGS;
+our @EXPORT_OK = @Log::Syslog::Fast::Constants::EXPORT_OK;
 
+use Carp;
 use POSIX 'strftime';
 use IO::Socket::IP;
 use IO::Socket::UNIX;
 use Socket;
 
-# protocols
-use constant LOG_UDP    => 0; # UDP
-use constant LOG_TCP    => 1; # TCP
-use constant LOG_UNIX   => 2; # UNIX socket
-
-# formats
-use constant LOG_RFC3164 => 0;
-use constant LOG_RFC5424 => 1;
-
-our %EXPORT_TAGS = (
-    protos => [qw/ LOG_TCP LOG_UDP LOG_UNIX /],
-    formats => [qw/ LOG_RFC3164 LOG_RFC5424 /],
-    %Log::Syslog::Constants::EXPORT_TAGS,
-);
-push @{ $EXPORT_TAGS{'all'} }, @{ $EXPORT_TAGS{'protos'} };
-push @{ $EXPORT_TAGS{'all'} }, @{ $EXPORT_TAGS{'formats'} };
-
-our @EXPORT_OK = @{ $EXPORT_TAGS{'all'} };
-our @EXPORT = qw();
-
 sub DESTROY { }
 
-sub AUTOLOAD {
-    (my $meth = our $AUTOLOAD) =~ s/.*:://;
-    if (Log::Syslog::Constants->can($meth)) {
-        return Log::Syslog::Constants->$meth(@_);
-    }
-    croak "Undefined subroutine $AUTOLOAD";
-}
-
 use constant PRIORITY   => 0;
 use constant SENDER     => 1;
 use constant NAME       => 2;
@@ -129,13 +103,13 @@ sub set_receiver {
         eval {
             $self->[SOCK] = IO::Socket::UNIX->new(
                 Type => SOCK_STREAM,
-                Peer  => $hostname,
+                Peer => $hostname,
             );
         };
         if ($@ || !$self->[SOCK]) {
             $self->[SOCK] = IO::Socket::UNIX->new(
                 Type => SOCK_DGRAM,
-                Peer  => $hostname,
+                Peer => $hostname,
             );
         }
     }

lib/Log/Syslog/Fast/Simple.pm

@@ -7,12 +7,10 @@ use Log::Syslog::Fast ':all';
 use Sys::Hostname;
 
 require Exporter;
-
 our @ISA = qw(Exporter);
-
-our %EXPORT_TAGS = %Log::Syslog::Fast::EXPORT_TAGS;
-our @EXPORT_OK   = @Log::Syslog::Fast::EXPORT_OK;
 our @EXPORT      = qw();
+our %EXPORT_TAGS = %Log::Syslog::Fast::Constants::EXPORT_TAGS;
+our @EXPORT_OK   = @Log::Syslog::Fast::Constants::EXPORT_OK;
 
 use constant _LOGGERS   => 0;
 use constant _ARGS      => 1;

t/01-Log-Syslog-Fast.pl

@@ -1,81 +1,11 @@
-use Test::More tests => 206;
-use File::Temp 'tempdir';
-use IO::Select;
-use IO::Socket::INET;
-use IO::Socket::UNIX;
-use POSIX 'strftime';
-
-require 't/lib/LSFServer.pm';
-
+use strict;
+use warnings;
 
+use Test::More tests => 206;
+use lib 't/lib';
+use LSF;
 
-my $test_dir   = tempdir(CLEANUP => 1);
-
-
-# old IO::Socket::INET fails with "Bad service '0'" when attempting to use
-# wildcard port
-my $port = 24767;
-sub listen_port {
-    return 0 if $IO::Socket::INET::VERSION >= 1.31;
-    diag("Using port $port for IO::Socket::INET v$IO::Socket::INET::VERSION");
-    return $port++;
-}
-
-my %servers = (
-    tcp => sub {
-        my $listener = IO::Socket::INET->new(
-            Proto       => 'tcp',
-            Type        => SOCK_STREAM,
-            LocalHost   => 'localhost',
-            LocalPort   => listen_port(),
-            Listen      => 5,
-            Reuse       => 1,
-        ) or die $!;
-        return StreamServer->new(
-            listener    => $listener,
-            proto       => LOG_TCP,
-            address     => [$listener->sockhost, $listener->sockport],
-        );
-    },
-    udp => sub {
-        my $listener = IO::Socket::INET->new(
-            Proto       => 'udp',
-            Type        => SOCK_DGRAM,
-            LocalHost   => 'localhost',
-            LocalPort   => listen_port(),
-            Reuse       => 1,
-        ) or die $!;
-        return DgramServer->new(
-            listener    => $listener,
-            proto       => LOG_UDP,
-            address     => [$listener->sockhost, $listener->sockport],
-        );
-    },
-    unix_stream => sub {
-        my $listener = IO::Socket::UNIX->new(
-            Local   => "$test_dir/stream",
-            Type    => SOCK_STREAM,
-            Listen  => 1,
-        ) or die $!;
-        return StreamServer->new(
-            listener    => $listener,
-            proto       => LOG_UNIX,
-            address     => [$listener->hostpath, 0],
-        );
-    },
-    unix_dgram => sub {
-        my $listener = IO::Socket::UNIX->new(
-            Local   => "$test_dir/dgram",
-            Type    => SOCK_DGRAM,
-            Listen  => 1,
-        ) or die $!;
-        return DgramServer->new(
-            listener    => $listener,
-            proto       => LOG_UNIX,
-            address     => [$listener->hostpath, 0],
-        );
-    },
-);
+use POSIX 'strftime';
 
 # strerror(3) messages on linux in the "C" locale are included below for reference
 
@@ -86,17 +16,16 @@ sub listen_port {
     like($@, qr/^Error in ->new/, "$proto: bad ->new call throws an exception");
 }
 
-for my $p (sort keys %servers) {
-    my $listen = $servers{$p};
+for my $p (qw( tcp udp unix_dgram unix_stream )) {
 
     # basic behavior
     eval {
-        my $server = $listen->();
+        my $server = make_server($p);
         ok($server->{listener}, "$p: listen") or diag("listen failed: $!");
 
-        my $logger = $server->connect($CLASS => @params);
+        my $logger = $server->connect($::CLASS => @params);
         ok($logger, "$p: ->new returns something");
-        is(ref $logger, $CLASS, "$p: ->new returns a $CLASS object");
+        is(ref $logger, $CLASS, "$p: ->new returns a $main::CLASS object");
 
         my $receiver = $server->accept;
         ok($receiver, "$p: accepted");
@@ -120,7 +49,7 @@ sub listen_port {
 
                 ok($buf =~ /^<38>/, "$p: ->send $msg has the right priority");
                 ok($buf =~ /$msg$/, "$p: ->send $msg has the right message");
-                ok(payload_ok($buf, LOG_RFC3164, @payload_params), "$p: ->send $msg has correct payload");
+                is($buf, expected_payload(@payload_params, LOG_RFC3164), "$p: ->send $msg has correct payload");
             }
         }
     };
@@ -129,7 +58,7 @@ sub listen_port {
     # write accessors
     eval {
 
-        my $server = $listen->();
+        my $server = make_server($p);
         my $logger = $server->connect($CLASS => @params);
 
         # ignore first connection for stream protos since reconnect is expected
@@ -174,15 +103,15 @@ sub listen_port {
             ok($buf =~ /test2\[/, "$p: ->send after set_name has the right name");
             ok($buf =~ /\[12345\]/, "$p: ->send after set_name has the right pid");
             ok($buf =~ /$msg$/, "$p: ->send after accessors sends right message");
-            ok(payload_ok($buf, LOG_RFC3164, @payload_params), "$p: ->send $msg has correct payload");
+            is($buf, expected_payload(@payload_params, LOG_RFC3164), "$p: ->send $msg has correct payload");
         }
     };
     diag($@) if $@;
 
     # RFC5424 format
     eval {
 
-        my $server = $listen->();
+        my $server = make_server($p);
         my $logger = $server->connect($CLASS => @params);
 
         # ignore first connection for stream protos since reconnect is expected
@@ -230,7 +159,7 @@ sub listen_port {
             ok($buf =~ / test2 /, "$p: ->send after set_name has the right name");
             ok($buf =~ / 12345 /, "$p: ->send after set_name has the right pid");
             ok($buf =~ / $msg$/, "$p: ->send after accessors sends right message");
-            ok(payload_ok($buf, LOG_RFC5424, @payload_params), "$p: ->send $msg has correct payload");
+            is($buf, expected_payload(@payload_params, LOG_RFC5424), "$p: ->send $msg has correct payload");
         }
     };
     diag($@) if $@;
@@ -239,7 +168,7 @@ sub listen_port {
     eval {
 
         # test when server is initially available but goes away
-        my $server = $listen->();
+        my $server = make_server($p);
         my $logger = $server->connect($CLASS => @params);
         $server->close();
 
@@ -294,7 +223,7 @@ sub listen_port {
 
 # test LOG_UNIX with nonexistent/non-sock endpoint
 {
-    my $filename = "$test_dir/fake";
+    my $filename = test_dir . "/fake";
 
     my $fake_server = DgramServer->new(
         listener    => 1,
@@ -338,21 +267,6 @@ sub expected_payload {
         $sender, $name, $pid, $msg;
 }
 
-sub payload_ok {
-    my ($payload, $format, @payload_params) = @_;
-    for my $offset (0, -1, 1) {
-        my $allowed = expected_payload(@payload_params, $format);
-        return 1 if $allowed eq $payload;
-    }
-    return 0;
-}
-
-# use select so test won't block on failure
-sub wait_for_readable {
-    my $sock = shift;
-    return IO::Select->new($sock)->can_read(1);
-}
-
 # vim: filetype=perl
 
-1;
+1;

t/03-corner-cases.pl

@@ -1,11 +1,9 @@
 use Test::More tests => 1;
 
-use IO::Socket::INET;
-
 eval {
     $CLASS->new(LOG_UNIX, 'a' x 10000, 0, LOG_LOCAL0, LOG_INFO, "mymachine", "logger");
 };
 like($@, qr/^Error in ->new/, "long filename");
 
 # vim: filetype=perl
-1;
+1;