File Coverage

blib/lib/prefork.pm
Criterion Covered Total %
statement 60 60 100.0
branch 24 28 85.7
condition 3 3 100.0
subroutine 12 12 100.0
pod 3 3 100.0
total 102 106 96.2


line stmt bran cond sub pod time code
1             package prefork;
2              
3             =pod
4              
5             =head1 NAME
6              
7             prefork - Optimized module loading for forking or non-forking processes
8              
9             =head1 SYNOPSIS
10              
11             In a module that normally delays module loading with require
12              
13             # Module Foo::Bar only uses This::That 25% of the time.
14             # We want to preload in in forking scenarios (like mod_perl), but
15             # we want to delay loading in non-forking scenarios (like CGI)
16             use prefork 'This::That';
17            
18             sub do_something {
19             my $arg = shift;
20            
21             # Load the module at run-time as normal
22             if ( $special_case ) {
23             require This::That;
24             This::That::blah(@_);
25             }
26             }
27            
28             # Register a module to be loaded before forking directly
29             prefork::prefork('Module::Name');
30              
31             In a script or module that is going to be forking.
32              
33             package Module::Forker;
34            
35             # Enable forking mode
36             use prefork ':enable';
37            
38             # Or call it directly
39             prefork::enable();
40              
41             In a third-party run-time loader
42              
43             package Runtime::Loader;
44            
45             use prefork ();
46             prefork::notify( \&load_everything );
47            
48             ...
49            
50             sub load_everything { ... }
51            
52             1;
53            
54             =head1 INTRODUCTION
55              
56             The task of optimizing module loading in Perl tends to move in two different
57             directions, depending on the context.
58              
59             In a procedural context, such as scripts and CGI-type situations, you can
60             improve the load times and memory usage by loading a module at run-time,
61             only once you are sure you will need it.
62              
63             In the other common load profile for perl applications, the application
64             will start up and then fork off various worker processes. To take full
65             advantage of memory copy-on-write features, the application should load
66             as many modules as possible before forking to prevent them consuming memory
67             in multiple worker processes.
68              
69             Unfortunately, the strategies used to optimise for these two load profiles
70             are diametrically opposed. What improves a situation for one tends to
71             make life worse for the other.
72              
73             =head1 DESCRIPTION
74              
75             The C pragma is intended to allow module writers to optimise
76             module loading for B scenarios with as little additional code as
77             possible.
78              
79             prefork.pm is intended to serve as a central and optional marshalling
80             point for state detection (are we running in compile-time or run-time
81             mode) and to act as a relatively light-weight module loader.
82              
83             =head2 Loaders and Forkers
84              
85             C is intended to be used in two different ways.
86              
87             The first is by a module that wants to indicate that another module should
88             be loaded before forking. This is known as a "Loader".
89              
90             The other is a script or module that will be initiating the forking. It
91             will tell prefork.pm that it is either going to fork, or is about to fork,
92             or for some other reason all modules previously mentioned by the Loaders
93             should be loaded immediately.
94              
95             =head2 Usage as a Pragma
96              
97             A Loader can register a module to be loaded using the following
98              
99             use prefork 'My::Module';
100              
101             The same thing can be done in such a way as to not require prefork
102             being installed, but taking advantage of it if it is.
103              
104             eval "use prefork 'My::Module';";
105              
106             A Forker can indicate that it will be forking with the following
107              
108             use prefork ':enable';
109              
110             In any use of C as a pragma, you can only pass a single value
111             as argument. Any additional arguments will be ignored. (This may throw
112             an error in future versions).
113              
114             =head2 Compatbility with mod_perl and others
115              
116             Part of the design of C, and its minimalistic nature, is that it
117             is intended to work easily with existing modules, needing only small
118             changes.
119              
120             For example, C itself will detect the C<$ENV{MOD_PERL}>
121             environment variable and automatically start in forking mode.
122              
123             prefork has support for integrating with third-party modules, such as
124             L. The C function allows these run-time loaders
125             to register callbacks, to be called once prefork enters forking mode.
126              
127             The synopsis entry above describes adding support for prefork.pm as a
128             dependency. To allow your third-party module loader without a dependency
129             and only if it is installed use the following:
130              
131             eval { require prefork; }
132             prefork::notify( \&function ) unless $@;
133              
134             =head2 Using prefork.pm
135              
136             From the Loader side, it is fairly simple. prefork becomes a dependency
137             for your module, and you use it as a pragma as documented above.
138              
139             For the Forker, you have two options. Use as a dependency or optional use.
140              
141             In the dependency case, you add prefork as a dependency and use it as a
142             pragma with the ':enable' option.
143              
144             To add only optional support for prefork, without requiring it to be
145             installed, you should wait until the moment just before you fork and then
146             call C directly ONLY if it is loaded.
147              
148             # Load modules if any use the prefork pragma.
149             prefork::enable() if $INC{prefork.pm};
150              
151             This will cause the modules to be loaded ONLY if there are any modules that
152             need to be loaded. The main advantage of the dependency version is that you
153             only need to enable the module once, and not before each fork.
154              
155             If you wish to have your own module leverage off the forking-detection that
156             prefork provides, you can also do the following.
157              
158             use prefork;
159             if ( $prefork::FORKING ) {
160             # Complete some preparation task
161             }
162              
163             =head2 Modules that are prefork-aware
164              
165             =over 4
166              
167             =item mod_perl/mod_perl2
168              
169             =item Class::Autouse
170              
171             =back
172              
173             =head1 FUNCTIONS
174              
175             =cut
176              
177 4     4   54484 use 5.005;
  4         16  
  4         191  
