view release on metacpan or  search on metacpan

lib/Apache2/Dispatch.pm  view on Meta::CPAN

    #---------------------------------------------------------------------
    # create the new object
    #---------------------------------------------------------------------

    my ($class, $method) =
      __PACKAGE__->_translate_uri($r, $prefix, $new_location, $log, $debug);

    unless ($class && $method) {
        $log->debug("\tclass and method could not be discovered");
        $log->debug("Exiting Apache2::Dispatch");
        return Apache2::Const::DECLINED;
    }

    if ($uppercase) {
        $class =~ s/::([a-z])/::\U$1/g;
    }

    my $object = {};

    bless $object, $class;

    #---------------------------------------------------------------------
    # set parent classes for DispatchISA
    #---------------------------------------------------------------------

    if (@parents) {
        $rc = __PACKAGE__->_set_ISA($prefix, $log, @parents);

        unless ($rc) {
            $log->error("\tDispatchISA did not return successfully!");
            $log->debug("Exiting Apache2::Dispatch") if $debug;
            return Apache2::Const::DECLINED;
        }
    }

    #---------------------------------------------------------------------
    # require the module if DispatchRequire On
    #---------------------------------------------------------------------

    if ($require) {
        $log->debug("\tattempting to require $class...") if $debug > 1;

        eval "require $class";

        if ($@) {
            $log->warn("\tcould not require $class: $@");
            $log->debug("Exiting Apache2::Dispatch") if $debug;
            return Apache2::Const::DECLINED;
        }
        else {
            $log->debug("\t$class required successfully") if $debug > 1;
        }
    }

    #---------------------------------------------------------------------
    # reload the module if DispatchStat On or ISA
    #---------------------------------------------------------------------

    if ($stat eq "ON") {
        $rc = __PACKAGE__->_stat($class, $log);

        unless ($rc) {
            $log->error("\tDispatchStat did not return successfully!");
            $log->debug("Exiting Apache2::Dispatch") if $debug;
            return Apache2::Const::DECLINED;
        }
    }
    elsif ($stat eq "ISA") {
        $rc = __PACKAGE__->_recurse_stat($class, $log);

        unless ($rc) {
            $log->error("\tDispatchStat did not return successfully!");
            $log->debug("Exiting Apache2::Dispatch") if $debug;
            return Apache2::Const::DECLINED;
        }
    }

    #---------------------------------------------------------------------
    # see if the handler is a valid method
    # if not, decline the request
    #---------------------------------------------------------------------

    my $handler = __PACKAGE__->_check_dispatch($object, $method, $autoload, $log, $debug);

    if ($handler) {
        $log->debug("\t$uri was translated into $class->$method") if $debug;
    }
    else {
        $log->error("\t$uri did not result in a valid method");
        $log->debug("Exiting Apache2::Dispatch") if $debug;
        return Apache2::Const::DECLINED;
    }

    #---------------------------------------------------------------------
    # since the uri is dispatchable, check each of the extras
    #---------------------------------------------------------------------
    foreach my $extra (@extras) {
        if ($extra eq "PRE") {
            $prehandler =
              __PACKAGE__->_check_dispatch($object, "pre_dispatch", $autoload, $log, $debug);
        }
        elsif ($extra eq "POST") {
            $posthandler =
              __PACKAGE__->_check_dispatch($object, "post_dispatch", $autoload, $log, $debug);
        }
        elsif ($extra eq "ERROR") {
            $errorhandler =
              __PACKAGE__->_check_dispatch($object, "error_dispatch", $autoload, $log, $debug);
        }
    }

    #---------------------------------------------------------------------
    # run each of the enabled methods, ignoring pre and post errors
    #---------------------------------------------------------------------

    eval { $object->$prehandler($r) } if $prehandler;

    eval { $rc = $object->$handler($r) };

    if ($errorhandler && ($@ || $rc != Apache2::Const::OK)) {

        # if the error handler dies we want to catch it, so don't eval
        $rc = $object->$errorhandler($r, $@, $rc);
    }
    elsif ($@) {
        $log->error("$class->$method died: $@");
        $rc = Apache2::Const::SERVER_ERROR;
    }