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

@@ -1,5 +1,5 @@
 use inc::Module::Install;
-  
+
 # Define metadata
 name           'Daemon-Control';
 all_from       'lib/Daemon/Control.pm';
@@ -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

@@ -136,7 +136,7 @@ sub with_plugins {
     my @plugins = map {
         substr( $_, 0, 1 ) eq '+'
             ? substr( $_, 1 )
-            : "Daemon::Control::Plugin::$_" 
+            : "Daemon::Control::Plugin::$_"
     } ref $in[0] eq 'ARRAY' ? @{ $in[0] } : @in;
 
 
@@ -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;
-        open STDOUT, ">>", $file
-            or die "Failed to open STDOUT to $file: $!";
-        $self->trace( "STDOUT redirected to $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;
-        open STDERR, ">>", $file
+
-            or die "Failed to open STDERR to $file: $!";
+        if ( ref $file eq 'ARRAY' ) {
-        $self->trace( "STDERR redirected to $file" );
+            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");
+        }
     }
 }
 
@@ -294,7 +313,7 @@ sub _double_fork {
     return $self;
 }
 
-sub _foreground { shift->_launch_program } 
+sub _foreground { shift->_launch_program }
 
 sub _fork {
     my ( $self ) = @_;
@@ -644,7 +663,7 @@ sub run_template {
 
 sub run_command {
     my ( $self, $arg ) = @_;
-    
+
     # Error Checking.
     if ( ! $self->program ) {
         die "Error: program must be defined.";
@@ -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
@@ -972,7 +1001,7 @@ as that the daemon started.  A shortcut to turn status off and go into foregroun
 mode is C<foreground> being set to 1, or C<DC_FOREGROUND> being set as an
 environment variable.  Additionally, calling C<foreground> instead of C<start> will
 override the forking mode at run-time.
-    
+
     $daemon->fork( 0 );
 
     $daemon->fork( 1 );
@@ -1072,13 +1101,13 @@ Your plugin should use the name Daemon::Control::Plugin::YourModuleName and
 YourModuleName should reasonably match the effect your plugin has on
 Daemon::Control.
 
-You can replace Daemon::Control methods by writing your own and using 
+You can replace Daemon::Control methods by writing your own and using
 Role::Tiny within your class to allow it to be composed into Daemon::Control.
 
-The default Daemon::Control ships with no dependancies and supports Perl 
+The default Daemon::Control ships with no dependancies and supports Perl
-5.8.1+, to use the plugin system your module MUST declare dependency on 
+5.8.1+, to use the plugin system your module MUST declare dependency on
-L<Role::Tiny> and if you wish to use the C<around>, C<before> and C<after> 
+L<Role::Tiny> and if you wish to use the C<around>, C<before> and C<after>
-your module MUST declare dependance on L<Class::Method::Modifiers> in your 
+your module MUST declare dependance on L<Class::Method::Modifiers> in your
 package.
 
 =head1 METHODS
@@ -1086,7 +1115,7 @@ package.
 =head2 run_command
 
 This function will process an action on the Daemon::Control instance.
-Valid arguments are those which a C<do_> method exists for, such as 
+Valid arguments are those which a C<do_> method exists for, such as
 B<start>, B<stop>, B<restart>.  Returns the LSB exit code for the
 action processed.
 
@@ -1095,7 +1124,7 @@ action processed.
 This will make your program act as an init file, accepting input from
 the command line.  Run will exit with 0 for success and uses LSB exit
 codes.  As such no code should be used after ->run is called.  Any code
-in your file should be before this.  This is a shortcut for 
+in your file should be before this.  This is a shortcut for
 
     exit Daemon::Control->new(...)->run_command( @ARGV );
 
@@ -1108,7 +1137,7 @@ exits. Called by:
 
 =head2 do_foreground
 
-Is called when B<foreground> is given as an argument.  Starts the 
+Is called when B<foreground> is given as an argument.  Starts the
 program or code reference and stays in the foreground -- no forking
 is done, regardless of the compile-time arguments.  Additionally,
 turns C<quiet> on to avoid showing L<Daemon::Control> output.
@@ -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;
+
+