178 4     4   23 use strict;
  4         6  
  4         151  
179 4     4   32 use Carp ();
  4         8  
  4         108  
180 4     4   22 use List::Util 0.18 ();
  4         140  
  4         99  
181 4     4   22 use Scalar::Util 0.18 ();
  4         80  
  4         115  
182              
183 4     4   20 use vars qw{$VERSION $FORKING %MODULES @NOTIFY};
  4         8  
  4         744  
184             BEGIN {
185 4     4   10 $VERSION = '1.04';
186              
187             # The main state variable for this package.
188             # Are we in preforking mode.
189 4         8 $FORKING = '';
190              
191             # The queue of modules to load
192 4         10 %MODULES = ();
193              
194             # The queue of notification callbacks
195             @NOTIFY = (
196             sub {
197             # Do a hash copy of Config to get everything
198             # inside of it preloaded.
199 3         21 require Config;
200 3         6 eval {
201             # Sometimes there is no Config_heavy.pl
202 3         2901 require 'Config_heavy.pl';
203             };
204 3         15589 my $copy = { %Config::Config };
205 3         135068 return 1;
206             },
207 4         27 );
208              
209             # Look for situations that need us to start in forking mode
210 4 50       3061 $FORKING = 1 if $ENV{MOD_PERL};
211             }
212              
213             sub import {
214 5 100   5   6524 return 1 unless $_[1];
215 3 100       16 ($_[1] eq ':enable') ? enable() : prefork($_[1]);
216             }
217              
218             =pod
219              
220             =head2 prefork $module
221              
222             The 'prefork' function indicates that a module should be loaded before
223             the process will fork. If already in forking mode the module will be
224             loaded immediately.
225              
226             Otherwise it will be added to a queue to be loaded later if it recieves
227             instructions that it is going to be forking.
228              
229             Returns true on success, or dies on error.
230              
231             =cut
232              
233             sub prefork ($) {
234             # Just hand straight to require if enabled
235 7 100   7 1 2564 my $module = defined $_[0] ? "$_[0]" : ''
    100          
236             or Carp::croak('You did not pass a module name to prefork');
237 5 100       165 $module =~ /^[^\W\d]\w*(?:(?:\'|::)[^\W\d]\w*)*$/
238             or Carp::croak("'$module' is not a module name");
239 4         54 my $file = join( '/', split /(?:\'|::)/, $module ) . '.pm';
240              
241             # Is it already loaded or queued
242 4 50       19 return 1 if $INC{$file};
243 4 50       58 return 1 if $MODULES{$module};
244              
245             # Load now if enabled, or add to the module list
246 4 100       2187 return require $file if $FORKING;
247 2         7 $MODULES{$module} = $file;
248              
249 2         21 1;
250             }
251              
252             =pod
253              
254             =head2 enable
255              
256             The C function indicates to the prefork module that the process is
257             going to fork, possibly immediately.
258              
259             When called, prefork.pm will immediately load all outstanding modules, and
260             will set a flag so that any further 'prefork' calls will load the module
261             at that time.
262              
263             Returns true, dieing as normal is there is a problem loading a module.
264              
265             =cut
266              
267             sub enable () {
268             # Turn on the PREFORK flag, so any additional
269             # 'use prefork ...' calls made during loading
270             # will load immediately.
271 4 100   4 1 716 return 1 if $FORKING;
272 3         8 $FORKING = 1;
273              
274             # Load all of the modules not yet loaded
275 3         16 foreach my $module ( sort keys %MODULES ) {
276 2         7 my $file = $MODULES{$module};
277              
278             # Has it been loaded since we were told about it
279 2 50       10 next if $INC{$file};
280              
281             # Load the module.
282 2         2275 require $file;
283             }
284              
285             # Clear the modules list
286 3         2457 %MODULES = ();
287              
288             # Execute the third-party callbacks
289 3         19 while ( my $callback = shift @NOTIFY ) {
290 7         30 $callback->();
291             }
292              
293 3         173 1;
294             }
295              
296             =pod
297              
298             =head2 notify &function
299              
300             The C function is used to integrate support for modules other than
301             prefork.pm itself.
302              
303             A module loader calls the notify function, passing it a reference to a
304             C reference (either anon or a function reference). C will
305             store this CODE reference, and execute it immediately as soon as it knows
306             it is in forking-mode, but after it loads its own modules.
307              
308             Callbacks are called in the order they are registered.
309              
310             Normally, this will happen as soon as the C function is called.
311              
312             However, you should be aware that if prefork is B in preforking
313             mode at the time that the notify function is called, prefork.pm will
314             execute the function immediately.
315              
316             This means that any third party module loader should be fully loaded and
317             initialised B the callback is provided to C.
318              
319             Returns true if the function is stored, or dies if not passed a C
320             reference, or the callback is already set in the notify queue.
321              
322             =cut
323              
324             sub notify ($) {
325             # Get the CODE ref callback param
326 11     11 1 3865 my $function = shift;
327 11         42 my $reftype = Scalar::Util::reftype($function);
328 11 100 100     79 unless ( $reftype and $reftype eq 'CODE' ) {
329 3         628 Carp::croak("prefork::notify was not passed a CODE reference");
330             }
331              
332             # Call it immediately is already in forking mode
333 8 100       43 if ( $FORKING ) {
334 2         6 $function->();
335 2         13 return 1;
336             }
337              
338             # Is it already defined?
339 6 100   9   58 if ( List::Util::first { Scalar::Util::refaddr($function) == Scalar::Util::refaddr($_) } @NOTIFY ) {
  9         47  
340 1         86 Carp::croak("Callback function already registered");
341             }
342              
343             # Add to the queue
344 5         21 push @NOTIFY, $function;
345              
346 5         12 1;
347             }
348              
349              
350              
351              
352              
353             #####################################################################
354             # Built-in Notifications
355              
356             # Compile CGI functions automatically
357             prefork::notify( sub {
358             CGI->compile() if $INC{'CGI.pm'};
359             } );
360              
361             1;
362              
363             =pod
364              
365             =head1 TO DO
366              
367             - Add checks for more pre-forking situations
368              
369             =head1 SUPPORT
370              
371             Bugs should be always submitted via the CPAN bug tracker, located at
372              
373             L
374              
375             For other issues, or commercial enhancement or support, contact the author.
376              
377             =head1 AUTHOR
378              
379             Adam Kennedy
380              
381             =head1 COPYRIGHT
382              
383             Thank you to Phase N Australia (L) for
384             permitting the open sourcing and release of this distribution.
385              
386             Copyright 2004 - 2009 Adam Kennedy.
387              
388             This program is free software; you can redistribute
389             it and/or modify it under the same terms as Perl itself.
390              
391             The full text of the license can be found in the
392             LICENSE file included with this module.
393              
394             =cut