File: prefork.pm

package info (click to toggle)
libprefork-perl 1.00-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 164 kB
  • ctags: 98
  • sloc: perl: 1,289; makefile: 42
file content (382 lines) | stat: -rw-r--r-- 10,165 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
package prefork;

=pod

=head1 NAME

prefork - Optimized module loading for forking or non-forking processes

=head1 SYNOPSIS

In a module that normally delays module loading with require

  # Module Foo::Bar only uses This::That 25% of the time.
  # We want to preload in in forking scenarios (like mod_perl), but
  # we want to delay loading in non-forking scenarios (like CGI)
  use prefork 'This::That';
  
  sub do_something {
  	my $arg = shift;
  
  	# Load the module at run-time as normal
  	if ( $special_case ) {
  		require This::That;
  		This::That::blah(@_);
  	}
  }
  
  # Register a module to be loaded before forking directly
  prefork::prefork('Module::Name');

In a script or module that is going to be forking.

  package Module::Forker;
  
  # Enable forking mode
  use prefork ':enable';
  
  # Or call it directly
  prefork::enable();

In a third-party run-time loader

  package Runtime::Loader;
  
  use prefork ();
  prefork::notify( \&load_everything );
  
  ...
  
  sub load_everything { ... }
  
  1;
  
=head1 INTRODUCTION

The task of optimizing module loading in Perl tends to move in two different
directions, depending on the context.

In a procedural context, such as scripts and CGI-type situations, you can
improve the load times and memory usage by loading a module at run-time,
only once you are sure you will need it.

In the other common load profile for perl applications, the application
will start up and then fork off various worker processes. To take full
advantage of memory copy-on-write features, the application should load
as many modules as possible before forking to prevent them consuming memory
in multiple worker processes.

Unfortunately, the strategies used to optimise for these two load profiles
are diametrically opposed. What improves a situation for one tends to
make life worse for the other.

=head1 DESCRIPTION

The C<prefork> pragma is intended to allow module writers to optimise
module loading for B<both> scenarios with as little additional code as
possible.

prefork.pm is intended to serve as a central and optional marshalling
point for state detection (are we running in compile-time or run-time
mode) and to act as a relatively light-weight module loader.

=head2 Loaders and Forkers

C<prefork> is intended to be used in two different ways.

The first is by a module that wants to indicate that another module should
be loaded before forking. This is known as a "Loader".

The other is a script or module that will be initiating the forking. It
will tell prefork.pm that it is either going to fork, or is about to fork,
or for some other reason all modules previously mentioned by the Loaders
should be loaded immediately.

=head2 Usage as a Pragma

A Loader can register a module to be loaded using the following

  use prefork 'My::Module';

The same thing can be done in such a way as to not require prefork
being installed, but taking advantage of it if it is.

  eval "use prefork 'My::Module';";

A Forker can indicate that it will be forking with the following

  use prefork ':enable';

In any use of C<prefork> as a pragma, you can only pass a single value
as argument. Any additional arguments will be ignored. (This may throw
an error in future versions).

=head2 Compatbility with mod_perl and others

Part of the design of C<prefork>, and its minimalistic nature, is that it
is intended to work easily with existing modules, needing only small
changes.

For example, C<prefork> itself will detect the C<$ENV{MOD_PERL}>
environment variable and automatically start in forking mode.

prefork has support for integrating with third-party modules, such as
L<Class::Autouse>. The C<notify> function allows these run-time loaders
to register callbacks, to be called once prefork enters forking mode.

The synopsis entry above describes adding support for prefork.pm as a
dependency. To allow your third-party module loader without a dependency
and only if it is installed use the following:

  eval { require prefork; }
  prefork::notify( \&function ) unless $@;

=head2 Using prefork.pm

From the Loader side, it is fairly simple. prefork becomes a dependency
for your module, and you use it as a pragma as documented above.

For the Forker, you have two options. Use as a dependency or optional use.

In the dependency case, you add prefork as a dependency and use it as a
pragma with the ':enable' option.

To add only optional support for prefork, without requiring it to be
installed, you should wait until the moment just before you fork and then
call C<prefork::enable> directly ONLY if it is loaded.

  # Load modules if any use the prefork pragma.
  prefork::enable() if $INC{prefork.pm};

This will cause the modules to be loaded ONLY if there are any modules that
need to be loaded. The main advantage of the dependency version is that you
only need to enable the module once, and not before each fork.

If you wish to have your own module leverage off the forking-detection that
prefork provides, you can also do the following.

  use prefork;
  if ( $prefork::FORKING ) {
  	# Complete some preparation task
  }

=head2 Modules that are prefork-aware

=over 4

=item mod_perl/mod_perl2

=item Class::Autouse

=back

=head1 FUNCTIONS

=cut

