perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Fred Moyer <f...@taperfriendlymusic.org>
Subject [patch] Apache::Reload work from Apachecon
Date Thu, 06 Dec 2007 20:59:24 GMT
Greetings,

I have attached the work completed for Apache::Reload up to this point. 
  A great deal of progress was made at ApacheCon thanks to help from 
Gozer, Geoff, and others.

There are some files that I will need to 'svn mv' from mp core and then 
modify, but this diff is the bulk of what I plan to commit.

Comments welcome.  One note, because Apache2::Reload is v0.9 in core, 
and Apache::Reload is v0.8, I have marked this version 0.10 to avoid any 
issues installing, see Changes for details.

If all goes well I hope to have this released to CPAN by the end of the 
month.

- Fred


Index: RELEASE
===================================================================
--- RELEASE	(revision 558376)
+++ RELEASE	(working copy)
@@ -40,8 +40,8 @@

    a. edit ./Changes:
       - find lib -type f -name "*.pm" | \
-         xargs perl -pi -e 's,0.08-dev,0.08-rc1,g'
-     - perl -pi -e 's,0.08-dev,0.08-rc1,g' Changes
+         xargs perl -pi -e 's,0.10-dev,0.10-rc1,g'
+     - perl -pi -e 's,0.10-dev,0.10-rc1,g' Changes

       - don't commit these (see dev@ archives)

@@ -60,7 +60,7 @@
       o dev/perl.apache.org
       o modperl/perl.apache.org

-  Subject: [RELEASE CANDIDATE] Apache-Reload 0.08 RC\d+
+  Subject: [RELEASE CANDIDATE] Apache-Reload 0.10 RC\d+

     (or maybe longer to give most people a chance to catch up). no need
     to tag this package
@@ -95,7 +95,7 @@
  5. Announce the package

    a. post ... to the modperl, announce lists
-  Subject: [ANNOUNCE] Apache-Reload 0.08
+  Subject: [ANNOUNCE] Apache-Reload 0.10
       include
    - MD5 sig (as it comes from CPAN upload announce).
    - the latest Changes
@@ -107,7 +107,7 @@
    b. edit ./Changes:
       - start a new item with incremented version + '-dev'

-  =item 0.92-dev
+  =item 0.11-dev

    c. bump up version numbers in this file to make it easier to do the
       next release.
@@ -115,4 +115,4 @@
       $ perl -pi -e 's/(\d+)\.(\d+)/join(".", $1, $2+1)/eg' RELEASE

    d. commit Changes
