view release on metacpan or  search on metacpan

lib/Module/Refresh.pm  view on Meta::CPAN

    }

}

=head2 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 C<Foo/Bar.pm>, not C<Foo::Bar>.

=cut

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);
}

=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 $mod  = shift;
    my $file = $INC{$mod};

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

    return ($self);
}

=head2 mtime $file

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

=cut

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

=head2 update_cache $file

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

=cut

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

    # In case the module was not loaded successfully.
    return unless defined $INC{$module_pm};

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

=head2 unload_subs $file

Wipe out subs defined in $file.

=cut

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;

=head1 BUGS

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.