symkat/Daemon-Control
1
0
Fork 0
Code Issues 2 Pull requests Releases Wiki Activity

allow for custom open() args for stdout_file and stderr_file

Browse source
This commit is contained in:
Zoffix Znet 2015-08-01 16:48:40 -04:00
parent 79840ca607
commit 7e7ed7fe62
5 changed files with 207 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Changes
View file

@ -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

3
Makefile.PL
View file

@ -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;

67
lib/Daemon/Control.pm
View file

@ -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<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
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>
your module MUST declare dependance on L<Class::Method::Modifiers> 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<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
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

123
t/06_stderr_stdout.t Normal file
View file

@ -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;

30
t/bin/05_stderr_stdout.pl Normal file
View file

@ -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;