[catagits/FCGI-ProcManager.git] / ProcManager.pm

package FCGI::ProcManager;

# Copyright (c) 2000, FundsXpress Financial Network, Inc.
# This library is free software released under the GNU Lesser General
# Public License, Version 2.1.  Please read the important licensing and
# disclaimer information included below.

# $Id: ProcManager.pm,v 1.15 2001/01/31 07:00:55 muaddib Exp $

use strict;
use Exporter;

use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $Q);
BEGIN {
  $VERSION = '0.15';
  @ISA = qw(Exporter);
  @EXPORT_OK = qw(pm_manage pm_die pm_reap_server
		  pm_write_pid_file pm_remove_pid_file
		  pm_pre_dispatch pm_post_dispatch
  		  pm_change_process_name pm_received_signal pm_parameter 
		  pm_warn pm_notify pm_abort pm_exit);
  $EXPORT_TAGS{all} = \@EXPORT_OK;
  $FCGI::ProcManager::Default = 'FCGI::ProcManager';
}

=head1 NAME

 FCGI::ProcManager - functions for managing FastCGI applications.

=head1 SYNOPSIS

{
 # In Object-oriented style.
 use CGI::Fast;
 use FCGI::ProcManager;
 my $proc_manager = FCGI::ProcManager->new({ n_processes => 10 });
 $proc_manager->pm_manage();
 while (my $cgi = CGI::Fast->new()) {
   $proc_manager->pm_pre_dispatch();
   # ... handle the request here ...
   $proc_manager->pm_post_dispatch();
 }

 # This style is also supported:
 use CGI::Fast;
 use FCGI::ProcManager qw(pm_manage pm_pre_dispatch pm_post_dispatch);
 pm_manage( n_processes => 10 );
 while (my $cgi = CGI::Fast->new()) {
   pm_pre_dispatch();
   #...
   pm_post_dispatch();
 }

=head1 DESCRIPTION

FCGI::ProcManager is used to serve as a FastCGI process manager.  By
re-implementing it in perl, developers can more finely tune performance in
their web applications, and can take advantage of copy-on-write semantics
prevalent in UNIX kernel process management.  The process manager should
be invoked before the caller''s request loop

The primary routine, C<pm_manage>, enters a loop in which it maintains a
number of FastCGI servers (via fork(2)), and which reaps those servers
when they die (via wait(2)).

C<pm_manage> provides too hooks:

 C<managing_init> - called just before the manager enters the manager loop.
 C<handling_init> - called just before a server is returns from C<pm_manage>

It is necessary for the caller, when implementing its request loop, to
insert a call to C<pm_pre_dispatch> at the top of the loop, and then
7C<pm_post_dispatch> at the end of the loop.


=head1 METHODS

=head2 new

=cut

sub new {
  my ($proto,$init) = @_;

  my $this = { 
	      role => "manager",
	      start_delay => 0,
	      die_timeout => 60
	     };
  $init and %$this = %$init;

  bless $this, ref($proto)||$proto;

  $this->{PIDS} = {};

  return $this;
}

=head1 Manager methods

=head2 pm_manage

 global
 () pm_manage(int processes_to_spawn)

DESCRIPTION:

When this is called by a FastCGI script to manage application servers.

=cut

sub pm_manage {
  my ($this,%values) = self_or_default(@_);
  map { $this->pm_parameter($_,$values{$_}) } keys %values;

  # skip to handling now if we won't be managing any processes.
  $this->n_processes() or goto HANDLING;

  # call the (possibly overloaded) management initialization hook.
  $this->role("manager");
  $this->managing_init();
  $this->pm_notify("initialized");

  my $manager_pid = $$;

 MANAGING_LOOP: while (1) {

    # if the calling process goes away, perform cleanup.
    getppid() == 1 and
      return $this->pm_die("calling process has died");

    $this->n_processes() > 0 or
      return $this->pm_die();

    # while we have fewer servers than we want.
  PIDS: while (keys(%{$this->{PIDS}}) < $this->n_processes()) {

      if (my $pid = fork()) {
	# the manager remembers the server.
	$this->{PIDS}->{$pid} = { pid=>$pid };
        $this->pm_notify("server (pid $pid) started");

      } elsif (! defined $pid) {
	return $this->pm_abort("fork: $!");

      } else {
	$this->role("server");
	$this->{MANAGER_PID} = $manager_pid;
	# the server exits the managing loop.
	last MANAGING_LOOP;
      }

      for (my $s = $this->start_delay(); $s; $s = sleep $s) {};
    }

    # this should block until the next server dies.
    $this->pm_reap_server();

  }# while 1

HANDLING:

  # call the (possibly overloaded) handling init hook
  $this->role("server");
  $this->handling_init();
  $this->pm_notify("initialized");

  # server returns 
  return 1;
}

=head2 managing_init

=cut

sub managing_init {
  my ($this) = self_or_default(@_);

  # begin to handle signals.
  $SIG{TERM} = sub { $this->sig_manager(@_) };
  $SIG{HUP}  = sub { $this->sig_manager(@_) };

  # change the name of this process as it appears in ps(1) output.
  $this->pm_change_process_name("perl-fcgi-pm");

  $this->pm_write_pid_file();
}


=head2 pm_die

=cut

sub pm_die {
  my ($this,$msg,$n) = self_or_default(@_);

  # stop handling signals.
  $SIG{HUP}  = 'DEFAULT';
  $SIG{TERM} = 'DEFAULT';

  $this->pm_remove_pid_file();

  # prepare to die no matter what.
  if (defined $this->die_timeout()) {
    $SIG{ARLM} = sub { $this->pm_abort("reap timeout") };
    alarm $this->die_timeout();
  }

  # send a TERM to each of the servers.
  kill "TERM", keys %{$this->{PIDS}};

  # wait for the servers to die.
  while (%{$this->{PIDS}}) {
    $this->pm_reap_server();
  }

  # die already.
  $this->pm_exit("dying: ".$msg,$n);
}

=head2 pm_reap_server

=cut

sub pm_reap_server {
  my ($this) = self_or_default(@_);

  # wait for the next server to die.
  next if (my $pid = wait()) < 0;

  # notify when one of our servers have died.
  delete $this->{PIDS}->{$pid} and
    $this->pm_notify("server (pid $pid) exited with status $?");
}

=head2 pm_write_pid_file

=cut

sub pm_write_pid_file {
  my ($this,$fname) = self_or_default(@_);
  $fname ||= $this->pid_fname() or return;
  if (!open PIDFILE, ">$fname") {
    $this->pm_warn("open: $fname: $!");
    return;
  }
  print PIDFILE "$$\n";
  close PIDFILE;
}

=head2 pm_remove_pid_file

=cut

sub pm_remove_pid_file {
  my ($this,$fname) = self_or_default(@_);
  $fname ||= $this->pid_fname() or return;
  my $ret = unlink($fname) or $this->pm_warn("unlink: $fname: $!");
  return $ret;
}

=head2 sig_manager

=cut

sub sig_manager {
  my ($this,$name) = @_;
  if ($name eq "TERM" or $name eq "HUP") {
    $this->pm_die("received signal $name");
  } else {
    $this->pm_notify("ignoring signal $name");
  }
}

=head1 Handler methods

=head2 handling_init

=cut

sub handling_init {
  my ($this) = self_or_default(@_);

  # begin to handle signals.
  $SIG{TERM} = sub { $this->sig_handler(@_) };
  $SIG{HUP}  = sub { $this->sig_handler(@_) };

  # change the name of this process as it appears in ps(1) output.
  $this->pm_change_process_name("perl-fcgi");
}

=head2 pm_pre_dispatch

=cut

sub pm_pre_dispatch {
  my ($this) = self_or_default(@_);
}

=head2 pm_post_dispatch

=cut

sub pm_post_dispatch {
  my ($this) = self_or_default(@_);
  if ($this->pm_received_signal("TERM")) {
    $this->pm_exit("safe exit after SIGTERM");
  }
  if ($this->pm_received_signal("HUP")) {
    $this->pm_exit("safe exit after SIGHUP");
  }
  if (getppid() != $this->{MANAGER_PID}) {
    $this->pm_exit("safe exit: manager has died");
  }
}

=head2 sig_handler

=cut

sub sig_handler {
  my ($this,$name) = @_;
  $this->pm_received_signal($name,1);
}

=head1 Common methods and routines

=head2 self_or_default

 private global
 (ProcManager, @args) self_or_default([ ProcManager, ] @args);

DESCRIPTION:

This is a helper subroutine to acquire or otherwise create a singleton
default object if one is not passed in, e.g., a method call.

=cut

sub self_or_default {
  return @_ if defined $_[0] and !ref $_[0] and $_[0] eq 'FCGI::ProcManager';
  if (!defined $_[0] or (ref($_[0]) ne 'FCGI::ProcManager' and
			 !UNIVERSAL::isa($_[0],'FCGI::ProcManager'))) {
    $Q or $Q = $FCGI::ProcManager::Default->new;
    unshift @_, $Q;
  }
  return wantarray ? @_ : $Q;
}

=head2 pm_change_process_name

=cut

sub pm_change_process_name {
  my ($this,$name) = self_or_default(@_);
  $0 = $name;
}

=head2 pm_received_signal

=cut

sub pm_received_signal {
  my ($this,$sig,$received) = self_or_default(@_);
  $sig or return $this->{SIG_RECEIVED};
  $received and $this->{SIG_RECEIVED}->{$sig}++;
  return $this->{SIG_RECEIVED}->{$sig};
}

=head2 pm_parameter

=cut

sub pm_parameter {
  my ($this,$key,$value) = self_or_default(@_);
  defined $value and $this->{$key} = $value;
  return $this->{$key};
}

=head2 n_processes

=head2 no_signals

=head2 pid_fname

=head2 die_timeout

=head2 role

=head2 start_delay

=cut

sub n_processes     { shift->pm_parameter("n_processes",     @_); }
sub pid_fname       { shift->pm_parameter("pid_fname",       @_); }
sub no_signals      { shift->pm_parameter("no_signals",      @_); }
sub die_timeout     { shift->pm_parameter("die_timeout",     @_); }
sub role            { shift->pm_parameter("role",            @_); }
sub start_delay     { shift->pm_parameter("start_delay",     @_); }

=head2 pm_warn

=cut

sub pm_warn {
  my ($this,$msg) = self_or_default(@_);
  $this->pm_notify($msg);
}

=head2 pm_notify

=cut

sub pm_notify {
  my ($this,$msg) = self_or_default(@_);
  $msg =~ s/\s*$/\n/;
  print STDERR "FastCGI: ".$this->role()." (pid $$): ".$msg;
}

=head2 exit

=cut

sub pm_exit {
  my ($this,$msg,$n) = self_or_default(@_);
  $n ||= 0;
  $this->pm_warn($msg);
  $@ = $msg;
  exit $n;
}

=head2 pm_abort

=cut

sub pm_abort {
  my ($this,$msg,$n) = self_or_default(@_);
  $n ||= 1;
  $this->pm_exit($msg,1);
}

1;
__END__

=head1 BUGS

No known bugs, but this does not mean no bugs exist.

=head1 SEE ALSO

L<FCGI>.

=head1 COPYRIGHT

 FCGI-ProcManager - A Perl FCGI Process Manager
 Copyright (c) 2000, FundsXpress Financial Network, Inc.

 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
 License as published by the Free Software Foundation; either
 version 2 of the License, or (at your option) any later version.

 BECAUSE THIS LIBRARY IS LICENSED FREE OF CHARGE, THIS LIBRARY IS
 BEING PROVIDED "AS IS WITH ALL FAULTS," WITHOUT ANY WARRANTIES
 OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, WITHOUT
 LIMITATION, ANY IMPLIED WARRANTIES OF TITLE, NONINFRINGEMENT,
 MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, AND THE
 ENTIRE RISK AS TO SATISFACTORY QUALITY, PERFORMANCE, ACCURACY,
 AND EFFORT IS WITH THE YOU.  See the GNU Lesser General Public
 License for more details.

 You should have received a copy of the GNU Lesser General Public
 License along with this library; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA

=cut
Commit	Line	Data
0baf5fac	1	package FCGI::ProcManager;
	2
	3	# Copyright (c) 2000, FundsXpress Financial Network, Inc.
	4	# This library is free software released under the GNU Lesser General
	5	# Public License, Version 2.1. Please read the important licensing and
	6	# disclaimer information included below.
	7
518709ed	8	# $Id: ProcManager.pm,v 1.15 2001/01/31 07:00:55 muaddib Exp $
0baf5fac	9
0baf5fac	10	use strict;
4ceac1a1	11	use Exporter;
4ceac1a1	12
518709ed	13	use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $Q);
0baf5fac	14	BEGIN {
518709ed	15	$VERSION = '0.15';
4ceac1a1	16	@ISA = qw(Exporter);
518709ed	17	@EXPORT_OK = qw(pm_manage pm_die pm_reap_server
4ceac1a1	18	pm_write_pid_file pm_remove_pid_file
c146b63d	19	pm_pre_dispatch pm_post_dispatch
518709ed	20	pm_change_process_name pm_received_signal pm_parameter
518709ed	21	pm_warn pm_notify pm_abort pm_exit);
4ceac1a1	22	$EXPORT_TAGS{all} = \@EXPORT_OK;
4ceac1a1	23	$FCGI::ProcManager::Default = 'FCGI::ProcManager';
0baf5fac	24	}
	25
	26	=head1 NAME
	27
	28	FCGI::ProcManager - functions for managing FastCGI applications.
	29
	30	=head1 SYNOPSIS
	31
