Module::Refresh - Refresh %INC files when updated on disk

Module-Refresh documentation Contained in the Module-Refresh distribution.

Index

Code Index:

NAME

Top

Module::Refresh - Refresh %INC files when updated on disk

SYNOPSIS

Top

    # During each request, call this once to refresh changed modules:

    Module::Refresh->refresh;

    # 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.pm');

DESCRIPTION

Top

This module is a generalization of the functionality provided by Apache::StatINC and Apache::Reload. It's designed to make it easy to do simple iterative development when working in a persistent environment.

It does not require mod_perl.

new

Initialize the module refresher.

refresh

Refresh all modules that have mtimes on disk newer than the newest ones we've got. Calls new to initialize the cache if it had not yet been called.

Specifically, it will renew any module that was loaded before the previous call to refresh (or new) and has changed on disk since then. If a module was both loaded for the first time and changed on disk between the previous call and this one, it will not be reloaded by this call (or any future one); you will need to update the modification time again (by using the Unix touch command or making a change to it) in order for it to be reloaded.

refresh_module_if_modified $module

If $module has been modified on disk, refresh it. Otherwise, do nothing

refresh_module $module

Refresh a module. It doesn't matter if it's already up to date. Just do it.

Note that it only accepts module names like Foo/Bar.pm, not Foo::Bar.

unload_module $module

Remove a module from %INC, and remove all subroutines defined in it.

mtime $file

Get the last modified time of $file in seconds since the epoch;

update_cache $file

Updates the cached "last modified" time for $file.

unload_subs $file

Wipe out subs defined in $file.

BUGS

Top

When we walk the symbol table to whack reloaded subroutines, we don't have a good way to invalidate the symbol table properly, so we mess up on things like global variables that were previously set.

SEE ALSO

Top

Apache::StatINC, Module::Reload

COPYRIGHT

Top

Copyright 2004,2011 by Jesse Vincent <jesse@bestpractical.com>, Audrey Tang <audreyt@audreyt.org>

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

See http://www.perl.com/perl/misc/Artistic.html

Module-Refresh documentation Contained in the Module-Refresh distribution. 
package Module::Refresh;

use strict;
use vars qw( $VERSION %CACHE );

$VERSION = "0.16";

BEGIN {

    # Turn on the debugger's symbol source tracing
    $^P |= 0x10;

    # Work around bug in pre-5.8.7 perl where turning on $^P
    # causes caller() to be confused about eval {}'s in the stack.
    # (See http://rt.perl.org/rt3/Ticket/Display.html?id=35059 for more info.)
    eval 'sub DB::sub' if $] < 5.008007;
}


sub new {
    my $proto = shift;
    my $self = ref($proto) || $proto;
    $self->update_cache($_) for keys %INC;
    return ($self);
}


sub refresh {
    my $self = shift;

    return $self->new if !%CACHE;

    foreach my $mod ( sort keys %INC ) {
        $self->refresh_module_if_modified($mod);
    }
    return ($self);
}


sub refresh_module_if_modified {
    my $self = shift;
    return $self->new if !%CACHE;
    my $mod = shift;

    if ( !$CACHE{$mod} ) {
        $self->update_cache($mod);
    } elsif ( $self->mtime( $INC{$mod} ) ne $CACHE{$mod} ) {
        $self->refresh_module($mod);
    }

}


sub refresh_module {
    my $self = shift;
    my $mod  = shift;

    $self->unload_module($mod);

    local $@;
    eval { require $mod; 1 } or warn $@;

    $self->update_cache($mod);

    return ($self);
}


sub unload_module {
    my $self = shift;
    my $mod  = shift;
    my $file = $INC{$mod};

    delete $INC{$mod};
    delete $CACHE{$mod};
    $self->unload_subs($file);

    return ($self);
}


sub mtime {
    return join ' ', ( stat( $_[1] ) )[ 1, 7, 9 ];
}


sub update_cache {
    my $self      = shift;
    my $module_pm = shift;

    $CACHE{$module_pm} = $self->mtime( $INC{$module_pm} );
}


sub unload_subs {
    my $self = shift;
    my $file = shift;

    foreach my $sym ( grep { index( $DB::sub{$_}, "$file:" ) == 0 }
        keys %DB::sub )
    {

        warn "Deleting $sym from $file" if ( $sym =~ /freeze/ );
        eval { undef &$sym };
        warn "$sym: $@" if $@;
        delete $DB::sub{$sym};
        { no strict 'refs';
            if ($sym =~ /^(.*::)(.*?)$/) {
                delete *{$1}->{$2};
            }
        } 
    }

    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__ . '::' } ) {
        next
            if $sym eq
            'VERSION';    # Skip the version sub, inherited from UNIVERSAL
        my $code = __PACKAGE__->can($sym) or next;
        delete ${ __PACKAGE__ . '::' }{$sym};
        *$sym = sub { goto &$code };
    }

}

1;