allow for custom open() args for stdout_file and stderr_file

Changes

@@ -1,3 +1,6 @@
+    * allow for custom open() args for stdout_file and stderr_file
+
+0.001007   2015-07-27 SymKat <symkat@symkat.com>
     * Module name POD format fixed (RT 93280)
     * Add "forground" to --help (by marcusramberg)
     * Add with_plugins to support a simple plugin system

Makefile.PL

@@ -15,5 +15,6 @@ requires       'Cwd'            => '0';
 requires       'File::Path'     => '2.08';
 
 test_requires  'Test::More'     => '0.88';
+test_requires  'File::Temp'     => '0.14';
 
 WriteAll;

lib/Daemon/Control.pm

@@ -185,17 +185,36 @@ sub redirect_filehandles {
     if ( $self->stdout_file ) {
         my $file = $self->stdout_file;
         $file = $file eq '/dev/null' ? File::Spec->devnull : $file;
+
+        if ( ref $file eq 'ARRAY' ) {
+            my $mode = shift @$file;
+            open STDOUT, $mode, @$file ? @$file : ()
+                or die "Failed to open STDOUT with args $mode @$file: $!";
+
+            $self->trace("STDOUT redirected to open(STDOUT $mode @$file)");
+        }
+        else {
             open STDOUT, ">>", $file
                 or die "Failed to open STDOUT to $file: $!";
             $self->trace( "STDOUT redirected to $file" );
-
+        }
     }
     if ( $self->stderr_file ) {
         my $file = $self->stderr_file;
         $file = $file eq '/dev/null' ? File::Spec->devnull : $file;
+
+        if ( ref $file eq 'ARRAY' ) {
+            my $mode = shift @$file;
+            open STDERR, $mode, @$file ? @$file : ()
+                or die "Failed to open STDERR with args $mode @$file: $!";
+
+            $self->trace("STDERR redirected to open(STDERR $mode @$file)");
+        }
+        else {
             open STDERR, ">>", $file
                 or die "Failed to open STDERR to $file: $!";
-        $self->trace( "STDERR redirected to $file" );
+            $self->trace("STDERR redirected to $file");
+        }
     }
 }
 
@@ -914,6 +933,11 @@ in double fork mode.
 
     $daemon->stdout_file( "/tmp/mydaemon.stdout" );
 
+Alternatively, you can specify an arrayref of arguments to C<open()>:
+
+    $daemon->stdout_file( [ '>',  '/tmp/overwrite-every-run'  ] );
+    $daemon->stdout_file( [ '|-', 'my_pipe_program', '-a foo' ] );
+
 =head2 stderr_file
 
 If provided stderr will be redirected to the given file.  This is only supported
@@ -921,6 +945,11 @@ in double fork mode.
 
     $daemon->stderr_file( "/tmp/mydaemon.stderr" );
 
+Alternatively, you can specify an arrayref of arguments to C<open()>:
+
+    $daemon->stderr_file( [ '>',  '/tmp/overwrite-every-run'  ] );
+    $daemon->stderr_file( [ '|-', 'my_pipe_program', '-a foo' ] );
+
 =head2 pid_file
 
 The location of the PID file to use.  Warning: if using single-fork mode, it is
