[Rt-commit] [svn] r1774 - in Module-Refresh: lib/Module t

[autrijus at pallas.eruditorum.org]

Author: autrijus
Date: Wed Nov 10 03:52:20 2004
New Revision: 1774

Modified:
   Module-Refresh/lib/Module/Refresh.pm
   Module-Refresh/t/1api.t
Log:
* Various cleanups to make it 5.005-friendly.
* Use (inode, size, mtime) as the cache value instead of mtime alone.


Modified: Module-Refresh/lib/Module/Refresh.pm
==============================================================================
--- Module-Refresh/lib/Module/Refresh.pm	(original)
+++ Module-Refresh/lib/Module/Refresh.pm	Wed Nov 10 03:52:20 2004
@@ -1,28 +1,25 @@
-use warnings;
-use strict;
-
 package Module::Refresh;
 
-our $VERSION = '0.01';
+use strict;
+use vars qw( $VERSION %CACHE );
 
-our %CACHE;
+$VERSION = 0.01;
 
-=head1 DESCRIPTION
+=head1 SYNOPSIS
 
-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
+    my $refresher = Module::Refresh->new();
 
-=head1 EXAMPLE
+    $refresher->refresh_updated();
 
+    # 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:
 
-my $refresher = Inc::Refresh->new();
+    $refresher->refresh_module('Apache::Current');
 
-$refresher->refresh_updated();
-
-# 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:
+=head1 DESCRIPTION
 
-$refresher->refresh_module('Apache::Current');
+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
 
 =cut
 
@@ -34,28 +31,21 @@
 
 sub new {
     my $proto = shift;
-    my $class = ref($proto) || $proto;
-
-    my $self = {};
-    bless $self, $class;
-
-    $self->_initialize_cache();
-    return ($self);
+    my $self = ref($proto) || $proto;
+    $self->initialize;
+    return $self;
 }
 
-=head2 _initialize_cache
+=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.
+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_cache {
+sub initialize {
     my $self = shift;
-    my $time = time();
-
-    $CACHE{$_} = $time for ( keys %INC );
-
+    $CACHE{$_} = $self->mtime($INC{$_}) for ( keys %INC );
     return ($self);
 }
 
@@ -67,8 +57,8 @@
 
 sub refresh_updated {
     my $self = shift;
-    while ( my ( $mod, $path ) = each %INC ) {
-        if ( !$CACHE{$mod} || $self->mtime($path) > $CACHE{$mod} ) {
+    foreach my $mod (sort keys %INC) {
+        if ( !$CACHE{$mod} or ( $self->mtime($INC{$mod}) ne $CACHE{$mod} ) ) {
             $self->refresh_module($mod);
         }
     }
@@ -87,10 +77,9 @@
 
     $self->unload_module($mod);
 
-        eval { 
-            require $mod 
-         };
-        warn $@ if ($@);
+    local $@;
+    eval { require $mod; 1 } or warn $@;
+
     $self->cache_mtime( $mod => $self->mtime( $INC{$mod} ) );
 
     return ($self);
@@ -98,10 +87,10 @@
 
 sub unload_module {
     my $self = shift;
-    my $mod  = shift;
-    delete $INC{$mod};
-    $self->cache_mtime( $mod => 0 );
-
+    my $file = shift;
+    delete $INC{$file};
+    delete $CACHE{$file};
+    return ($self);
 }
 
 sub cache_mtime {
@@ -121,9 +110,7 @@
 =cut
 
 sub mtime {
-    my $self     = shift;
-    my $filename = shift;
-    return ( stat($filename) )[9];
+    return join ' ', ( stat($_[1]) )[1, 7, 9];
 }
 
 

Modified: Module-Refresh/t/1api.t
==============================================================================
--- Module-Refresh/t/1api.t	(original)
+++ Module-Refresh/t/1api.t	Wed Nov 10 03:52:20 2004
@@ -3,10 +3,17 @@
 use strict;
 
 use Test::More qw/no_plan/;
+use File::Spec;
 
-use lib qw{/tmp};
+my $tmp = File::Spec->tmpdir;
+my $module = File::Spec->catfile($tmp, 'FooBar.pm');
+push @INC, $tmp;
 
-`echo "package Foo::Bar; sub foo { 'bar'}\n1;" > /tmp/FooBar.pm`;
+write_out(<<".");
+package Foo::Bar;
+sub foo { 'bar' }
+1;
+.
 
 use_ok('Module::Refresh');
 
@@ -21,11 +28,15 @@
 
 is(Foo::Bar->foo, 'bar', "We got the right result");
 
-`echo "package Foo::Bar; sub foo { 'baz'}\n1;" > /tmp/FooBar.pm`;
+write_out(<<".");
+package Foo::Bar; 
+sub foo { 'baz' }
+1;
+.
+
 is(Foo::Bar->foo, 'bar', "We got the right result, still");
 
 $r->refresh_updated;
-sleep (2); # we only have second-level granularity
 
 is(Foo::Bar->foo, 'baz', "We got the right new result,");
 
@@ -40,6 +51,12 @@
 
 is(Foo::Bar->foo, 'baz', "We got the right new result,");
 
+sub write_out {
+    local *FH;
+    open FH, "> $module" or die "Cannot open $module: $!";
+    print FH $_[0];
+    close FH;
+}
 
 
 package Foo::Bar;
@@ -49,5 +66,3 @@
 }
 
 1;
-
-