518709ed	32	{
518709ed	33	# In Object-oriented style.
0baf5fac	34	use CGI::Fast;
0baf5fac	35	use FCGI::ProcManager;
518709ed	36	my $proc_manager = FCGI::ProcManager->new({ n_processes => 10 });
518709ed	37	$proc_manager->pm_manage();
0baf5fac	38	while (my $cgi = CGI::Fast->new()) {
518709ed	39	$proc_manager->pm_pre_dispatch();
	40	# ... handle the request here ...
	41	$proc_manager->pm_post_dispatch();
	42	}
	43
	44	# This style is also supported:
	45	use CGI::Fast;
	46	use FCGI::ProcManager qw(pm_manage pm_pre_dispatch pm_post_dispatch);
	47	pm_manage( n_processes => 10 );
	48	while (my $cgi = CGI::Fast->new()) {
	49	pm_pre_dispatch();
0baf5fac	50	#...
518709ed	51	pm_post_dispatch();
518709ed	52	}
0baf5fac	53
	54	=head1 DESCRIPTION
	55
518709ed	56	FCGI::ProcManager is used to serve as a FastCGI process manager. By
	57	re-implementing it in perl, developers can more finely tune performance in
	58	their web applications, and can take advantage of copy-on-write semantics
	59	prevalent in UNIX kernel process management. The process manager should
	60	be invoked before the caller''s request loop
	61
	62	The primary routine, C<pm_manage>, enters a loop in which it maintains a
	63	number of FastCGI servers (via fork(2)), and which reaps those servers
	64	when they die (via wait(2)).
	65
	66	C<pm_manage> provides too hooks:
	67
	68	C<managing_init> - called just before the manager enters the manager loop.
	69	C<handling_init> - called just before a server is returns from C<pm_manage>
	70
	71	It is necessary for the caller, when implementing its request loop, to
	72	insert a call to C<pm_pre_dispatch> at the top of the loop, and then
	73	7C<pm_post_dispatch> at the end of the loop.
	74
0baf5fac	75
	76	=head1 METHODS
	77
	78	=head2 new
	79
	80	=cut
	81
	82	sub new {
	83	my ($proto,$init) = @_;
	84
518709ed	85	my $this = {
	86	role => "manager",
	87	start_delay => 0,
	88	die_timeout => 60
	89	};
0baf5fac	90	$init and %$this = %$init;
4ceac1a1	91
4ceac1a1	92	bless $this, ref($proto)\|\|$proto;
0baf5fac	93
	94	$this->{PIDS} = {};
	95
	96	return $this;
	97	}
	98
518709ed	99	=head1 Manager methods
4ceac1a1	100
4ceac1a1	101	=head2 pm_manage
0baf5fac	102
0baf5fac	103	global
4ceac1a1	104	() pm_manage(int processes_to_spawn)
0baf5fac	105
	106	DESCRIPTION:
	107
	108	When this is called by a FastCGI script to manage application servers.
	109
	110	=cut
	111
4ceac1a1	112	sub pm_manage {
518709ed	113	my ($this,%values) = self_or_default(@_);
518709ed	114	map { $this->pm_parameter($_,$values{$_}) } keys %values;
0baf5fac	115
518709ed	116	# skip to handling now if we won't be managing any processes.
c146b63d	117	$this->n_processes() or goto HANDLING;
0baf5fac	118
518709ed	119	# call the (possibly overloaded) management initialization hook.
518709ed	120	$this->role("manager");
c146b63d	121	$this->managing_init();
518709ed	122	$this->pm_notify("initialized");
0baf5fac	123
518709ed	124	my $manager_pid = $$;
0baf5fac	125
518709ed	126	MANAGING_LOOP: while (1) {
	127
	128	# if the calling process goes away, perform cleanup.
	129	getppid() == 1 and
	130	return $this->pm_die("calling process has died");
0baf5fac	131
518709ed	132	$this->n_processes() > 0 or
518709ed	133	return $this->pm_die();
0baf5fac	134
518709ed	135	# while we have fewer servers than we want.
	136	PIDS: while (keys(%{$this->{PIDS}}) < $this->n_processes()) {
	137
	138	if (my $pid = fork()) {
	139	# the manager remembers the server.
0baf5fac	140	$this->{PIDS}->{$pid} = { pid=>$pid };
518709ed	141	$this->pm_notify("server (pid $pid) started");
0baf5fac	142
0baf5fac	143	} elsif (! defined $pid) {
518709ed	144	return $this->pm_abort("fork: $!");
0baf5fac	145
0baf5fac	146	} else {
518709ed	147	$this->role("server");
	148	$this->{MANAGER_PID} = $manager_pid;
	149	# the server exits the managing loop.
	150	last MANAGING_LOOP;
0baf5fac	151	}
0baf5fac	152
518709ed	153	for (my $s = $this->start_delay(); $s; $s = sleep $s) {};
518709ed	154	}
c146b63d	155
518709ed	156	# this should block until the next server dies.
518709ed	157	$this->pm_reap_server();
0baf5fac	158
	159	}# while 1
	160
518709ed	161	HANDLING:
0baf5fac	162
518709ed	163	# call the (possibly overloaded) handling init hook
518709ed	164	$this->role("server");
c146b63d	165	$this->handling_init();
518709ed	166	$this->pm_notify("initialized");
0baf5fac	167
518709ed	168	# server returns
0baf5fac	169	return 1;
	170	}
	171
c146b63d	172	=head2 managing_init
0baf5fac	173
	174	=cut
	175
c146b63d	176	sub managing_init {
4ceac1a1	177	my ($this) = self_or_default(@_);
0baf5fac	178
518709ed	179	# begin to handle signals.
	180	$SIG{TERM} = sub { $this->sig_manager(@_) };
	181	$SIG{HUP} = sub { $this->sig_manager(@_) };
0baf5fac	182
518709ed	183	# change the name of this process as it appears in ps(1) output.
518709ed	184	$this->pm_change_process_name("perl-fcgi-pm");
0baf5fac	185
518709ed	186	$this->pm_write_pid_file();
0baf5fac	187	}
0baf5fac	188
518709ed	189
518709ed	190	=head2 pm_die
0baf5fac	191
	192	=cut
	193
518709ed	194	sub pm_die {
	195	my ($this,$msg,$n) = self_or_default(@_);
	196
	197	# stop handling signals.
	198	$SIG{HUP} = 'DEFAULT';
	199	$SIG{TERM} = 'DEFAULT';
	200
	201	$this->pm_remove_pid_file();
	202
	203	# prepare to die no matter what.
	204	if (defined $this->die_timeout()) {
	205	$SIG{ARLM} = sub { $this->pm_abort("reap timeout") };
	206	alarm $this->die_timeout();
	207	}
	208
	209	# send a TERM to each of the servers.
	210	kill "TERM", keys %{$this->{PIDS}};
	211
	212	# wait for the servers to die.
	213	while (%{$this->{PIDS}}) {
	214	$this->pm_reap_server();
	215	}
	216
	217	# die already.
	218	$this->pm_exit("dying: ".$msg,$n);
0baf5fac	219	}
0baf5fac	220
518709ed	221	=head2 pm_reap_server
0baf5fac	222
	223	=cut
	224
518709ed	225	sub pm_reap_server {
4ceac1a1	226	my ($this) = self_or_default(@_);
518709ed	227
	228	# wait for the next server to die.
	229	next if (my $pid = wait()) < 0;
	230
	231	# notify when one of our servers have died.
	232	delete $this->{PIDS}->{$pid} and
	233	$this->pm_notify("server (pid $pid) exited with status $?");
0baf5fac	234	}
0baf5fac	235
c146b63d	236	=head2 pm_write_pid_file
0baf5fac	237
	238	=cut
	239
4ceac1a1	240	sub pm_write_pid_file {
4ceac1a1	241	my ($this,$fname) = self_or_default(@_);
0baf5fac	242	$fname \|\|= $this->pid_fname() or return;
0baf5fac	243	if (!open PIDFILE, ">$fname") {
518709ed	244	$this->pm_warn("open: $fname: $!");
0baf5fac	245	return;
	246	}
	247	print PIDFILE "$$\n";
	248	close PIDFILE;
	249	}
	250
c146b63d	251	=head2 pm_remove_pid_file
0baf5fac	252
	253	=cut
	254
4ceac1a1	255	sub pm_remove_pid_file {
4ceac1a1	256	my ($this,$fname) = self_or_default(@_);
0baf5fac	257	$fname \|\|= $this->pid_fname() or return;
518709ed	258	my $ret = unlink($fname) or $this->pm_warn("unlink: $fname: $!");
0baf5fac	259	return $ret;
	260	}
	261
518709ed	262	=head2 sig_manager
0baf5fac	263
	264	=cut
	265
518709ed	266	sub sig_manager {
	267	my ($this,$name) = @_;
	268	if ($name eq "TERM" or $name eq "HUP") {
	269	$this->pm_die("received signal $name");
	270	} else {
	271	$this->pm_notify("ignoring signal $name");
	272	}
0baf5fac	273	}
0baf5fac	274
518709ed	275	=head1 Handler methods
0baf5fac	276
518709ed	277	=head2 handling_init
0baf5fac	278
	279	=cut
	280
518709ed	281	sub handling_init {
518709ed	282	my ($this) = self_or_default(@_);
0baf5fac	283
518709ed	284	# begin to handle signals.
	285	$SIG{TERM} = sub { $this->sig_handler(@_) };
	286	$SIG{HUP} = sub { $this->sig_handler(@_) };
0baf5fac	287
518709ed	288	# change the name of this process as it appears in ps(1) output.
518709ed	289	$this->pm_change_process_name("perl-fcgi");
0baf5fac	290	}
0baf5fac	291
518709ed	292	=head2 pm_pre_dispatch
0baf5fac	293
	294	=cut
	295
518709ed	296	sub pm_pre_dispatch {
4ceac1a1	297	my ($this) = self_or_default(@_);
0baf5fac	298	}
0baf5fac	299
518709ed	300	=head2 pm_post_dispatch
0baf5fac	301
	302	=cut
	303
518709ed	304	sub pm_post_dispatch {
4ceac1a1	305	my ($this) = self_or_default(@_);
518709ed	306	if ($this->pm_received_signal("TERM")) {
	307	$this->pm_exit("safe exit after SIGTERM");
	308	}
	309	if ($this->pm_received_signal("HUP")) {
	310	$this->pm_exit("safe exit after SIGHUP");
	311	}
	312	if (getppid() != $this->{MANAGER_PID}) {
	313	$this->pm_exit("safe exit: manager has died");
	314	}
0baf5fac	315	}
0baf5fac	316
518709ed	317	=head2 sig_handler
0baf5fac	318
	319	=cut
	320
518709ed	321	sub sig_handler {
c146b63d	322	my ($this,$name) = @_;
518709ed	323	$this->pm_received_signal($name,1);
	324	}
	325
	326	=head1 Common methods and routines
	327
	328	=head2 self_or_default
	329
	330	private global
	331	(ProcManager, @args) self_or_default([ ProcManager, ] @args);
	332
	333	DESCRIPTION:
	334
	335	This is a helper subroutine to acquire or otherwise create a singleton
	336	default object if one is not passed in, e.g., a method call.
	337
	338	=cut
	339
	340	sub self_or_default {
	341	return @_ if defined $_[0] and !ref $_[0] and $_[0] eq 'FCGI::ProcManager';
	342	if (!defined $_[0] or (ref($_[0]) ne 'FCGI::ProcManager' and
	343	!UNIVERSAL::isa($_[0],'FCGI::ProcManager'))) {
	344	$Q or $Q = $FCGI::ProcManager::Default->new;
	345	unshift @_, $Q;
0baf5fac	346	}
518709ed	347	return wantarray ? @_ : $Q;
	348	}
	349
	350	=head2 pm_change_process_name
	351
	352	=cut
	353
	354	sub pm_change_process_name {
	355	my ($this,$name) = self_or_default(@_);
	356	$0 = $name;
	357	}
	358
	359	=head2 pm_received_signal
	360
	361	=cut
	362
	363	sub pm_received_signal {
	364	my ($this,$sig,$received) = self_or_default(@_);
	365	$sig or return $this->{SIG_RECEIVED};
	366	$received and $this->{SIG_RECEIVED}->{$sig}++;
	367	return $this->{SIG_RECEIVED}->{$sig};
	368	}
	369
	370	=head2 pm_parameter
	371
	372	=cut
	373
	374	sub pm_parameter {
	375	my ($this,$key,$value) = self_or_default(@_);
	376	defined $value and $this->{$key} = $value;
	377	return $this->{$key};
0baf5fac	378	}
0baf5fac	379
518709ed	380	=head2 n_processes
	381
	382	=head2 no_signals
	383
	384	=head2 pid_fname
	385
	386	=head2 die_timeout
	387
	388	=head2 role
	389
	390	=head2 start_delay
	391
	392	=cut
	393
	394	sub n_processes { shift->pm_parameter("n_processes", @_); }
	395	sub pid_fname { shift->pm_parameter("pid_fname", @_); }
	396	sub no_signals { shift->pm_parameter("no_signals", @_); }
	397	sub die_timeout { shift->pm_parameter("die_timeout", @_); }
	398	sub role { shift->pm_parameter("role", @_); }
	399	sub start_delay { shift->pm_parameter("start_delay", @_); }
	400
c146b63d	401	=head2 pm_warn
0baf5fac	402
	403	=cut
	404
4ceac1a1	405	sub pm_warn {
4ceac1a1	406	my ($this,$msg) = self_or_default(@_);
518709ed	407	$this->pm_notify($msg);
	408	}
	409
	410	=head2 pm_notify
	411
	412	=cut
	413
	414	sub pm_notify {
	415	my ($this,$msg) = self_or_default(@_);
	416	$msg =~ s/\s*$/\n/;
	417	print STDERR "FastCGI: ".$this->role()." (pid $$): ".$msg;
0baf5fac	418	}
	419
	420	=head2 exit
	421
	422	=cut
	423
4ceac1a1	424	sub pm_exit {
4ceac1a1	425	my ($this,$msg,$n) = self_or_default(@_);
0baf5fac	426	$n \|\|= 0;
4ceac1a1	427	$this->pm_warn($msg);
0baf5fac	428	$@ = $msg;
	429	exit $n;
	430	}
	431
c146b63d	432	=head2 pm_abort
0baf5fac	433
	434	=cut
	435
4ceac1a1	436	sub pm_abort {
4ceac1a1	437	my ($this,$msg,$n) = self_or_default(@_);
0baf5fac	438	$n \|\|= 1;
4ceac1a1	439	$this->pm_exit($msg,1);
0baf5fac	440	}
	441
	442	1;
	443	__END__
	444
	445	=head1 BUGS
	446
	447	No known bugs, but this does not mean no bugs exist.
	448
	449	=head1 SEE ALSO
	450
	451	L<FCGI>.
	452
	453	=head1 COPYRIGHT
	454
	455	FCGI-ProcManager - A Perl FCGI Process Manager
	456	Copyright (c) 2000, FundsXpress Financial Network, Inc.
	457
	458	This library is free software; you can redistribute it and/or
	459	modify it under the terms of the GNU Lesser General Public
	460	License as published by the Free Software Foundation; either
	461	version 2 of the License, or (at your option) any later version.
	462
	463	BECAUSE THIS LIBRARY IS LICENSED FREE OF CHARGE, THIS LIBRARY IS
	464	BEING PROVIDED "AS IS WITH ALL FAULTS," WITHOUT ANY WARRANTIES
	465	OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, WITHOUT
	466	LIMITATION, ANY IMPLIED WARRANTIES OF TITLE, NONINFRINGEMENT,
	467	MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, AND THE
	468	ENTIRE RISK AS TO SATISFACTORY QUALITY, PERFORMANCE, ACCURACY,
	469	AND EFFORT IS WITH THE YOU. See the GNU Lesser General Public
	470	License for more details.
	471
	472	You should have received a copy of the GNU Lesser General Public
	473	License along with this library; if not, write to the Free Software
	474	Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
	475
	476	=cut