Skip to content
Browse files

initial import

  • Loading branch information...
1 parent 1eb267e commit da44190fbc6fcd4ac2b8b5f1e4f3aaf5689a84ce @tokuhirom committed
Showing with 198 additions and 15 deletions.
  1. +2 −4 Makefile.PL
  2. +53 −5 README.mkdn
  3. +119 −6 lib/Proc/Guard.pm
  4. +22 −0 t/01_simple.t
  5. +2 −0 xt/01_podspell.t
View
6 Makefile.PL
@@ -2,14 +2,12 @@ use inc::Module::Install;
name 'Proc-Guard';
all_from 'lib/Proc/Guard.pm';
-# requires '';
-
+requires 'Class::Accessor::Lite';
+requires 'Exporter' => 5.63;
readme_markdown_from 'lib/Proc/Guard.pm';
tests 't/*.t t/*/*.t t/*/*/*.t t/*/*/*/*.t';
test_requires 'Test::More';
-test_requires 'YAML';
author_tests('xt');
-# use_test_base;
auto_include;
WriteAll;
View
58 README.mkdn
@@ -1,21 +1,69 @@
# NAME
-Proc::Guard -
+Proc::Guard - process runner with RAII pattern
# SYNOPSIS
- use Proc::Guard;
+ use Test::TCP qw/empty_port wait_port/;
+ use File::Which qw/which/;
+ use Proc::Guard;
+
+ my $port = empty_port();
+ my $proc = proc_guard(which('memcached'), '-p', $port);
+ wait_port($port);
+
+ # your code here
# DESCRIPTION
-Proc::Guard is
+Proc::Guard runs process, and destroys it when the perl script exits.
+
+# FUNCTIONS
+
+- proc_guard(@cmdline)
+
+This is shorthand for:
+
+ Proc::Guard->new(
+ command => \@cmdline,
+ );
+
+# METHODS
+
+- my $proc = Proc::Guard->new(%args);
+
+Create and run a process. The process is terminated when the returned object is being DESTROYed.
+
+ - command
+
+ Proc::Guard->new(command => '/path/to/memcached');
+ # or
+ Proc::Guard->new(command => ['/path/to/memcached', '-p', '11211']);
+
+ The command line.
+
+ - auto_start
+
+ Proc::Guard->new(auto_start => 0);
+
+ Start child process automatically or not(default: 1).
+
+- pid
+
+Returns process id (or undef if not running).
+
+- start
+
+Starts process.
+
+- stop
+
+Stops process.
# AUTHOR
Tokuhiro Matsuno <tokuhirom AAJKLFJEF GMAIL COM>
-# SEE ALSO
-
# LICENSE
Copyright (C) Tokuhiro Matsuno
View
125 lib/Proc/Guard.pm
@@ -4,7 +4,60 @@ use warnings;
use 5.00800;
our $VERSION = '0.01';
-
+# functional interface
+our @EXPORT = qw/proc_guard/;
+use Exporter 'import';
+sub proc_guard { Proc::Guard->new(command => [@_]) }
+
+# OOish interface
+use POSIX;
+use Class::Accessor::Lite;
+Class::Accessor::Lite->mk_accessors(qw/pid/);
+
+sub new {
+ my ($class, %args) = @_;
+
+ my $self = bless {
+ _owner_pid => $$,
+ auto_start => 1,
+ %args,
+ }, $class;
+ $self->{command} = [$self->{command}] unless ref $self->{command};
+
+ $self->start()
+ if $self->{auto_start};
+
+ return $self;
+}
+
+sub start {
+ my $self = shift;
+
+ my $pid = fork();
+ die "fork failed: $!" unless defined $pid;
+ if ($pid == 0) { # child
+ exec @{$self->{command}};
+ die "cannot exec @{$self->{command}}: $!";
+ }
+ $self->pid($pid);
+}
+
+sub stop {
+ my ( $self, $sig ) = @_;
+ return
+ unless defined $self->pid;
+ $sig ||= SIGTERM;
+
+ kill $sig, $self->pid;
+ 1 while waitpid( $self->pid, 0 ) <= 0;
+
+ $self->pid(undef);
+}
+
+sub DESTROY {
+ my $self = shift;
+ $self->stop() if defined $self->pid && $$ == $self->{_owner_pid};
+}
1;
__END__
@@ -13,22 +66,82 @@ __END__
=head1 NAME
-Proc::Guard -
+Proc::Guard - process runner with RAII pattern
=head1 SYNOPSIS
- use Proc::Guard;
+ use Test::TCP qw/empty_port wait_port/;
+ use File::Which qw/which/;
+ use Proc::Guard;
+
+ my $port = empty_port();
+ my $proc = proc_guard(which('memcached'), '-p', $port);
+ wait_port($port);
+
+ # your code here
=head1 DESCRIPTION
-Proc::Guard is
+Proc::Guard runs process, and destroys it when the perl script exits.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item proc_guard(@cmdline)
+
+This is shorthand for:
+
+ Proc::Guard->new(
+ command => \@cmdline,
+ );
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item my $proc = Proc::Guard->new(%args);
+
+Create and run a process. The process is terminated when the returned object is being DESTROYed.
+
+=over 4
+
+=item command
+
+ Proc::Guard->new(command => '/path/to/memcached');
+ # or
+ Proc::Guard->new(command => ['/path/to/memcached', '-p', '11211']);
+
+The command line.
+
+=item auto_start
+
+ Proc::Guard->new(auto_start => 0);
+
+Start child process automatically or not(default: 1).
+
+=back
+
+=item pid
+
+Returns process id (or undef if not running).
+
+=item start
+
+Starts process.
+
+=item stop
+
+Stops process.
+
+=back
=head1 AUTHOR
Tokuhiro Matsuno E<lt>tokuhirom AAJKLFJEF GMAIL COME<gt>
-=head1 SEE ALSO
-
=head1 LICENSE
Copyright (C) Tokuhiro Matsuno
View
22 t/01_simple.t
@@ -0,0 +1,22 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Requires qw/File::Which Test::TCP/;
+use Proc::Guard;
+
+my $port = Test::TCP::empty_port();
+my $proc = proc_guard(File::Which::which('memcached'), '-p', $port);
+ok $proc->pid, 'memcached: ' . $proc->pid;
+Test::TCP::wait_port($port);
+
+my $sock = IO::Socket::INET->new(
+ PeerAddr => '127.0.0.1',
+ PeerPort => $port,
+ Proto => 'tcp',
+) or die $!;
+print $sock "version\r\n";
+my $version = <$sock>;
+like $version, qr/VERSION \d\.\d\.\d/;
+note $version;
+
+done_testing;
View
2 xt/01_podspell.t
@@ -30,3 +30,5 @@ kazeburo
daisuke
maki
TODO
+DESTROYed
+RAII

0 comments on commit da44190

Please sign in to comment.
Something went wrong with that request. Please try again.