root/lang/perl/Parallel-Prefork/trunk/lib/Parallel/Prefork.pm @ 9073

Revision 9073, 4.3 kB (checked in by kazuho, 7 years ago)

update version no., changes

Line 
1package Parallel::Prefork;
2
3use strict;
4use warnings;
5
6use base qw/Class::Accessor::Fast/;
7use List::Util qw/first/;
8use Proc::Wait3;
9
10__PACKAGE__->mk_accessors(qw/max_workers err_respawn_interval trap_signals signal_received manager_pid/);
11
12our $VERSION = '0.02';
13
14sub new {
15    my ($klass, $opts) = @_;
16    $opts ||= {};
17    my $self = bless {
18        worker_pids          => {},
19        max_workers          => 10,
20        err_respawn_interval => 1,
21        trap_signals         => {
22            TERM => 'TERM',
23        },
24        signal_received      => '',
25        manager_pid          => undef,
26        generation           => 0,
27        %$opts,
28    }, $klass;
29    $SIG{$_} = sub {
30        $self->signal_received($_[0]);
31    } for keys %{$self->trap_signals};
32    $self;
33}
34
35sub start {
36    my $self = shift;
37   
38    $self->manager_pid($$);
39    $self->signal_received('');
40    $self->{generation}++;
41   
42    die 'cannot start another process while you are in child process'
43        if $self->{in_child};
44   
45    # for debugging
46    return if $self->{max_workers} == 0;
47   
48    # main loop
49    while (! $self->signal_received) {
50        my $pid;
51        if (keys %{$self->{worker_pids}} < $self->max_workers) {
52            $pid = fork;
53            die 'fork error' unless defined $pid;
54            unless ($pid) {
55                # child process
56                $self->{in_child} = 1;
57                $SIG{$_} = 'DEFAULT' for keys %{$self->trap_signals};
58                exit 0 if $self->signal_received;
59                return;
60            }
61            $self->{worker_pids}{$pid} = $self->{generation};
62        }
63        if (my ($exit_pid, $status) = wait3(! $pid)) {
64            if (delete($self->{worker_pids}{$exit_pid}) == $self->{generation}
65                    && $status != 0) {
66                sleep $self->err_respawn_interval;
67            }
68        }
69    }
70    # send signals to workers
71    if (my $sig = $self->{trap_signals}{$self->signal_received}) {
72        $self->signal_all_children($sig);
73    }
74   
75    1; # return from parent process
76}
77
78sub finish {
79    my ($self, $exit_code) = @_;
80    return unless $self->{max_workers};
81    exit($exit_code || 0);
82}
83
84sub signal_all_children {
85    my ($self, $sig) = @_;
86    foreach my $pid (sort keys %{$self->{worker_pids}}) {
87        kill $sig, $pid;
88    }
89}
90
91sub wait_all_children {
92    my $self = shift;
93    while (%{$self->{worker_pids}}) {
94        if (my $pid = wait) {
95            delete $self->{worker_pids}{$pid};
96        }
97    }
98}
99
1001;
101
102__END__
103
104=head1 NAME
105Parallel::Prefork - A simple prefork server framework
106
107=head1 SYNOPSIS
108
109  use Parallel::Prefork;
110 
111  my $pm = Parallel::Prefork->new({
112    max_workers  => 10,
113    fork_delay   => 1,
114    trap_signals => {
115      TERM => TERM,
116      HUP  => TERM,
117      USR1 => undef,
118  });
119 
120  while ($pm->signal_received ne 'TERM') {
121    load_config();
122    $pm->start and next;
123   
124    ... do some work within the child process ...
125   
126    $pm->finish;
127  }
128 
129  $pm->wait_all_children();
130
131=head1 DESCRIPTION
132
133C<Parallel::Prefork> is much like C<Parallel::ForkManager>, but supports graceful shutdown and run-time reconfiguration.
134
135=head1 METHODS
136
137=head2 new
138
139Instantiation.  Takes a hashref as an argument.  Recognized attributes are as follows.
140
141=head3 max_workers
142
143number of worker processes (default: 10)
144
145=head3 err_respawn_interval
146
147interval until next child process is spawned after a worker exits abnormally (default: 1)
148
149=head3 trap_signals
150
151hashref of signals to be trapped.  Manager process will trap the signals listed in the keys of the hash, and send the signal specified in the associated value (if any) to all worker processes.
152
153=head2 start
154
155The main routine.  Returns undef in child processes.  Returns a true value within manager process upon receiving a signal specified in the C<trap_signals> hashref.
156
157=head2 finish
158
159Child processes should call this function for termination.  Takes exit code as an optional argument.  Only usable from child processes.
160
161=head2 signal_all_children
162
163Sends signal to all worker processes.  Only usable from manager process.
164
165=head2 wait_all_children
166
167Blocks until all worker processes exit.  Only usable from manager process.
168
169=head1 LICENSE
170
171This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
172
173See http://www.perl.com/perl/misc/Artistic.html
174
175=cut
Note: See TracBrowser for help on using the browser.