From 7e7ed7fe62e70e6d6662d1d416f47f34f693573f Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 1 Aug 2015 16:48:40 -0400 Subject: [PATCH] allow for custom open() args for stdout_file and stderr_file --- Changes | 3 + Makefile.PL | 3 +- lib/Daemon/Control.pm | 67 +++++++++++++++------ t/06_stderr_stdout.t | 123 ++++++++++++++++++++++++++++++++++++++ t/bin/05_stderr_stdout.pl | 30 ++++++++++ 5 files changed, 207 insertions(+), 19 deletions(-) create mode 100644 t/06_stderr_stdout.t create mode 100644 t/bin/05_stderr_stdout.pl diff --git a/Changes b/Changes index 513bf35..06d1ea4 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,6 @@ + * allow for custom open() args for stdout_file and stderr_file + +0.001007 2015-07-27 SymKat * Module name POD format fixed (RT 93280) * Add "forground" to --help (by marcusramberg) * Add with_plugins to support a simple plugin system diff --git a/Makefile.PL b/Makefile.PL index 4642e6a..5f92cf0 100644 --- a/Makefile.PL +++ b/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; diff --git a/lib/Daemon/Control.pm b/lib/Daemon/Control.pm index 37cbdeb..53cc4a9 100644 --- a/lib/Daemon/Control.pm +++ b/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: $!"; - $self->trace( "STDERR redirected to $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"); + } } } @@ -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: + + $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: + + $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 being set to 1, or C being set as an environment variable. Additionally, calling C instead of C 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 -5.8.1+, to use the plugin system your module MUST declare dependency on -L and if you wish to use the C, C and C -your module MUST declare dependance on L in your +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 +L and if you wish to use the C, C and C +your module MUST declare dependance on L 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 method exists for, such as +Valid arguments are those which a C method exists for, such as B, B, B. 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 is given as an argument. Starts the +Is called when B 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 on to avoid showing L output. @@ -1198,6 +1227,8 @@ Kaitlyn Parkhurst (SymKat) Isymkat@symkat.comE> ( Blog: Lmark.curtis@affinitylive.com> +=item * Zoffix Znet Izoffix@cpan.org> + =back =head2 SPONSORS diff --git a/t/06_stderr_stdout.t b/t/06_stderr_stdout.t new file mode 100644 index 0000000..d4c62af --- /dev/null +++ b/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; + + diff --git a/t/bin/05_stderr_stdout.pl b/t/bin/05_stderr_stdout.pl new file mode 100644 index 0000000..0e55140 --- /dev/null +++ b/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; + +