use 5.005;
use strict;
use Carp         ();
use List::Util   ();
use Scalar::Util ();

use vars qw{$VERSION $FORKING %MODULES @NOTIFY};
BEGIN {
	$VERSION = '1.00';

	# The main state variable for this package.
	# Are we in preforking mode.
	$FORKING = '';

	# The queue of modules to load
	%MODULES = ();

	# The queue of notification callbacks
	@NOTIFY = ();

	# Look for situations that need us to start in forking mode
	$FORKING = 1 if $ENV{MOD_PERL};
}

sub import {
	return 1 unless $_[1];
	($_[1] eq ':enable') ? enable() : prefork($_[1]);
}

=pod

=head2 prefork $module

The 'prefork' function indicates that a module should be loaded before
the process will fork. If already in forking mode the module will be
loaded immediately.

Otherwise it will be added to a queue to be loaded later if it recieves
instructions that it is going to be forking.

Returns true on success, or dies on error.

=cut

sub prefork ($) {
	# Just hand straight to require if enabled
	my $module = defined $_[0] ? "$_[0]" : ''
		or Carp::croak('You did not pass a module name to prefork');
	$module =~ /^[^\W\d]\w*(?:(?:'|::)[^\W\d]\w*)*$/
		or Carp::croak("'$module' is not a module name");
	my $file = join( '/', split /(?:\'|::)/, $module ) . '.pm';

	# Is it already loaded or queued
	return 1 if $INC{$file};
	return 1 if $MODULES{$module};

	# Load now if enabled, or add to the module list
	return require $file if $FORKING;
	$MODULES{$module} = $file;

	1;
}

=pod

=head2 enable

The C<enable> function indicates to the prefork module that the process is
going to fork, possibly immediately.

When called, prefork.pm will immediately load all outstanding modules, and
will set a flag so that any further 'prefork' calls will load the module
at that time.

Returns true, dieing as normal is there is a problem loading a module.

=cut

sub enable () {
	# Turn on the PREFORK flag, so any additional
	# 'use prefork ...' calls made during loading
	# will load immediately.
	return 1 if $FORKING;
	$FORKING = 1;

	# Load all of the modules not yet loaded
	foreach my $module ( sort keys %MODULES ) {
		my $file = $MODULES{$module};

		# Has it been loaded since we were told about it
		next if $INC{$file};

		# Load the module.
		require $file;
	}

	# Clear the modules list
	%MODULES = ();

	# Execute the third-party callbacks
	while ( my $callback = shift @NOTIFY ) {
		$callback->();
	}

	1;
}

=pod

=head2 notify &function

The C<notify> function is used to integrate support for modules other than
prefork.pm itself.

A module loader calls the notify function, passing it a reference to a
C<CODE> reference (either anon or a function reference). C<prefork> will
store this CODE reference, and execute it immediately as soon as it knows
it is in forking-mode, but after it loads its own modules.

Callbacks are called in the order they are registered.

Normally, this will happen as soon as the C<enable> function is called.

However, you should be aware that if prefork is B<already> in preforking
mode at the time that the notify function is called, prefork.pm will
execute the function immediately.

This means that any third party module loader should be fully loaded and
initialised B<before> the callback is provided to C<notify>.

Returns true if the function is stored, or dies if not passed a C<CODE>
reference, or the callback is already set in the notify queue.

=cut

sub notify ($) {
	# Get the CODE ref callback param
	my $function = shift;
	my $reftype  = Scalar::Util::reftype($function);
	unless ( $reftype and $reftype eq 'CODE' ) {
		Carp::croak("prefork::notify was not passed a CODE reference");
	}

	# Call it immediately is already in forking mode
	if ( $FORKING ) {
		$function->();
		return 1;
	}

	# Is it already defined?
	if ( List::Util::first { Scalar::Util::refaddr($function) == Scalar::Util::refaddr($_) } @NOTIFY ) {
		Carp::croak("Callback function already registered");
	}

	# Add to the queue
	push @NOTIFY, $function;

	1;
}





#####################################################################
# Built-in Notifications

# Compile CGI functions automatically
prefork::notify( sub {
	CGI->compile() if $INC{'CGI.pm'};
} );

1;

=pod

=head1 TO DO

- Add checks for more pre-forking situations

=head1 SUPPORT

Bugs should be always submitted via the CPAN bug tracker, located at

L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=prefork>

For other issues, or commercial enhancement or support, contact the author.

=head1 AUTHOR

Adam Kennedy, L<http://ali.as/>, cpan@ali.as

=head1 COPYRIGHT

Thank you to Phase N Australia (L<http://phase-n.com/>) for
permitting the open sourcing and release of this distribution.

Copyright (c) 2004 - 2005 Adam Kennedy. All rights reserved.

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=cut