home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Reload.pm < prev    next >
Encoding:
Perl POD Document  |  2004-09-17  |  18.0 KB  |  583 lines
  1. # Copyright 2001-2004 The Apache Software Foundation
  2. #
  3. # Licensed under the Apache License, Version 2.0 (the "License");
  4. # you may not use this file except in compliance with the License.
  5. # You may obtain a copy of the License at
  6. #
  7. #     http://www.apache.org/licenses/LICENSE-2.0
  8. #
  9. # Unless required by applicable law or agreed to in writing, software
  10. # distributed under the License is distributed on an "AS IS" BASIS,
  11. # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  12. # See the License for the specific language governing permissions and
  13. # limitations under the License.
  14. #
  15. package Apache::Reload;
  16.  
  17. use strict;
  18. use warnings FATAL => 'all';
  19.  
  20. use mod_perl 1.99;
  21.  
  22. our $VERSION = '0.09';
  23.  
  24. use Apache::Const -compile => qw(OK);
  25.  
  26. use Apache::Connection;
  27. use Apache::ServerUtil;
  28. use Apache::RequestUtil;
  29.  
  30. use vars qw(%INCS %Stat $TouchTime %UndefFields);
  31.  
  32. %Stat = ($INC{"Apache/Reload.pm"} => time);
  33.  
  34. $TouchTime = time;
  35.  
  36. sub import {
  37.     my $class = shift;
  38.     my($package, $file) = (caller)[0,1];
  39.  
  40.     $class->register_module($package, $file);
  41. }
  42.  
  43. sub package_to_module {
  44.     my $package = shift;
  45.     $package =~ s/::/\//g;
  46.     $package .= ".pm";
  47.     return $package;
  48. }
  49.  
  50. sub register_module {
  51.     my($class, $package, $file) = @_;
  52.     my $module = package_to_module($package);
  53.  
  54.     if ($file) {
  55.         $INCS{$module} = $file;
  56.     }
  57.     else {
  58.         $file = $INC{$module};
  59.         return unless $file;
  60.         $INCS{$module} = $file;
  61.     }
  62.  
  63.     no strict 'refs';
  64.     if (%{"${package}::FIELDS"}) {
  65.         $UndefFields{$module} = "${package}::FIELDS";
  66.     }
  67. }
  68.  
  69. # the first argument is:
  70. # $c if invoked as 'PerlPreConnectionHandler'
  71. # $r if invoked as 'PerlInitHandler'
  72. sub handler {
  73.     my $o = shift;
  74.     $o = $o->base_server if ref($o) eq 'Apache::Connection';
  75.  
  76.     my $DEBUG = ref($o) && (lc($o->dir_config("ReloadDebug") || '') eq 'on');
  77.  
  78.     my $TouchFile = ref($o) && $o->dir_config("ReloadTouchFile");
  79.  
  80.     my $ConstantRedefineWarnings = ref($o) && 
  81.         (lc($o->dir_config("ReloadConstantRedefineWarnings") || '') eq 'off') 
  82.             ? 0 : 1;
  83.  
  84.     my $TouchModules;
  85.  
  86.     if ($TouchFile) {
  87.         warn "Checking mtime of $TouchFile\n" if $DEBUG;
  88.         my $touch_mtime = (stat $TouchFile)[9] || return 1;
  89.         return 1 unless $touch_mtime > $TouchTime;
  90.         $TouchTime = $touch_mtime;
  91.         open my $fh, $TouchFile or die "Can't open '$TouchFile': $!";
  92.         $TouchModules = <$fh>;
  93.         chomp $TouchModules if $TouchModules;
  94.     }
  95.  
  96.     if (ref($o) && (lc($o->dir_config("ReloadAll") || 'on') eq 'on')) {
  97.         *Apache::Reload::INCS = \%INC;
  98.     }
  99.     else {
  100.         *Apache::Reload::INCS = \%INCS;
  101.         my $ExtraList = 
  102.                 $TouchModules || 
  103.                 (ref($o) && $o->dir_config("ReloadModules")) || 
  104.                 '';
  105.         my @extra = split /\s+/, $ExtraList;
  106.         foreach (@extra) {
  107.             if (/(.*)::\*$/) {
  108.                 my $prefix = $1;
  109.                 $prefix =~ s/::/\//g;
  110.                 foreach my $match (keys %INC) {
  111.                     if ($match =~ /^\Q$prefix\E/) {
  112.                         $Apache::Reload::INCS{$match} = $INC{$match};
  113.                         my $package = $match;
  114.                         $package =~ s/\//::/g;
  115.                         $package =~ s/\.pm$//;
  116.                         no strict 'refs';
  117. #                        warn "checking for FIELDS on $package\n";
  118.                         if (%{"${package}::FIELDS"}) {
  119. #                            warn "found fields in $package\n";
  120.                             $UndefFields{$match} = "${package}::FIELDS";
  121.                         }
  122.                     }
  123.                 }
  124.             }
  125.             else {
  126.                 Apache::Reload->register_module($_);
  127.             }
  128.         }
  129.     }
  130.  
  131.     my $ReloadDirs = ref($o) && $o->dir_config("ReloadDirectories");
  132.     my @watch_dirs = split(/\s+/, $ReloadDirs||'');
  133.     while (my($key, $file) = each %Apache::Reload::INCS) {
  134.         next unless defined $file;
  135.         next if @watch_dirs && !grep { $file =~ /^$_/ } @watch_dirs;
  136.         warn "Apache::Reload: Checking mtime of $key\n" if $DEBUG;
  137.  
  138.         my $mtime = (stat $file)[9];
  139.  
  140.         unless (defined($mtime) && $mtime) {
  141.             for (@INC) {
  142.                 $mtime = (stat "$_/$file")[9];
  143.                 last if defined($mtime) && $mtime;
  144.             }
  145.         }
  146.  
  147.         warn("Apache::Reload: Can't locate $file\n"), next
  148.             unless defined $mtime and $mtime;
  149.  
  150.         unless (defined $Stat{$file}) {
  151.             $Stat{$file} = $^T;
  152.         }
  153.  
  154.         if ($mtime > $Stat{$file}) {
  155.             delete $INC{$key};
  156. #           warn "Reloading $key\n";
  157.             if (my $symref = $UndefFields{$key}) {
  158. #                warn "undeffing fields\n";
  159.                 no strict 'refs';
  160.                 undef %{$symref};
  161.             }
  162.             no warnings FATAL => 'all';
  163.             local $SIG{__WARN__} = \&skip_redefine_const_sub_warn
  164.                 unless $ConstantRedefineWarnings;
  165.             require $key;
  166.             warn("Apache::Reload: process $$ reloading $key\n")
  167.                     if $DEBUG;
  168.         }
  169.         $Stat{$file} = $mtime;
  170.     }
  171.  
  172.     return Apache::OK;
  173. }
  174.  
  175. sub skip_redefine_const_sub_warn {
  176.     return if $_[0] =~ /^Constant subroutine [\w:]+ redefined at/;
  177.     CORE::warn(@_);
  178. }
  179.  
  180. 1;
  181. __END__
  182.  
  183. =head1 NAME
  184.  
  185. Apache::Reload - Reload Perl Modules when Changed on Disk
  186.  
  187. =head1 Synopsis
  188.  
  189.   # Monitor and reload all modules in %INC:
  190.   # httpd.conf:
  191.   PerlModule Apache::Reload
  192.   PerlInitHandler Apache::Reload
  193.  
  194.   # when working with protocols and connection filters
  195.   # PerlPreConnectionHandler Apache::Reload
  196.  
  197.   # Reload groups of modules:
  198.   # httpd.conf:
  199.   PerlModule Apache::Reload
  200.   PerlInitHandler Apache::Reload
  201.   PerlSetVar ReloadAll Off
  202.   PerlSetVar ReloadModules "ModPerl::* Apache::*"
  203.   #PerlSetVar ReloadDebug On
  204.   #PerlSetVar ReloadConstantRedefineWarnings Off
  205.   
  206.   # Reload a single module from within itself:
  207.   package My::Apache::Module;
  208.   use Apache::Reload;
  209.   sub handler { ... }
  210.   1;
  211.  
  212. =head1 Description
  213.  
  214. C<Apache::Reload> reloads modules that change on the disk.
  215.  
  216. When Perl pulls a file via C<require>, it stores the filename in the
  217. global hash C<%INC>.  The next time Perl tries to C<require> the same
  218. file, it sees the file in C<%INC> and does not reload from disk.  This
  219. module's handler can be configured to iterate over the modules in
  220. C<%INC> and reload those that have changed on disk or only specific
  221. modules that have registered themselves with C<Apache::Reload>. It can
  222. also do the check for modified modules, when a special touch-file has
  223. been modified.
  224.  
  225. Note that C<Apache::Reload> operates on the current context of
  226. C<@INC>.  Which means, when called as a C<Perl*Handler> it will not
  227. see C<@INC> paths added or removed by C<Apache::Registry> scripts, as
  228. the value of C<@INC> is saved on server startup and restored to that
  229. value after each request.  In other words, if you want
  230. C<Apache::Reload> to work with modules that live in custom C<@INC>
  231. paths, you should modify C<@INC> when the server is started.  Besides,
  232. C<'use lib'> in the startup script, you can also set the C<PERL5LIB>
  233. variable in the httpd's environment to include any non-standard 'lib'
  234. directories that you choose.  For example, to accomplish that you can
  235. include a line:
  236.  
  237.   PERL5LIB=/home/httpd/perl/extra; export PERL5LIB
  238.  
  239. in the script that starts Apache. Alternatively, you can set this
  240. environment variable in I<httpd.conf>:
  241.  
  242.   PerlSetEnv PERL5LIB /home/httpd/perl/extra
  243.  
  244. =head2 Monitor All Modules in C<%INC>
  245.  
  246. To monitor and reload all modules in C<%INC> at the beginning of
  247. request's processing, simply add the following configuration to your
  248. I<httpd.conf>:
  249.  
  250.   PerlModule Apache::Reload
  251.   PerlInitHandler Apache::Reload
  252.  
  253. When working with connection filters and protocol modules
  254. C<Apache::Reload> should be invoked in the pre_connection stage:
  255.  
  256.   PerlPreConnectionHandler Apache::Reload
  257.  
  258. See also the discussion on
  259. C<L<PerlPreConnectionHandler|docs::2.0::user::handlers::protocols/PerlPreConnectionHandler>>.
  260.  
  261. =head2 Register Modules Implicitly
  262.  
  263. To only reload modules that have registered with C<Apache::Reload>,
  264. add the following to the I<httpd.conf>:
  265.  
  266.   PerlModule Apache::Reload
  267.   PerlInitHandler Apache::Reload
  268.   PerlSetVar ReloadAll Off
  269.   # ReloadAll defaults to On
  270.  
  271. Then any modules with the line:
  272.  
  273.   use Apache::Reload;
  274.  
  275. Will be reloaded when they change.
  276.  
  277. =head2 Register Modules Explicitly
  278.  
  279. You can also register modules explicitly in your I<httpd.conf> file
  280. that you want to be reloaded on change:
  281.  
  282.   PerlModule Apache::Reload
  283.   PerlInitHandler Apache::Reload
  284.   PerlSetVar ReloadAll Off
  285.   PerlSetVar ReloadModules "My::Foo My::Bar Foo::Bar::Test"
  286.  
  287. Note that these are split on whitespace, but the module list B<must>
  288. be in quotes, otherwise Apache tries to parse the parameter list.
  289.  
  290. The C<*> wild character can be used to register groups of files under
  291. the same namespace. For example the setting:
  292.  
  293.   PerlSetVar ReloadModules "ModPerl::* Apache::*"
  294.  
  295. will monitor all modules under the namespaces C<ModPerl::> and
  296. C<Apache::>.
  297.  
  298. =head2 Monitor Only Certain Sub Directories
  299.  
  300. To reload modules only in certain directories (and their
  301. subdirectories) add the following to the I<httpd.conf>:
  302.  
  303.   PerlModule Apache::Reload
  304.   PerlInitHandler Apache::Reload
  305.   PerlSetVar ReloadDirectories "/tmp/project1 /tmp/project2"
  306.  
  307. You can further narrow the list of modules to be reloaded from the
  308. chosen directories with C<ReloadModules> as in:
  309.  
  310.   PerlModule Apache::Reload
  311.   PerlInitHandler Apache::Reload
  312.   PerlSetVar ReloadDirectories "/tmp/project1 /tmp/project2"
  313.   PerlSetVar ReloadAll Off
  314.   PerlSetVar ReloadModules "MyApache::*"
  315.  
  316. In this configuration example only modules from the namespace
  317. C<MyApache::> found in the directories I</tmp/project1/> and
  318. I</tmp/project2/> (and their subdirectories) will be reloaded.
  319.  
  320. =head2 Special "Touch" File
  321.  
  322. You can also declare a file, which when gets C<touch(1)>ed, causes the
  323. reloads to be performed. For example if you set:
  324.  
  325.   PerlSetVar ReloadTouchFile /tmp/reload_modules
  326.  
  327. and don't C<touch(1)> the file I</tmp/reload_modules>, the reloads
  328. won't happen until you go to the command line and type:
  329.  
  330.   % touch /tmp/reload_modules
  331.  
  332. When you do that, the modules that have been changed, will be
  333. magically reloaded on the next request. This option works with any
  334. mode described before.
  335.  
  336. =head1 Performance Issues
  337.  
  338. This modules is perfectly suited for a development environment. Though
  339. it's possible that you would like to use it in a production
  340. environment, since with C<Apache::Reload> you don't have to restart
  341. the server in order to reload changed modules during software
  342. updates. Though this convenience comes at a price:
  343.  
  344. =over
  345.  
  346. =item *
  347.  
  348. If the "touch" file feature is used, C<Apache::Reload> has to stat(2)
  349. the touch file on each request, which adds a slight but most likely
  350. insignificant overhead to response times. Otherwise C<Apache::Reload>
  351. will stat(2) each registered module or even worse--all modules in
  352. C<%INC>, which will significantly slow everything down.
  353.  
  354. =item *
  355.  
  356. Once the child process reloads the modules, the memory used by these
  357. modules is not shared with the parent process anymore. Therefore the
  358. memory consumption may grow significantly.
  359.  
  360. =back
  361.  
  362. Therefore doing a full server stop and restart is probably a better
  363. solution.
  364.  
  365. =head1 Debug
  366.  
  367. If you aren't sure whether the modules that are supposed to be
  368. reloaded, are actually getting reloaded, turn the debug mode on:
  369.  
  370.   PerlSetVar ReloadDebug On
  371.  
  372. =head1 Silencing 'Constant subroutine ... redefined at' Warnings
  373.  
  374. If a module defines constants, e.g.:
  375.  
  376.   use constant PI => 3.14;
  377.  
  378. and gets re-loaded, Perl issues a mandatory warnings which can't be
  379. silenced by conventional means (since Perl 5.8.0). This is because
  380. constants are inlined at compile time, so if there are other modules
  381. that are using constants from this module, but weren't reloaded they
  382. will see different values. Hence the warning is mandatory. However
  383. chances are that most of the time you won't modify the constant
  384. subroutine and you don't want I<error_log> to be cluttered with
  385. (hopefully) irrelevant warnings. In such cases, if you haven't
  386. modified the constant subroutine, or you know what you are doing, you
  387. can tell C<Apache::Reload> to shut those for you (it overrides
  388. C<$SIG{__WARN__}> to accomplish that):
  389.  
  390.   PerlSetVar ReloadConstantRedefineWarnings Off
  391.  
  392. For the reasons explained above this option is turned on by default.
  393.  
  394. since: mod_perl 1.99_10
  395.  
  396. =head1 Caveats
  397.  
  398. =head2 Problems With Reloading Modules Which Do Not Declare Their Package Name
  399.  
  400. If you modify modules, which don't declare their C<package>, and rely on
  401. C<Apache::Reload> to reload them, you may encounter problems: i.e.,
  402. it'll appear as if the module wasn't reloaded when in fact it
  403. was. This happens because when C<Apache::Reload> C<require()>s such a
  404. module all the global symbols end up in the C<Apache::Reload>
  405. namespace!  So the module does get reloaded and you see the compile
  406. time errors if there are any, but the symbols don't get imported to
  407. the right namespace. Therefore the old version of the code is running.
  408.  
  409.  
  410. =head2 Failing to Find a File to Reload
  411.  
  412. C<Apache::Reload> uses C<%INC> to find the files on the filesystem. If
  413. an entry for a certain filepath in C<%INC> is relative,
  414. C<Apache::Reload> will use C<@INC> to try to resolve that relative
  415. path. Now remember that mod_perl freezes the value of C<@INC> at the
  416. server startup, and you can modify it only for the duration of one
  417. request when you need to load some module which is not in on of the
  418. C<@INC> directories. So a module gets loaded, and registered in
  419. C<%INC> with a relative path. Now when C<Apache::Reload> tries to find
  420. that module to check whether it has been modified, it can't find since
  421. its directory is not in C<@INC>. So C<Apache::Reload> will silently
  422. skip that module.
  423.  
  424. You can enable the C<Debug|/Debug> mode to see what C<Apache::Reload>
  425. does behind the scenes.
  426.  
  427.  
  428.  
  429. =head2 Problems with Scripts Running with Registry Handlers that Cache the Code
  430.  
  431. The following problem is relevant only to registry handlers that cache
  432. the compiled script. For example it concerns
  433. C<L<ModPerl::Registry|docs::2.0::api::ModPerl::Registry>> but not
  434. C<L<ModPerl::PerlRun|docs::2.0::api::ModPerl::PerlRun>>.
  435.  
  436. =head3 The Problem
  437.  
  438. Let's say that there is a module C<My::Utils>:
  439.  
  440.   #file:My/Utils.pm
  441.   #----------------
  442.   package My::Utils;
  443.   BEGIN { warn __PACKAGE__ , " was reloaded\n" }
  444.   use base qw(Exporter);
  445.   @EXPORT = qw(colour);
  446.   sub colour { "white" }
  447.   1;
  448.  
  449. And a registry script F<test.pl>:
  450.  
  451.   #file:test.pl
  452.   #------------
  453.   use My::Utils;
  454.   print "Content-type: text/plain\n\n";
  455.   print "the color is " . colour();
  456.  
  457. Assuming that the server is running in a single mode, we request the
  458. script for the first time and we get the response:
  459.  
  460.   the color is white
  461.  
  462. Now we change F<My/Utils.pm>:
  463.  
  464.   -  sub colour { "white" }
  465.   +  sub colour { "red" }
  466.  
  467. And issue the request again. C<Apache::Reload> does its job and we can
  468. see that C<My::Utils> was reloaded (look in the I<error_log>
  469. file). However the script still returns:
  470.  
  471.   the color is white
  472.  
  473. =head3 The Explanation
  474.  
  475. Even though F<My/Utils.pm> was reloaded, C<ModPerl::Registry>'s cached
  476. code won't run 'C<use My::Utils;>' again (since it happens only once,
  477. i.e. during the compile time). Therefore the script doesn't know that
  478. the subroutine reference has been changed.
  479.  
  480. This is easy to verify. Let's change the script to be:
  481.  
  482.   #file:test.pl
  483.   #------------
  484.   use My::Utils;
  485.   print "Content-type: text/plain\n\n";
  486.   my $sub_int = \&colour;
  487.   my $sub_ext = \&My::Utils::colour;
  488.   print "int $sub_int\n";
  489.   print "ext $sub_ext\n";
  490.  
  491. Issue a request, you will see something similar to:
  492.  
  493.   int CODE(0x8510af8)
  494.   ext CODE(0x8510af8)
  495.  
  496. As you can see both point to the same CODE reference (meaning that
  497. it's the same symbol). After modifying F<My/Utils.pm> again:
  498.  
  499.   -  sub colour { "red" }
  500.   +  sub colour { "blue" }
  501.  
  502. and calling the script on the secondnd time, we get:
  503.  
  504.   int CODE(0x8510af8)
  505.   ext CODE(0x851112c)
  506.  
  507. You can see that the internal CODE reference is not the same as the
  508. external one.
  509.  
  510. =head3 The Solution
  511.  
  512. There are two solutions to this problem:
  513.  
  514. Solution 1: replace C<use()> with an explicit C<require()> +
  515. C<import()>.
  516.  
  517.  - use My::Utils;
  518.  + require My::Utils; My::Utils->import();
  519.  
  520. now the changed functions will be reimported on every request.
  521.  
  522. Solution 2: remember to touch the script itself every time you change
  523. the module that it requires.
  524.  
  525. =head1 Threaded MPM and Multiple Perl Interpreters
  526.  
  527. If you use C<Apache::Reload> with a threaded MPM and multiple Perl
  528. interpreters, the modules will be reloaded by each interpreter as they
  529. are used, not every interpreters at once.  Similar to mod_perl 1.0
  530. where each child has its own Perl interpreter, the modules are
  531. reloaded as each child is hit with a request.
  532.  
  533. If a module is loaded at startup, the syntax tree of each subroutine
  534. is shared between interpreters (big win), but each subroutine has its
  535. own padlist (where lexical my variables are stored).  Once
  536. C<Apache::Reload> reloads a module, this sharing goes away and each
  537. Perl interpreter will have its own copy of the syntax tree for the
  538. reloaded subroutines.
  539.  
  540.  
  541. =head1 Pseudo-hashes
  542.  
  543. The short summary of this is: Don't use pseudo-hashes. They are
  544. deprecated since Perl 5.8 and are removed in 5.9.
  545.  
  546. Use an array with constant indexes. Its faster in the general case,
  547. its more guaranteed, and generally, it works.
  548.  
  549. The long summary is that some work has been done to get this module
  550. working with modules that use pseudo-hashes, but it's still broken in
  551. the case of a single module that contains multiple packages that all
  552. use pseudo-hashes.
  553.  
  554. So don't do that.
  555.  
  556.  
  557.  
  558.  
  559. =head1 Copyright
  560.  
  561. mod_perl 2.0 and its core modules are copyrighted under
  562. The Apache Software License, Version 2.0.
  563.  
  564.  
  565. =head1 Authors
  566.  
  567. Matt Sergeant, matt@sergeant.org
  568.  
  569. Stas Bekman (porting to mod_perl 2.0)
  570.  
  571. A few concepts borrowed from C<Stonehenge::Reload> by Randal Schwartz
  572. and C<Apache::StatINC> (mod_perl 1.x) by Doug MacEachern and Ask
  573. Bjoern Hansen.
  574.  
  575.  
  576.  
  577. =head1 See Also
  578.  
  579. C<Stonehenge::Reload>
  580.  
  581. =cut
  582.  
  583.