@@ -1198,6 +1227,8 @@ Kaitlyn Parkhurst (SymKat) I<E<lt>symkat@symkat.comE<gt>> ( Blog: L<http://symka
 
 =item * Mark Curtis I<E<lt>mark.curtis@affinitylive.com<gt>>
 
+=item * Zoffix Znet I<E<lt>zoffix@cpan.org<gt>>
+
 =back
 
 =head2 SPONSORS

t/06_stderr_stdout.t

@@ -0,0 +1,123 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use Test::More;
+use File::Temp;
+
+my ( $file, $ilib );
+
+# Let's make it so people can test in t/ or in the dist directory.
+my $daemon = '05_stderr_stdout.pl';
+if ( -f "t/bin/$daemon" ) { # Dist Directory.
+    $file = "t/bin/$daemon";
+    $ilib = "lib";
+} elsif ( -f "bin/$daemon" ) {
+    $file = "bin/$daemon";
+    $ilib = "../lib";
+} else {
+    die "Tests should be run in the dist directory or t/";
+}
+
+sub get_command_output {
+    my ( @command ) = @_;
+    open my $lf, "-|", @command
+        or die "Couldn't get pipe to '@command': $!";
+    my $content = do { local $/; <$lf> };
+    close $lf;
+    return $content;
+}
+
+{
+    diag 'Test STDOUT and STDERR when we use plain strings as arguments';
+    my $out;
+    my $stdout = File::Temp->new; # object stringifies to the filename
+    my $stderr = File::Temp->new;
+    my $cmd = "$^X -I$ilib $file $stdout $stderr";
+
+    ok $out = get_command_output("$cmd start"), "Started perl daemon";
+    like $out, qr/\[Started\]/, "Daemon started.";
+
+    sleep 2; # chill out for a bit, or we might miss writes to files
+
+    ok $out
+    = get_command_output("$cmd status" ), "Get status of system daemon.";
+    like $out, qr/\[Not Running\]/, "Daemon is stopped.";
+
+    # Check data written by the daemon
+    open my $fh, '<', $stdout
+        or die "Failed to open stdout file ($stdout) for inspection: $!";
+    like do { local $/; <$fh>; }, qr/STDOUT output success/,
+        "STDOUT file contains expected data";
+
+    open $fh, '<', $stderr
+        or die "Failed to open stderr file ($stderr) for inspection: $!";
+
+    is do { local $/; <$fh>; }, "STDERR output success\n",
+        "STDERR file contains expected data";
+
+}
+
+{
+    diag 'Test STDOUT and STDERR when we use custom arrayrefs as arguments';
+    # We're passing 'custom' argument so our daemon knows to use arrayrefs
+    # Consult the code of the daemon for details
+
+    my $out;
+    my $stdout = File::Temp->new; # object stringifies to the filename
+    my $stderr = File::Temp->new;
+    my $cmd = "$^X -I$ilib $file custom $stdout $stderr";
+
+    ok $out = get_command_output("$cmd start"), "Started perl daemon";
+    like $out, qr/\[Started\]/, "Daemon started.";
+
+    sleep 2; # chill out for a bit, or we might miss writes to files
+
+    ok $out
+    = get_command_output("$cmd status" ), "Get status of system daemon.";
+    like $out, qr/\[Not Running\]/, "Daemon is stopped.";
+
+
+    # Check daemon's first write
+    open my $fh, '<', $stdout
+        or die "Failed to open stdout file ($stdout) for inspection: $!";
+    like do { local $/; <$fh>; }, qr/STDOUT output success/,
+        "STDOUT file contains expected data";
+
+    open $fh, '<', $stderr
+        or die "Failed to open stderr file ($stderr) for inspection: $!";
+
+    is do { local $/; <$fh>; }, "STDERR output success\n",
+        "STDERR file contains expected data";
+
+
+    # Restart so we'd get a second STD[OUT|ERR] write
+    ok $out
+    = get_command_output("$cmd start"), "Get status of system daemon.";
+    like $out, qr/\[Started\]/s, "Daemon restarted.";
+
+    sleep 2; # chill out for a bit, or we might miss writes to files
+
+    ok $out
+    = get_command_output("$cmd status" ), "Get status of system daemon.";
+    like $out, qr/\[Not Running\]/, "Daemon is stopped.";
+
+    # Check daemon's second write
+    open $fh, '<', $stdout
+        or die "Failed to open stdout file ($stdout) for inspection: $!";
+    like do { local $/; <$fh>; },
+        qr/^STDOUT output success(?!.*STDOUT output success)/s,
+        "STDOUT file contains expected data";
+
+    open $fh, '<', $stderr
+        or die "Failed to open stderr file ($stderr) for inspection: $!";
+
+    like do { local $/; <$fh>; },
+        qr/^STDERR output success(?!.*STDERR output success)/s,
+        "STDERR file contains expected data";
+}
+
+unlink 'pid_tmp';
+
+done_testing;
+
+

t/bin/05_stderr_stdout.pl

@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use Daemon::Control;
+
+my $custom = $ARGV[0] eq 'custom' ? shift : undef;
+my $stdout = shift;
+my $stderr = shift;
+
+Daemon::Control->new({
+    name        => "My Daemon",
+    lsb_start   => '$syslog $remote_fs',
+    lsb_stop    => '$syslog',
+    lsb_sdesc   => 'My Daemon Short',
+    lsb_desc    => 'My Daemon controls the My Daemon daemon.',
+    path        => '/usr/sbin/mydaemon/init.pl',
+
+    program     => sub {
+        print STDOUT "STDOUT output success\n";
+        print STDERR "STDERR output success\n";
+    },
+
+    pid_file    => 'pid_tmp',
+    stderr_file => ($custom ? [ '>', $stderr ] : $stderr),
+    stdout_file => ($custom ? [ "> $stdout"  ] : $stdout),
+
+    fork        => 2,
+})->run;
+
+