[Rt-commit] [svn] r1785 - in Module-Refresh: . lib/Module t
autrijus at pallas.eruditorum.org
autrijus at pallas.eruditorum.org
Wed Nov 10 07:25:38 EST 2004
Author: autrijus
Date: Wed Nov 10 07:25:37 2004
New Revision: 1785
Modified:
Module-Refresh/Makefile.PL
Module-Refresh/lib/Module/Refresh.pm
Module-Refresh/t/1api.t
Log:
* "Anonymize" all our methods so we can refresh ourselves.
* POD cleanup; nomenclature unification.
* ->refresh now implicitly calls ->new for the first time.
Modified: Module-Refresh/Makefile.PL
==============================================================================
--- Module-Refresh/Makefile.PL (original)
+++ Module-Refresh/Makefile.PL Wed Nov 10 07:25:37 2004
@@ -4,5 +4,6 @@
author('Jesse Vincent <jesse at bestpractical.com>');
license('perl');
version_from('lib/Module/Refresh.pm');
+abstract_from('lib/Module/Refresh.pm');
build_requires ('Test::More' => 0);
&WriteAll;
Modified: Module-Refresh/lib/Module/Refresh.pm
==============================================================================
--- Module-Refresh/lib/Module/Refresh.pm (original)
+++ Module-Refresh/lib/Module/Refresh.pm Wed Nov 10 07:25:37 2004
@@ -6,71 +6,70 @@
$VERSION = "0.02";
# Turn on the debugger's symbol source tracing
-BEGIN {$^P |= 0x10};
+BEGIN { $^P |= 0x10 };
+
+=head1 NAME
+
+Module::Refresh - Refresh %INC files when updated on disk
=head1 SYNOPSIS
- my $refresher = Module::Refresh->new();
+ # During each request, call this once to refresh changed modules:
- $refresher->refresh_updated();
+ Module::Refresh->refresh;
- # each night at midnight, you automatically download the latest
- # Acme::Current from CPAN. Use this snippet to make your running
+ # Each night at midnight, you automatically download the latest
+ # Acme::Current from CPAN. Use this snippet to make your running
# program pick it up off disk:
$refresher->refresh_module('Acme::Current');
=head1 DESCRIPTION
-This module is a generalization of the functionality provided by Apache::StatINC. It's designed to make it easy to do simple iterative development when working in a persistent environment. To that end
+This module is a generalization of the functionality provided by
+B<Apache::StatINC>. It's designed to make it easy to do simple iterative
+development when working in a persistent environment.
=cut
=head2 new
-Initialize the module refresher;
+Initialize the module refresher.
=cut
sub new {
my $proto = shift;
my $self = ref($proto) || $proto;
- $self->initialize;
- return $self;
-}
-
-=head2 initialize
-
-When we start up, set the mtime of each module to I<now>, so we don't go about
-refreshing and refreshing everything.
-
-=cut
-
-sub initialize {
- my $self = shift;
$CACHE{$_} = $self->mtime($INC{$_}) for ( keys %INC );
return ($self);
-}
+};
-=head2 refresh_updated
+=head2 refresh
-refresh all modules that have mtimes on disk newer than the newest ones we've got.
+Refresh all modules that have mtimes on disk newer than the newest ones we've got.
+Calls C<new> to initialize the cache if it had not yet been called.
=cut
-sub refresh_updated {
+sub refresh {
my $self = shift;
+
+ return $self->new if !%CACHE;
+
foreach my $mod (sort keys %INC) {
if ( !$CACHE{$mod} or ( $self->mtime($INC{$mod}) ne $CACHE{$mod} ) ) {
$self->refresh_module($mod);
}
}
return ($self);
-}
+};
+
+=head2 refresh_module $module
-=head2 refresh_module $mod
+Refresh a module. It doesn't matter if it's already up to date. Just do it.
-refresh module $mod. It doesn't matter if it's already up to date. Just do it.
+Note that it only accepts module names like C<Foo/Bar.pm>, not C<Foo::Bar>.
=cut
@@ -83,30 +82,28 @@
local $@;
eval { require $mod; 1 } or warn $@;
- $self->cache_mtime( $mod => $self->mtime( $INC{$mod} ) );
+ $CACHE{$mod} = $self->mtime( $INC{$mod} );
return ($self);
-}
+};
+
+=head2 unload_module $module
+
+Remove a module from C<%INC>, and remove all subroutines defined in it.
+
+=cut
sub unload_module {
my $self = shift;
- my $file = shift;
- my $path = $INC{$file};
- delete $INC{$file};
- delete $CACHE{$file};
- $self->cleanup_subs($path);
- return ($self);
-}
-
-sub cache_mtime {
- my $self = shift;
- my $mod = shift;
- my $mtime = shift;
+ my $mod = shift;
+ my $file = $INC{$mod};
- $CACHE{$mod} = $mtime;
+ delete $INC{$mod};
+ delete $CACHE{$mod};
+ $self->unload_subs($file);
return ($self);
-}
+};
=head2 mtime $file
@@ -116,21 +113,18 @@
sub mtime {
return join ' ', ( stat($_[1]) )[1, 7, 9];
-}
-
+};
-=head2 cleanup_subs filename
+=head2 unload_subs $file
-Wipe out subs defined in $file.
+Wipe out subs defined in $file.
=cut
-
-sub cleanup_subs {
+sub unload_subs {
my $self = shift;
my $file = shift;
- # Find all the entries in %DB::sub whose keys match "$file:" and wack em
foreach my $sym (
grep { index( $DB::sub{$_}, "$file:" ) == 0 } keys %DB::sub
) {
@@ -138,26 +132,39 @@
delete $DB::sub{$sym};
}
- return ($self);
+ return $self;
+};
+
+# "Anonymize" all our subroutines into unnamed closures; so we can safely
+# refresh this very package.
+BEGIN {
+ no strict 'refs';
+ foreach my $sym (sort keys %{__PACKAGE__.'::'}) {
+ my $code = __PACKAGE__->can($sym) or next;
+ delete ${__PACKAGE__.'::'}{$sym};
+ *$sym = sub { goto &$code };
+ }
}
+1;
+
=head1 BUGS
When we walk the symbol table to whack reloaded subroutines, we don't have a good way
to invalidate the symbol table.
-=head1 AUTHOR
+=head1 SEE ALSO
-Jesse Vincent <jesse at bestpractical.com>
+L<Apache::StatINC>, L<Module::Reload>
-8 November, 2004, Hua Lien, Taiwan
+=head1 COPYRIGHT
+Copyright 2004 by Jesse Vincent E<lt>jesse at bestpractical.comE<gt>,
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
-=head1 SEE ALSO
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
-L<Module::Refresh>, which does much the same thing, with a little less efficiency
-up front. (And doesn't have the API for manual expiry.
+See L<http://www.perl.com/perl/misc/Artistic.html>
=cut
-
-1;
Modified: Module-Refresh/t/1api.t
==============================================================================
--- Module-Refresh/t/1api.t (original)
+++ Module-Refresh/t/1api.t Wed Nov 10 07:25:37 2004
@@ -6,7 +6,7 @@
use File::Spec;
my $tmp = File::Spec->tmpdir;
-my $module = File::Spec->catfile($tmp, 'FooBar.pm');
+my $file = File::Spec->catfile($tmp, 'FooBar.pm');
push @INC, $tmp;
write_out(<<".");
@@ -36,14 +36,14 @@
is(Foo::Bar->foo, 'bar', "We got the right result, still");
-$r->refresh_updated;
+$r->refresh;
is(Foo::Bar->foo, 'baz', "We got the right new result,");
# After a refresh, did we blow away our non-file-based comp?
can_ok('Foo::Bar', 'not_in_foobarpm');
-$r->cleanup_subs($module);
+$r->unload_subs($file);
ok(!defined(&Foo::Bar::foo), "We cleaned out the 'foo' method'");
#ok(!UNIVERSAL::can('Foo::Bar', 'foo'), "We cleaned out the 'foo' method'");
@@ -52,7 +52,7 @@
sub write_out {
local *FH;
- open FH, "> $module" or die "Cannot open $module: $!";
+ open FH, "> $file" or die "Cannot open $file: $!";
print FH $_[0];
close FH;
}
More information about the Rt-commit
mailing list