ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-Fork/Fork.pm
Revision: 1.15
Committed: Fri Apr 5 08:56:36 2013 UTC (11 years, 2 months ago) by root
Branch: MAIN
CVS Tags: rel-0_2
Changes since 1.14: +65 -9 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 =head1 NAME
2    
3 root 1.4 AnyEvent::Fork - everything you wanted to use fork() for, but couldn't
4 root 1.1
5     =head1 SYNOPSIS
6    
7 root 1.4 use AnyEvent::Fork;
8 root 1.1
9 root 1.9 ##################################################################
10     # create a single new process, tell it to run your worker function
11    
12     AnyEvent::Fork
13     ->new
14     ->require ("MyModule")
15     ->run ("MyModule::worker, sub {
16     my ($master_filehandle) = @_;
17    
18     # now $master_filehandle is connected to the
19     # $slave_filehandle in the new process.
20     });
21    
22     # MyModule::worker might look like this
23     sub MyModule::worker {
24     my ($slave_filehandle) = @_;
25    
26     # now $slave_filehandle is connected to the $master_filehandle
27     # in the original prorcess. have fun!
28     }
29    
30     ##################################################################
31     # create a pool of server processes all accepting on the same socket
32    
33     # create listener socket
34     my $listener = ...;
35    
36     # create a pool template, initialise it and give it the socket
37     my $pool = AnyEvent::Fork
38     ->new
39     ->require ("Some::Stuff", "My::Server")
40     ->send_fh ($listener);
41    
42     # now create 10 identical workers
43     for my $id (1..10) {
44     $pool
45     ->fork
46     ->send_arg ($id)
47     ->run ("My::Server::run");
48     }
49    
50     # now do other things - maybe use the filehandle provided by run
51     # to wait for the processes to die. or whatever.
52    
53     # My::Server::run might look like this
54     sub My::Server::run {
55     my ($slave, $listener, $id) = @_;
56    
57     close $slave; # we do not use the socket, so close it to save resources
58    
59     # we could go ballistic and use e.g. AnyEvent here, or IO::AIO,
60     # or anything we usually couldn't do in a process forked normally.
61     while (my $socket = $listener->accept) {
62     # do sth. with new socket
63     }
64     }
65    
66 root 1.1 =head1 DESCRIPTION
67    
68 root 1.4 This module allows you to create new processes, without actually forking
69     them from your current process (avoiding the problems of forking), but
70     preserving most of the advantages of fork.
71    
72     It can be used to create new worker processes or new independent
73     subprocesses for short- and long-running jobs, process pools (e.g. for use
74     in pre-forked servers) but also to spawn new external processes (such as
75     CGI scripts from a webserver), which can be faster (and more well behaved)
76     than using fork+exec in big processes.
77 root 1.1
78 root 1.5 Special care has been taken to make this module useful from other modules,
79     while still supporting specialised environments such as L<App::Staticperl>
80     or L<PAR::Packer>.
81    
82 root 1.1 =head1 PROBLEM STATEMENT
83    
84     There are two ways to implement parallel processing on UNIX like operating
85     systems - fork and process, and fork+exec and process. They have different
86     advantages and disadvantages that I describe below, together with how this
87     module tries to mitigate the disadvantages.
88    
89     =over 4
90    
91     =item Forking from a big process can be very slow (a 5GB process needs
92     0.05s to fork on my 3.6GHz amd64 GNU/Linux box for example). This overhead
93     is often shared with exec (because you have to fork first), but in some
94     circumstances (e.g. when vfork is used), fork+exec can be much faster.
95    
96     This module can help here by telling a small(er) helper process to fork,
97     or fork+exec instead.
98    
99     =item Forking usually creates a copy-on-write copy of the parent
100     process. Memory (for example, modules or data files that have been
101     will not take additional memory). When exec'ing a new process, modules
102     and data files might need to be loaded again, at extra cpu and memory
103     cost. Likewise when forking, all data structures are copied as well - if
104     the program frees them and replaces them by new data, the child processes
105     will retain the memory even if it isn't used.
106    
107     This module allows the main program to do a controlled fork, and allows
108     modules to exec processes safely at any time. When creating a custom
109     process pool you can take advantage of data sharing via fork without
110     risking to share large dynamic data structures that will blow up child
111     memory usage.
112    
113     =item Exec'ing a new perl process might be difficult and slow. For
114     example, it is not easy to find the correct path to the perl interpreter,
115     and all modules have to be loaded from disk again. Long running processes
116     might run into problems when perl is upgraded for example.
117    
118     This module supports creating pre-initialised perl processes to be used
119     as template, and also tries hard to identify the correct path to the perl
120     interpreter. With a cooperative main program, exec'ing the interpreter
121     might not even be necessary.
122    
123     =item Forking might be impossible when a program is running. For example,
124     POSIX makes it almost impossible to fork from a multithreaded program and
125     do anything useful in the child - strictly speaking, if your perl program
126     uses posix threads (even indirectly via e.g. L<IO::AIO> or L<threads>),
127     you cannot call fork on the perl level anymore, at all.
128    
129     This module can safely fork helper processes at any time, by caling
130     fork+exec in C, in a POSIX-compatible way.
131    
132     =item Parallel processing with fork might be inconvenient or difficult
133     to implement. For example, when a program uses an event loop and creates
134     watchers it becomes very hard to use the event loop from a child
135     program, as the watchers already exist but are only meaningful in the
136     parent. Worse, a module might want to use such a system, not knowing
137     whether another module or the main program also does, leading to problems.
138    
139     This module only lets the main program create pools by forking (because
140     only the main program can know when it is still safe to do so) - all other
141     pools are created by fork+exec, after which such modules can again be
142     loaded.
143    
144     =back
145    
146 root 1.3 =head1 CONCEPTS
147    
148     This module can create new processes either by executing a new perl
149     process, or by forking from an existing "template" process.
150    
151     Each such process comes with its own file handle that can be used to
152     communicate with it (it's actually a socket - one end in the new process,
153     one end in the main process), and among the things you can do in it are
154     load modules, fork new processes, send file handles to it, and execute
155     functions.
156    
157     There are multiple ways to create additional processes to execute some
158     jobs:
159    
160     =over 4
161    
162     =item fork a new process from the "default" template process, load code,
163     run it
164    
165     This module has a "default" template process which it executes when it is
166     needed the first time. Forking from this process shares the memory used
167     for the perl interpreter with the new process, but loading modules takes
168     time, and the memory is not shared with anything else.
169    
170     This is ideal for when you only need one extra process of a kind, with the
171     option of starting and stipping it on demand.
172    
173 root 1.9 Example:
174    
175     AnyEvent::Fork
176     ->new
177     ->require ("Some::Module")
178     ->run ("Some::Module::run", sub {
179     my ($fork_fh) = @_;
180     });
181    
182 root 1.3 =item fork a new template process, load code, then fork processes off of
183     it and run the code
184    
185     When you need to have a bunch of processes that all execute the same (or
186     very similar) tasks, then a good way is to create a new template process
187     for them, loading all the modules you need, and then create your worker
188     processes from this new template process.
189    
190     This way, all code (and data structures) that can be shared (e.g. the
191     modules you loaded) is shared between the processes, and each new process
192     consumes relatively little memory of its own.
193    
194     The disadvantage of this approach is that you need to create a template
195     process for the sole purpose of forking new processes from it, but if you
196     only need a fixed number of proceses you can create them, and then destroy
197     the template process.
198    
199 root 1.9 Example:
200    
201     my $template = AnyEvent::Fork->new->require ("Some::Module");
202    
203     for (1..10) {
204     $template->fork->run ("Some::Module::run", sub {
205     my ($fork_fh) = @_;
206     });
207     }
208    
209     # at this point, you can keep $template around to fork new processes
210     # later, or you can destroy it, which causes it to vanish.
211    
212 root 1.3 =item execute a new perl interpreter, load some code, run it
213    
214     This is relatively slow, and doesn't allow you to share memory between
215     multiple processes.
216    
217     The only advantage is that you don't have to have a template process
218     hanging around all the time to fork off some new processes, which might be
219     an advantage when there are long time spans where no extra processes are
220     needed.
221    
222 root 1.9 Example:
223    
224     AnyEvent::Fork
225     ->new_exec
226     ->require ("Some::Module")
227     ->run ("Some::Module::run", sub {
228     my ($fork_fh) = @_;
229     });
230    
231 root 1.3 =back
232    
233     =head1 FUNCTIONS
234    
235 root 1.1 =over 4
236    
237     =cut
238    
239 root 1.4 package AnyEvent::Fork;
240 root 1.1
241     use common::sense;
242    
243     use Socket ();
244    
245     use AnyEvent;
246     use AnyEvent::Util ();
247    
248 root 1.15 use IO::FDPass;
249    
250     our $VERSION = 0.2;
251 root 1.12
252 root 1.4 our $PERL; # the path to the perl interpreter, deduces with various forms of magic
253 root 1.1
254 root 1.4 =item my $pool = new AnyEvent::Fork key => value...
255 root 1.1
256     Create a new process pool. The following named parameters are supported:
257    
258     =over 4
259    
260     =back
261    
262     =cut
263    
264 root 1.5 # the early fork template process
265     our $EARLY;
266    
267 root 1.4 # the empty template process
268     our $TEMPLATE;
269    
270     sub _cmd {
271     my $self = shift;
272    
273 root 1.9 #TODO: maybe append the packet to any existing string command already in the queue
274    
275 root 1.4 # ideally, we would want to use "a (w/a)*" as format string, but perl versions
276 root 1.5 # from at least 5.8.9 to 5.16.3 are all buggy and can't unpack it.
277 root 1.11 push @{ $self->[2] }, pack "N/a*", pack "(w/a*)*", @_;
278 root 1.4
279     $self->[3] ||= AE::io $self->[1], 1, sub {
280 root 1.9 # send the next "thing" in the queue - either a reference to an fh,
281     # or a plain string.
282    
283 root 1.4 if (ref $self->[2][0]) {
284 root 1.9 # send fh
285 root 1.15 IO::FDPass::send fileno $self->[1], fileno ${ $self->[2][0] }
286 root 1.4 and shift @{ $self->[2] };
287 root 1.5
288 root 1.4 } else {
289 root 1.9 # send string
290 root 1.4 my $len = syswrite $self->[1], $self->[2][0]
291     or do { undef $self->[3]; die "AnyEvent::Fork: command write failure: $!" };
292 root 1.5
293 root 1.4 substr $self->[2][0], 0, $len, "";
294     shift @{ $self->[2] } unless length $self->[2][0];
295     }
296    
297     unless (@{ $self->[2] }) {
298     undef $self->[3];
299 root 1.9 # invoke run callback
300 root 1.4 $self->[0]->($self->[1]) if $self->[0];
301     }
302     };
303 root 1.14
304     () # make sure we don't leak the watcher
305 root 1.4 }
306 root 1.1
307 root 1.4 sub _new {
308     my ($self, $fh) = @_;
309 root 1.1
310 root 1.6 AnyEvent::Util::fh_nonblocking $fh, 1;
311    
312 root 1.4 $self = bless [
313     undef, # run callback
314 root 1.1 $fh,
315 root 1.4 [], # write queue - strings or fd's
316     undef, # AE watcher
317     ], $self;
318    
319     $self
320 root 1.1 }
321    
322 root 1.6 # fork template from current process, used by AnyEvent::Fork::Early/Template
323     sub _new_fork {
324     my ($fh, $slave) = AnyEvent::Util::portable_socketpair;
325 root 1.7 my $parent = $$;
326    
327 root 1.6 my $pid = fork;
328    
329     if ($pid eq 0) {
330     require AnyEvent::Fork::Serve;
331 root 1.7 $AnyEvent::Fork::Serve::OWNER = $parent;
332 root 1.6 close $fh;
333 root 1.7 $0 = "$_[1] of $parent";
334 root 1.6 AnyEvent::Fork::Serve::serve ($slave);
335 root 1.15 exit 0;
336 root 1.6 } elsif (!$pid) {
337     die "AnyEvent::Fork::Early/Template: unable to fork template process: $!";
338     }
339    
340     AnyEvent::Fork->_new ($fh)
341     }
342    
343 root 1.4 =item my $proc = new AnyEvent::Fork
344 root 1.1
345 root 1.4 Create a new "empty" perl interpreter process and returns its process
346     object for further manipulation.
347 root 1.1
348 root 1.4 The new process is forked from a template process that is kept around
349     for this purpose. When it doesn't exist yet, it is created by a call to
350     C<new_exec> and kept around for future calls.
351    
352 root 1.9 When the process object is destroyed, it will release the file handle
353     that connects it with the new process. When the new process has not yet
354     called C<run>, then the process will exit. Otherwise, what happens depends
355     entirely on the code that is executed.
356    
357 root 1.4 =cut
358    
359     sub new {
360     my $class = shift;
361 root 1.1
362 root 1.4 $TEMPLATE ||= $class->new_exec;
363     $TEMPLATE->fork
364 root 1.1 }
365    
366 root 1.4 =item $new_proc = $proc->fork
367    
368     Forks C<$proc>, creating a new process, and returns the process object
369     of the new process.
370    
371     If any of the C<send_> functions have been called before fork, then they
372     will be cloned in the child. For example, in a pre-forked server, you
373     might C<send_fh> the listening socket into the template process, and then
374     keep calling C<fork> and C<run>.
375    
376     =cut
377    
378     sub fork {
379     my ($self) = @_;
380 root 1.1
381     my ($fh, $slave) = AnyEvent::Util::portable_socketpair;
382 root 1.4
383     $self->send_fh ($slave);
384     $self->_cmd ("f");
385    
386     AnyEvent::Fork->_new ($fh)
387     }
388    
389     =item my $proc = new_exec AnyEvent::Fork
390    
391     Create a new "empty" perl interpreter process and returns its process
392     object for further manipulation.
393    
394     Unlike the C<new> method, this method I<always> spawns a new perl process
395     (except in some cases, see L<AnyEvent::Fork::Early> for details). This
396     reduces the amount of memory sharing that is possible, and is also slower.
397    
398     You should use C<new> whenever possible, except when having a template
399     process around is unacceptable.
400    
401     The path to the perl interpreter is divined usign various methods - first
402     C<$^X> is investigated to see if the path ends with something that sounds
403     as if it were the perl interpreter. Failing this, the module falls back to
404     using C<$Config::Config{perlpath}>.
405    
406     =cut
407    
408     sub new_exec {
409     my ($self) = @_;
410    
411 root 1.5 return $EARLY->fork
412     if $EARLY;
413    
414 root 1.4 # first find path of perl
415     my $perl = $;
416    
417     # first we try $^X, but the path must be absolute (always on win32), and end in sth.
418     # that looks like perl. this obviously only works for posix and win32
419     unless (
420 root 1.15 ($^O eq "MSWin32" || $perl =~ m%^/%)
421 root 1.4 && $perl =~ m%[/\\]perl(?:[0-9]+(\.[0-9]+)+)?(\.exe)?$%i
422     ) {
423     # if it doesn't look perlish enough, try Config
424     require Config;
425     $perl = $Config::Config{perlpath};
426     $perl =~ s/(?:\Q$Config::Config{_exe}\E)?$/$Config::Config{_exe}/;
427     }
428    
429     require Proc::FastSpawn;
430    
431     my ($fh, $slave) = AnyEvent::Util::portable_socketpair;
432     Proc::FastSpawn::fd_inherit (fileno $slave);
433    
434 root 1.10 # new fh's should always be set cloexec (due to $^F),
435     # but hey, not on win32, so we always clear the inherit flag.
436     Proc::FastSpawn::fd_inherit (fileno $fh, 0);
437    
438 root 1.4 # quick. also doesn't work in win32. of course. what did you expect
439     #local $ENV{PERL5LIB} = join ":", grep !ref, @INC;
440 root 1.1 my %env = %ENV;
441 root 1.15 $env{PERL5LIB} = join +($^O eq "MSWin32" ? ";" : ":"), grep !ref, @INC;
442 root 1.1
443 root 1.4 Proc::FastSpawn::spawn (
444     $perl,
445 root 1.7 ["perl", "-MAnyEvent::Fork::Serve", "-e", "AnyEvent::Fork::Serve::me", fileno $slave, $$],
446 root 1.4 [map "$_=$env{$_}", keys %env],
447     ) or die "unable to spawn AnyEvent::Fork server: $!";
448    
449     $self->_new ($fh)
450     }
451    
452 root 1.9 =item $proc = $proc->eval ($perlcode, @args)
453    
454     Evaluates the given C<$perlcode> as ... perl code, while setting C<@_> to
455     the strings specified by C<@args>.
456    
457     This call is meant to do any custom initialisation that might be required
458     (for example, the C<require> method uses it). It's not supposed to be used
459     to completely take over the process, use C<run> for that.
460    
461     The code will usually be executed after this call returns, and there is no
462     way to pass anything back to the calling process. Any evaluation errors
463     will be reported to stderr and cause the process to exit.
464    
465     Returns the process object for easy chaining of method calls.
466    
467     =cut
468    
469     sub eval {
470     my ($self, $code, @args) = @_;
471    
472     $self->_cmd (e => $code, @args);
473    
474     $self
475     }
476    
477 root 1.4 =item $proc = $proc->require ($module, ...)
478 root 1.1
479 root 1.9 Tries to load the given module(s) into the process
480 root 1.1
481 root 1.4 Returns the process object for easy chaining of method calls.
482 root 1.1
483 root 1.9 =cut
484    
485     sub require {
486     my ($self, @modules) = @_;
487    
488     s%::%/%g for @modules;
489     $self->eval ('require "$_.pm" for @_', @modules);
490    
491     $self
492     }
493    
494 root 1.4 =item $proc = $proc->send_fh ($handle, ...)
495 root 1.1
496 root 1.4 Send one or more file handles (I<not> file descriptors) to the process,
497     to prepare a call to C<run>.
498 root 1.1
499 root 1.4 The process object keeps a reference to the handles until this is done,
500     so you must not explicitly close the handles. This is most easily
501     accomplished by simply not storing the file handles anywhere after passing
502     them to this method.
503    
504     Returns the process object for easy chaining of method calls.
505    
506 root 1.9 Example: pass an fh to a process, and release it without closing. it will
507     be closed automatically when it is no longer used.
508    
509     $proc->send_fh ($my_fh);
510     undef $my_fh; # free the reference if you want, but DO NOT CLOSE IT
511    
512 root 1.4 =cut
513    
514     sub send_fh {
515     my ($self, @fh) = @_;
516    
517     for my $fh (@fh) {
518     $self->_cmd ("h");
519     push @{ $self->[2] }, \$fh;
520     }
521    
522     $self
523 root 1.1 }
524    
525 root 1.4 =item $proc = $proc->send_arg ($string, ...)
526    
527     Send one or more argument strings to the process, to prepare a call to
528     C<run>. The strings can be any octet string.
529    
530     Returns the process object for easy chaining of emthod calls.
531    
532     =cut
533 root 1.1
534 root 1.4 sub send_arg {
535     my ($self, @arg) = @_;
536 root 1.1
537 root 1.4 $self->_cmd (a => @arg);
538 root 1.1
539     $self
540     }
541    
542 root 1.4 =item $proc->run ($func, $cb->($fh))
543    
544     Enter the function specified by the fully qualified name in C<$func> in
545     the process. The function is called with the communication socket as first
546     argument, followed by all file handles and string arguments sent earlier
547     via C<send_fh> and C<send_arg> methods, in the order they were called.
548    
549     If the called function returns, the process exits.
550    
551     Preparing the process can take time - when the process is ready, the
552     callback is invoked with the local communications socket as argument.
553    
554     The process object becomes unusable on return from this function.
555    
556     If the communication socket isn't used, it should be closed on both sides,
557     to save on kernel memory.
558    
559     The socket is non-blocking in the parent, and blocking in the newly
560     created process. The close-on-exec flag is set on both. Even if not used
561     otherwise, the socket can be a good indicator for the existance of the
562 root 1.8 process - if the other process exits, you get a readable event on it,
563 root 1.4 because exiting the process closes the socket (if it didn't create any
564     children using fork).
565    
566 root 1.9 Example: create a template for a process pool, pass a few strings, some
567     file handles, then fork, pass one more string, and run some code.
568    
569     my $pool = AnyEvent::Fork
570     ->new
571     ->send_arg ("str1", "str2")
572     ->send_fh ($fh1, $fh2);
573    
574     for (1..2) {
575     $pool
576     ->fork
577     ->send_arg ("str3")
578     ->run ("Some::function", sub {
579     my ($fh) = @_;
580    
581     # fh is nonblocking, but we trust that the OS can accept these
582     # extra 3 octets anyway.
583     syswrite $fh, "hi #$_\n";
584    
585     # $fh is being closed here, as we don't store it anywhere
586     });
587     }
588    
589     # Some::function might look like this - all parameters passed before fork
590     # and after will be passed, in order, after the communications socket.
591     sub Some::function {
592     my ($fh, $str1, $str2, $fh1, $fh2, $str3) = @_;
593    
594     print scalar <$fh>; # prints "hi 1\n" and "hi 2\n"
595     }
596    
597 root 1.4 =cut
598    
599     sub run {
600     my ($self, $func, $cb) = @_;
601    
602     $self->[0] = $cb;
603 root 1.9 $self->_cmd (r => $func);
604 root 1.4 }
605    
606 root 1.1 =back
607    
608 root 1.15 =head1 TYPICAL PROBLEMS
609    
610     This section lists typical problems that remain. I hope by recognising
611     them, most can be avoided.
612    
613     =over 4
614    
615     =item "leaked" file descriptors for exec'ed processes
616    
617     POSIX systems inherit file descriptors by default when exec'ing a new
618     process. While perl itself laudably sets the close-on-exec flags on new
619     file handles, most C libraries don't care, and even if all cared, it's
620     often not possible to set the flag in a race-free manner.
621    
622     That means some file descriptors can leak through. And since it isn't
623     possible to know which file descriptors are "good" and "neccessary" (or
624     even to know which file descreiptors are open), there is no good way to
625     close the ones that might harm.
626    
627     As an example of what "harm" can be done consider a web server that
628     accepts connections and afterwards some module uses AnyEvent::Fork for the
629     first time, causing it to fork and exec a new process, which might inherit
630     the network socket. When the server closes the socket, it is still open
631     in the child (which doesn't even know that) and the client might conclude
632     that the connection is still fine.
633    
634     For the main program, there are multiple remedies available -
635     L<AnyEvent::Fork::Early> is one, creating a process early and not using
636     C<new_exec> is another, as in both cases, the first process can be exec'ed
637     well before many random file descriptors are open.
638    
639     In general, the solution for these kind of problems is to fix the
640     libraries or the code that leaks those file descriptors.
641    
642     Fortunately, most of these lekaed descriptors do no harm, other than
643     sitting on some resources.
644    
645     =item "leaked" file descriptors for fork'ed processes
646    
647     Normally, L<AnyEvent::Fork> does start new processes by exec'ing them,
648     which closes file descriptors not marked for being inherited.
649    
650     However, L<AnyEvent::Fork::Early> and L<AnyEvent::Fork::Template> offer
651     a way to create these processes by forking, and this leaks more file
652     descriptors than exec'ing them, as there is no way to mark descriptors as
653     "close on fork".
654    
655     An example would be modules like L<EV>, L<IO::AIO> or L<Gtk2>. Both create
656     pipes for internal uses, and L<Gtk2> might open a connection to the X
657     server. L<EV> and L<IO::AIO> can deal with fork, but Gtk2 might have
658     trouble with a fork.
659    
660     The solution is to either not load these modules before use'ing
661     L<AnyEvent::Fork::Early> or L<AnyEvent::Fork::Template>, or to delay
662     initialising them, for example, by calling C<init Gtk2> manually.
663    
664     =back
665    
666 root 1.8 =head1 PORTABILITY NOTES
667    
668 root 1.10 Native win32 perls are somewhat supported (AnyEvent::Fork::Early is a nop,
669     and ::Template is not going to work), and it cost a lot of blood and sweat
670     to make it so, mostly due to the bloody broken perl that nobody seems to
671     care about. The fork emulation is a bad joke - I have yet to see something
672     useful that you cna do with it without running into memory corruption
673     issues or other braindamage. Hrrrr.
674    
675     Cygwin perl is not supported at the moment, as it should implement fd
676     passing, but doesn't, and rolling my own is hard, as cygwin doesn't
677     support enough functionality to do it.
678 root 1.8
679 root 1.13 =head1 SEE ALSO
680    
681     L<AnyEvent::Fork::Early> (to avoid executing a perl interpreter),
682     L<AnyEvent::Fork::Template> (to create a process by forking the main
683     program at a convenient time).
684    
685 root 1.1 =head1 AUTHOR
686    
687     Marc Lehmann <schmorp@schmorp.de>
688     http://home.schmorp.de/
689    
690     =cut
691    
692     1
693