-     % svn ci -m "start 0.92-dev cycle" Changes RELEASE 
lib/Apache/Reload.pm
+     % svn ci -m "start 0.11-dev cycle" Changes RELEASE 
lib/Apache/Reload.pm
Index: t/conf/extra.last.conf.in
===================================================================
--- t/conf/extra.last.conf.in	(revision 0)
+++ t/conf/extra.last.conf.in	(revision 0)
@@ -0,0 +1,22 @@
+<IfModule mod_perl.c>
+    <IfDefine APACHE2>
+        PerlModule Apache2::Reload
+        PerlModule Apache2::TestReload
+    </IfDefine>
+    <IfDefine APACHE1>
+        PerlModule Apache::Reload
+        PerlModule Apache::TestReload
+    </IfDefine>
+    </IfDefine>
+    <Location /reload>
+        SetHandler perl-script
+        <IfDefine APACHE2>
+            PerlInitHandler Apache2::Reload
+            PerlResponseHandler Apache2::TestReload
+        </IfDefine>
+        <IfDefine APACHE1>
+            PerlInitHandler Apache::Reload
+            PerlHandler Apache::TestReload
+        </IfDefine>
+    </Location>
+</IfModule>
Index: t/lib/Apache/TestReload.pm
===================================================================
--- t/lib/Apache/TestReload.pm	(revision 0)
+++ t/lib/Apache/TestReload.pm	(revision 0)
@@ -0,0 +1,44 @@
+package Apache::TestReload;
+
+use strict;
+use warnings FATAL => 'all';
+
+#use ModPerl::Util ();
+use Apache::Constants qw(:common);
+
+my $package = 'Reload::Test';
+
+our $pass = 0;
+
+sub handler {
+    my $r = shift;
+    $pass++;
+    $r->send_http_header('text/plain');
+    if ((defined ($r->args)) && ($r->args eq 'last')) {
+        #Apache2::Reload->unregister_module($package);
+        #ModPerl::Util::unload_package($package);
+        $pass = 0;
+        $r->print("unregistered OK");
+        return OK;
+    }
+
+    eval "require $package";
+
+    Reload::Test::run($r);
+
+    return OK;
+}
+
+# This one shouldn't be touched
+package Reload::Test::SubPackage;
+
+sub subpackage {
+    if ($Apache::TestReload::pass == '2') {
+        return 'SUBPACKAGE';
+    }
+    else {
+        return 'subpackage';
+    }
+}
+
+1;
Index: t/lib/Apache2/TestReload.pm
===================================================================
--- t/lib/Apache2/TestReload.pm	(revision 0)
+++ t/lib/Apache2/TestReload.pm	(revision 0)
@@ -0,0 +1,45 @@
+package Apache2::TestReload;
+
+use strict;
+use warnings FATAL => 'all';
+
+use ModPerl::Util ();
+use Apache2::RequestRec ();
+use Apache2::Const -compile => qw(OK);
+use Apache2::RequestIO ();
+
+my $package = 'Reload::Test';
+
+our $pass = 0;
+
+sub handler {
+    my $r = shift;
+    $pass++;
+    if ($r->args eq 'last') {
+        Apache2::Reload->unregister_module($package);
+        ModPerl::Util::unload_package($package);
+        $pass = 0;
+        $r->print("unregistered OK");
+        return Apache2::Const::OK;
+    }
+
+    eval "require $package";
+
+    Reload::Test::run($r);
+
+    return Apache2::Const::OK;
+}
+
+# This one shouldn't be touched
+package Reload::Test::SubPackage;
+
+sub subpackage {
+    if ($Apache2::TestReload::pass == '2') {
+        return 'SUBPACKAGE';
+    }
+    else {
+        return 'subpackage';
+    }
+}
+
+1;
Index: t/reload.t
===================================================================
--- t/reload.t	(revision 0)
+++ t/reload.t	(revision 0)
@@ -0,0 +1,70 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+use File::Spec::Functions qw(catfile tmpdir);
+
+Apache::TestRequest::user_agent(keep_alive => 1);
+
+plan tests => 3, need 'HTML::HeadParser';
+
+my $test_file = catfile qw(Reload Test.pm);
+
+my $location = '/reload';
+
+my @tests = qw(const prototype simple subpackage);
+
+my $header = join '', <DATA>;
+
+my $initial = <<'EOF';
+sub simple { 'simple' }
+use constant const => 'const';
+sub prototype($) { 'prototype' }
+sub promised;
+EOF
+
+my $modified = <<'EOF';
+sub simple { 'SIMPLE' }
+use constant const => 'CONST';
+sub prototype($$) { 'PROTOTYPE' }
+EOF
+
+t_write_test_lib($test_file, $header, $initial);
+
+{
+    my $expected = join '', map { "$_:$_\n" } sort @tests;
+    my $received = GET $location;
+    ok t_cmp($received->content, $expected, 'Initial');
+}
+
+t_write_test_lib($test_file, $header, $modified);
+
+{
+    my $expected = join '', map { "$_:" . uc($_) . "\n" } sort @tests;
+    my $received = GET $location;
+    ok t_cmp($received->content, $expected, 'Reload');
+}
+
+{
+    my $expected = "unregistered OK";
+    my $received = GET "$location?last";
+    ok t_cmp($received->content, $expected, 'Unregister');
+}
+
+__DATA__
+package Reload::Test;
+
+our @methods = qw(const prototype simple subpackage);
+
+sub subpackage { return Reload::Test::SubPackage::subpackage() }
+
+sub run {
+    my $r = shift;
+    foreach my $m (sort @methods) {
+        $r->print($m, ':', __PACKAGE__->$m(), "\n");
+    }
+}
+
+1;
Index: lib/Apache/Reload.pm
===================================================================
--- lib/Apache/Reload.pm	(revision 558376)
+++ lib/Apache/Reload.pm	(working copy)
@@ -17,7 +17,7 @@

  use strict;

