view release on metacpan or  search on metacpan

lib/Apache/Dispatch/Util.pm  view on Meta::CPAN

    # this method is for internal use only
    #---------------------------------------------------------------------
	
	my $pkg = shift;
    my ($class, $log) = @_;

    (my $module = $class) =~ s!::!/!g;

    $module .= ".pm";

    $stat{$module} = $^T unless $stat{$module};

    if ($INC{$module}) {
        $log->debug("\tchecking $module for reload in pid $$...");

        my $mtime = (stat $INC{$module})[9];

        unless (defined $mtime && $mtime) {
            $log->error("Apache::Dispatch cannot find $module!");
            return 1;
        }

        if ($mtime > $stat{$module}) {

            # turn off warnings for this bit...
            local $^W;

            delete $INC{$module};
            eval { require $module };

            if ($@) {
                $log->error("Apache::Dispatch: $module failed reload! $@");
                return;
            }
            elsif (!$@) {
                $log->debug("\t$module reloaded");
            }
            $stat{$module} = $mtime;
        }
        else {
            $log->debug("\t$module not modified");
        }
    }
    else {
        $log->error("Apache::Dispatch: $module not in \%INC!");
    }

    return 1;
}

sub _recurse_stat {

    #---------------------------------------------------------------------
    # recurse through all the parent classes of the current class
    # and call _stat on each
    # this method is for internal use only
    #---------------------------------------------------------------------

    my ($class, $log) = @_;

    my $rc = _stat($class, $log);

    return unless $rc;

    # turn off strict here so we can get at the class @ISA
    no strict 'refs';

    foreach my $package (@{"${class}::ISA"}) {
        $rc = _recurse_stat($package, $log);
        last unless $rc;
    }

    return $rc;
}

sub _set_ISA {

    #---------------------------------------------------------------------
    # set the ISA array for the class
    # this method is for internal use only
    #---------------------------------------------------------------------
    my ($pkg, $class, $log, @parents) = @_;

    # turn off strict here so we can get at the class @ISA
    no strict 'refs';

    $log->debug("\t\@ISA for $class currently contains ",
                (join ", ", @{"${class}::ISA"}));
    $log->debug("\tabout to merge ", (join ", ", @parents));
    
	# only add classes to @ISA if they are not there already
    my %seen;

    @{"${class}::ISA"} = grep !$seen{$_}++, (@{"${class}::ISA"}, @parents);
	
	$log->debug("\t\@ISA for $class now contains ",
                (join ", ", @{"${class}::ISA"}));

    return 1;
}

#---------------------------------------------------------------------
# Apache configuration methods
#---------------------------------------------------------------------

sub _new {
    return bless {}, shift;
}

sub DIR_CREATE {
    my $class = shift;
    my $self  = $class->_new;

    $self->{_stat}     = "Off";    # no reloading by default
    $self->{_autoload} = 0;        # no autloading by default
    $self->{_require}  = 0;        # no require()ing by default

    #  warn "inside DIR_CREATE";
    return $self;
}

sub DIR_MERGE {
    my ($parent, $current) = @_;
    my %new = (%$parent, %$current);

    #  warn "inside DIR_MERGE";
    return bless \%new, ref($parent);
}