view release on metacpan or  search on metacpan

lib/Apache/Reload.pm  view on Meta::CPAN

# 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 Apache::Reload;

use strict;

$Apache::Reload::VERSION = '0.14';

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

%Stat = ($INC{"Apache/Reload.pm"} => time);

$TouchTime = time;

sub import {
    my $class = shift;
    my ($package,$file) = (caller)[0,1];
    
    $class->register_module($package, $file);
}

sub unimport {
    my $class = shift;
    my ($package,$file) = (caller)[0,1];

    $class->unregister_module($package, $file);
}

sub package_to_module {
    my $package = shift;
    $package =~ s/::/\//g;
    $package .= ".pm";
    return $package;
}

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;
    }
    
    no strict 'refs';
    if (%{"${package}::FIELDS"}) {
        $UndefFields{$module} = "${package}::FIELDS";
    }
}

sub unregister_module {
    my ($class, $package, $file) = @_;
    my $module = package_to_module($package);

    $Ignore{$module} = 1;
}

sub handler {
    my $r = shift;
    
    my $DEBUG = ref($r) && (lc($r->dir_config("ReloadDebug") || '') eq 'on');
    
    my $TouchFile = ref($r) && $r->dir_config("ReloadTouchFile");
    
    my $TouchModules;
    
    if ($TouchFile) {
        warn "Checking mtime of $TouchFile\n" if $DEBUG;
        my $touch_mtime = (stat($TouchFile))[9] || return 1;
        return 1 unless $touch_mtime > $TouchTime;
        $TouchTime = $touch_mtime;
        my $sym = Apache->gensym;
        open($sym, $TouchFile) || die "Can't open '$TouchFile': $!";
        $TouchModules = <$sym>;
        chomp $TouchModules;
    }
    
    if (ref($r) && (lc($r->dir_config("ReloadAll") || 'on') eq 'on')) {
        *Apache::Reload::INCS = \%INC;
    }