-$Apache::Reload::VERSION = '0.08';
+$Apache::Reload::VERSION = '0.10';

  use vars qw(%INCS %Stat $TouchTime %UndefFields);

@@ -262,6 +262,10 @@

  Matt Sergeant, matt@sergeant.org

+=head1 MAINTAINERS
+
+the mod_perl developers, dev@perl.apache.org
+
  =head1 SEE ALSO

  Apache::StatINC, Stonehenge::Reload
Index: lib/Apache2/Reload.pm
===================================================================
--- lib/Apache2/Reload.pm	(revision 0)
+++ lib/Apache2/Reload.pm	(revision 0)
@@ -0,0 +1,297 @@
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements.  See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License.  You may obtain a copy of the License at
+#
+#     http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+package Apache2::Reload;
+
+use strict;
+use warnings FATAL => 'all';
+
+use mod_perl2;
+
+our $VERSION = '0.10';
+
+use Apache2::Const -compile => qw(OK);
+
+use Apache2::Connection;
+use Apache2::ServerUtil;
+use Apache2::RequestUtil;
+
+use ModPerl::Util ();
+
+use vars qw(%INCS %Stat $TouchTime);
+
+%Stat = ($INC{"Apache2/Reload.pm"} => time);
+
+$TouchTime = time;
+
+sub import {
+    my $class = shift;
+    my ($package, $file) = (caller)[0,1];
+
+    $class->register_module($package, $file);
+}
+
+sub package_to_module {
+    my $package = shift;
+    $package =~ s/::/\//g;
+    $package .= ".pm";
+    return $package;
+}
+
+sub module_to_package {
+    my $module = shift;
+    $module =~ s/\//::/g;
+    $module =~ s/\.pm$//g;
+    return $module;
+}
+
+sub register_module {
+    my ($class, $package, $file) = @_;
+    my $module = package_to_module($package);
+
+    if ($file) {
+        $INCS{$module} = $file;
+    }
+    else {
+        $file = $INC{$module};
+        return unless $file;
+        $INCS{$module} = $file;
+    }
+}
+
+sub unregister_module {
+    my ($class, $package) = @_;
+    my $module = package_to_module($package);
+    delete $INCS{$module};
+}
+
+# the first argument is:
+# $c if invoked as 'PerlPreConnectionHandler'
+# $r if invoked as 'PerlInitHandler'
+sub handler {
+    my $o = shift;
+    $o = $o->base_server if ref($o) eq 'Apache2::Connection';
+
+    my $DEBUG = ref($o) && (lc($o->dir_config("ReloadDebug") || '') eq 
'on');
+
+    my $TouchFile = ref($o) && $o->dir_config("ReloadTouchFile");
+
+    my $ConstantRedefineWarnings = ref($o) &&
+        (lc($o->dir_config("ReloadConstantRedefineWarnings") || '') eq 
'off')
+            ? 0 : 1;
+
+    my $TouchModules;
+
+    if ($TouchFile) {
+        warn "Checking mtime of $TouchFile\n" if $DEBUG;
+        my $touch_mtime = (stat $TouchFile)[9] || return 
Apache2::Const::OK;
+        return Apache2::Const::OK unless $touch_mtime > $TouchTime;
+        $TouchTime = $touch_mtime;
+        open my $fh, $TouchFile or die "Can't open '$TouchFile': $!";
+        $TouchModules = <$fh>;
+        chomp $TouchModules if $TouchModules;
+    }
+
+    if (ref($o) && (lc($o->dir_config("ReloadAll") || 'on') eq 'on')) {
+        *Apache2::Reload::INCS = \%INC;
+    }
+    else {
+        *Apache2::Reload::INCS = \%INCS;
+        my $ExtraList =
+                $TouchModules ||
+                (ref($o) && $o->dir_config("ReloadModules")) ||
+                '';
+        my @extra = split /\s+/, $ExtraList;
+        foreach (@extra) {
+            if (/(.*)::\*$/) {
+                my $prefix = $1;
+                $prefix =~ s/::/\//g;
+                foreach my $match (keys %INC) {
+                    if ($match =~ /^\Q$prefix\E/) {
+                        $Apache2::Reload::INCS{$match} = $INC{$match};
+                    }
+                }
+            }
+            else {
+                Apache2::Reload->register_module($_);
+            }
+        }
+    }
+
+    my $ReloadDirs = ref($o) && $o->dir_config("ReloadDirectories");
+    my @watch_dirs = split(/\s+/, $ReloadDirs||'');
+
+    my @changed;
+    foreach my $key (sort { $a cmp $b } keys %Apache2::Reload::INCS) {
+        my $file = $Apache2::Reload::INCS{$key};
+
+        next unless defined $file;
+        next if @watch_dirs && !grep { $file =~ /^$_/ } @watch_dirs;
+        warn "Apache2::Reload: Checking mtime of $key\n" if $DEBUG;
+
+        my $mtime = (stat $file)[9];
+
+        unless (defined($mtime) && $mtime) {
+            for (@INC) {
+                $mtime = (stat "$_/$file")[9];
+                last if defined($mtime) && $mtime;
+            }
+        }
+
+        warn("Apache2::Reload: Can't locate $file\n"), next
+            unless defined $mtime and $mtime;
+
+        unless (defined $Stat{$file}) {
+            $Stat{$file} = $^T;
+        }
+
+        if ($mtime > $Stat{$file}) {
+            push @changed, $key;
+        }
+        $Stat{$file} = $mtime;
+    }
+
+    #First, let's unload all changed modules
+    foreach my $module (@changed) {
+        my $package = module_to_package($module);
+        ModPerl::Util::unload_package($package);
+    }
+
+    #Then, let's reload them all, so that module dependencies can satisfy
+    #themselves in the correct order.
+    foreach my $module (@changed) {
+        my $package = module_to_package($module);
+        require $module;
+        warn("Apache2::Reload: process $$ reloading $package from 
$module\n")
+            if $DEBUG;
+    }
+
+    return Apache2::Const::OK;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Apache2::Reload - Reload changed modules
+
+=head1 SYNOPSIS
+
+In httpd.conf:
+
+  PerlInitHandler Apache2::Reload
+  PerlSetVar ReloadAll Off
+
+Then your module:
+
+  package My::Apache::Module;
+
+  use Apache2::Reload;
+
+  sub handler { ... }
+
+  1;
+
+=head1 DESCRIPTION
+
+This module is two things. First it is an adaptation of Randal
+Schwartz's Stonehenge::Reload module that attempts to be a little
+more intuitive and makes the usage easier. Stonehenge::Reload was
+written by Randal to make specific modules reload themselves when
+they changed. Unlike Apache::StatINC, Stonehenge::Reload only checked
+the change time of modules that registered themselves with
+Stonehenge::Reload, thus reducing stat() calls. Apache::Reload also
+offers the exact same functionality as Apache::StatINC, and is thus
+designed to be a drop-in replacement. Apache::Reload only checks modules
+that register themselves with Apache::Reload if you explicitly turn off
+the StatINC emulation method (see below). Like Apache::StatINC,
+Apache::Reload must be installed as an Init Handler.
+
+=head2 StatINC Replacement
+
+To use as a StatINC replacement, simply add the following configuration
+to your httpd.conf:
+
+  PerlInitHandler Apache::Reload
+
+=head2 Register Modules Implicitly
+
+To only reload modules that have registered with Apache::Reload,
+add the following to the httpd.conf:
+
+  PerlInitHandler Apache::Reload
+  PerlSetVar ReloadAll Off
+  # ReloadAll defaults to On
+
+Then any modules with the line:
+
+  use Apache2::Reload;
+
+Will be reloaded when they change.
+
+=head2 Register Modules Explicitly
+
+You can also register modules explicitly in your httpd.conf file that
+you want to be reloaded on change:
+
+  PerlInitHandler Apache2::Reload
+  PerlSetVar ReloadAll Off
+  PerlSetVar ReloadModules "My::Foo My::Bar Foo::Bar::Test"
+
+Note that these are split on whitespace, but the module list B<must>
+be in quotes, otherwise Apache tries to parse the parameter list.
+
+=head2 Special "Touch" File
+
+You can also set a file that you can touch() that causes the reloads to be
+performed. If you set this, and don't touch() the file, the reloads don't
+happen. This can be a great boon in a live environment:
+
+  PerlSetVar ReloadTouchFile /tmp/reload_modules
+
+Now when you're happy with your changes, simply go to the command line and
+type:
+
+  touch /tmp/reload_modules
+
+And your modules will be magically reloaded on the next request. This 
option
+works in both StatINC emulation mode and the registered modules mode.
+
+=head1 PSUEDOHASHES
+
+The short summary of this is: Don't use psuedohashes. Use an array with
+constant indexes. Its faster in the general case, its more guaranteed, and
+generally, it works.
+
+The long summary is that I've done some work to get this working with
+modules that use psuedo hashes, but its still broken in the case of a
+single module that contains multiple packages that all use psuedohashes.
+
+So don't do that.
+
+=head1 AUTHOR
+
+Matt Sergeant, matt@sergeant.org
+
+=head1 MAINTAINERS
+
+the mod_perl developers, dev@perl.apache.org
+
+=head1 SEE ALSO
+
+Apache::StatINC, Stonehenge::Reload
+
+=cut
Index: MANIFEST
===================================================================
--- MANIFEST	(revision 558376)
+++ MANIFEST	(working copy)
@@ -3,4 +3,9 @@
  README
  LICENSE
  lib/Apache/Reload.pm
+lib/Apache2/Reload.pm
+t/reload.t
+t/lib/Apache/TestReload.pm
+t/lib/Apache2/TestReload.pm
  RELEASE
+Changes
Index: Makefile.PL
===================================================================
--- Makefile.PL	(revision 558376)
+++ Makefile.PL	(working copy)
@@ -38,9 +38,9 @@
      require ModPerl::MM;
      ModPerl::MM::WriteMakefile(
                                 %common_opts,
-                               VERSION_FROM    => "lib/Apache/Reload.pm",
-                               NAME            => "Apache::Reload",
-                               ABSTRACT_FROM   => 'lib/Apache/Reload.pm',
+                               VERSION_FROM    => "lib/Apache2/Reload.pm",
+                               NAME            => "Apache2::Reload",
+                               ABSTRACT_FROM   => 'lib/Apache2/Reload.pm',
                                );
  }

Index: Changes
===================================================================
--- Changes	(revision 558376)
+++ Changes	(working copy)
@@ -6,8 +6,18 @@

  =over 1

-=item 0.08-dev
+=item 0.10-dev

+Apache::Reload and Apache2::Reload bundled for CPAN release
+This release incorporates unreleased changes in 0.08 and 0.09
+[Fred Moyer <fred@redhotpenguin.com>]
+
+=item 0.09
+
+Apache2::Reload was part of mod_perl2 core
+
+=item 0.08
+
  Remove modified modules before reloading them
  [Javier Ureuen Val]

Index: README
===================================================================
--- README	(revision 558376)
+++ README	(working copy)
@@ -101,6 +101,10 @@
  AUTHOR
      Matt Sergeant, matt@sergeant.org

+MAINTAINERS
+
+the mod_perl developers, dev@perl.apache.org
+
  SEE ALSO
      Apache::StatINC, Stonehenge::Reload


---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org


Mime
View raw message