File Coverage

blib/lib/prefork.pm
Criterion Covered Total %
statement 46 46 100.0
branch 23 26 88.4
condition 3 3 100.0
subroutine 10 10 100.0
pod 3 3 100.0
total 85 88 96.5


line stmt bran cond sub pod time code
1             package prefork; # git description: 7b0d615
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 Compatibility 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 3     3   110066 use 5.006;
  3         23  
178 3     3   13 use strict;
  3         4  
  3         70  
179             #use warnings; # this might not be safe to turn on!
180 3     3   13 use Carp ();
  3         4  
  3         60  
181 3     3   12 use List::Util 0.18 ();
  3         56  
  3         64  
182 3     3   14 use Scalar::Util 0.18 ();
  3         52  
  3         1798  
183              
184             our $VERSION = '1.05';
185              
186             # The main state variable for this package.
187             # Are we in preforking mode.
188             our $FORKING = '';
189              
190             # The queue of modules to load
191             our %MODULES = ();
192              
193             # The queue of notification callbacks
194             our @NOTIFY = (
195             sub {
196             # Do a hash copy of Config to get everything
197             # inside of it preloaded.
198             require Config;
199             eval {
200             # Sometimes there is no Config_heavy.pl
201             require 'Config_heavy.pl';
202             };
203             my $copy = { %Config::Config };
204             return 1;
205             },
206             );
207              
208             # Look for situations that need us to start in forking mode
209             $FORKING = 1 if $ENV{MOD_PERL};
210              
211             sub import {
212 4 100   4   4064 return 1 unless $_[1];
213 3 100       9 ($_[1] eq ':enable') ? enable() : prefork($_[1]);
214             }
215              
216             =pod
217              
218             =head2 prefork $module
219              
220             The 'prefork' function indicates that a module should be loaded before
221             the process will fork. If already in forking mode the module will be
222             loaded immediately.
223              
224             Otherwise it will be added to a queue to be loaded later if it receives
225             instructions that it is going to be forking.
226              
227             Returns true on success, or dies on error.
228              
229             =cut
230              
231             sub prefork ($) {
232             # Just hand straight to require if enabled
233 7 100   7 1 2459 my $module = defined $_[0] ? "$_[0]" : ''
    100          
234             or Carp::croak('You did not pass a module name to prefork');
235 5 100       107 $module =~ /^[^\W\d]\w*(?:(?:\'|::)[^\W\d]\w*)*$/
236             or Carp::croak("'$module' is not a module name");
237 4         35 my $file = join( '/', split /(?:\'|::)/, $module ) . '.pm';
238              
239             # Is it already loaded or queued
240 4 50       12 return 1 if $INC{$file};
241 4 50       11 return 1 if $MODULES{$module};
242              
243             # Load now if enabled, or add to the module list
244 4 100       918 return require $file if $FORKING;
245 2         14 $MODULES{$module} = $file;
246              
247 2         14 1;
248             }
249              
250             =pod
251              
252             =head2 enable
253              
254             The C function indicates to the prefork module that the process is
255             going to fork, possibly immediately.
256              
257             When called, prefork.pm will immediately load all outstanding modules, and
258             will set a flag so that any further 'prefork' calls will load the module
259             at that time.
260              
261             Returns true, dying as normal is there is a problem loading a module.
262              
263             =cut
264              
265             sub enable () {
266             # Turn on the PREFORK flag, so any additional
267             # 'use prefork ...' calls made during loading
268             # will load immediately.
269 4 100   4 1 500 return 1 if $FORKING;
270 3         14 $FORKING = 1;
271              
272             # Load all of the modules not yet loaded
273 3         15 foreach my $module ( sort keys %MODULES ) {
274 2         4 my $file = $MODULES{$module};
275              
276             # Has it been loaded since we were told about it
277 2 50       5 next if $INC{$file};
278              
279             # Load the module.
280 2         742 require $file;
281             }
282              
283             # Clear the modules list
284 3         1240 %MODULES = ();
285              
286             # Execute the third-party callbacks
287 3         12 while ( my $callback = shift @NOTIFY ) {
288 7         32 $callback->();
289             }
290              
291 3         47 1;
292             }
293              
294             =pod
295              
296             =head2 notify &function
297              
298             The C function is used to integrate support for modules other than
299             prefork.pm itself.
300              
301             A module loader calls the notify function, passing it a reference to a
302             C reference (either anon or a function reference). C will
303             store this CODE reference, and execute it immediately as soon as it knows
304             it is in forking-mode, but after it loads its own modules.
305              
306             Callbacks are called in the order they are registered.
307              
308             Normally, this will happen as soon as the C function is called.
309              
310             However, you should be aware that if prefork is B in preforking
311             mode at the time that the notify function is called, prefork.pm will
312             execute the function immediately.
313              
314             This means that any third party module loader should be fully loaded and
315             initialised B the callback is provided to C.
316              
317             Returns true if the function is stored, or dies if not passed a C
318             reference, or the callback is already set in the notify queue.
319              
320             =cut
321              
322             sub notify ($) {
323             # Get the CODE ref callback param
324 10     10 1 1919 my $function = shift;
325 10         26 my $reftype = Scalar::Util::reftype($function);
326 10 100 100     46 unless ( $reftype and $reftype eq 'CODE' ) {
327 3         289 Carp::croak("prefork::notify was not passed a CODE reference");
328             }
329              
330             # Call it immediately is already in forking mode
331 7 100       15 if ( $FORKING ) {
332 2         5 $function->();
333 2         9 return 1;
334             }
335              
336             # Is it already defined?
337 5 100   8   26 if ( List::Util::first { Scalar::Util::refaddr($function) == Scalar::Util::refaddr($_) } @NOTIFY ) {
  8         25  
338 1         66 Carp::croak("Callback function already registered");
339             }
340              
341             # Add to the queue
342 4         14 push @NOTIFY, $function;
343              
344 4         9 1;
345             }
346              
347              
348              
349              
350              
351             #####################################################################
352             # Built-in Notifications
353              
354             # Compile CGI functions automatically
355             prefork::notify( sub {
356             CGI->compile() if $INC{'CGI.pm'};
357             } );
358              
359             1;
360              
361             =pod
362              
363             =head1 TO DO
364              
365             - Add checks for more pre-forking situations
366              
367             =head1 SUPPORT
368              
369             Bugs should be always submitted via the CPAN bug tracker, located at
370              
371             L
372              
373             For other issues, or commercial enhancement or support, contact the author.
374              
375             =head1 AUTHOR
376              
377             Adam Kennedy
378              
379             =head1 COPYRIGHT
380              
381             Thank you to Phase N Australia (L) for
382             permitting the open sourcing and release of this distribution.
383              
384             Copyright 2004 - 2009 Adam Kennedy.
385              
386             This program is free software; you can redistribute
387             it and/or modify it under the same terms as Perl itself.
388              
389             The full text of the license can be found in the
390             LICENSE file included with this module.
391              
392             =cut