credentials results from the CPAN

AxKit2
view release on metacpan or search on metacpan
sub hook_error {
    my $self = shift;
    $self->headers_out->code(SERVER_ERROR);
    $self->run_hooks('error', @_);
}

sub hook_error_end {
    my ($self, $ret) = @_;
    if ($ret == DECLINED) {
        $self->default_error_out(SERVER_ERROR);
    }
    elsif ($ret == OK || $ret == DONE) {
        # we assume some hook handled the error
    }
    else {
        $self->default_error_out($ret);
    }
}

# stolen shamelessly from httpd-2.2.2/modules/http/http_protocol.c
sub default_error_out {
    my ($self, $code, $extras) = @_;
    $extras = '' unless defined $extras;
    
    $self->initialize_response;
    
    $self->headers_out->code($code);
    
    if ($code == NOT_MODIFIED) {
        $self->send_http_headers;
        $self->write(sub { $self->hook_response_sent($self->headers_out->response_code) });
        # The 304 response MUST NOT contain a message-body
        return;
    }
    
    $self->headers_out->header('Content-Type', 'text/html');
    $self->headers_out->header('Connection', 'close');
    $self->send_http_headers;
    
    $self->write("<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n" .
                 "<HTML><HEAD>\n" .
                 "<TITLE>$code ".$self->headers_out->http_code_english."</TITLE>\n" .
                 "</HEAD></BODY>\n" .
                 "<H1>".$self->headers_out->http_code_english."</H1>\n"
                 );
    
    if ($code == REDIRECT) {
        my $new_uri = $self->headers_out->header('Location')
            || die "No Location header set for REDIRECT";
        $self->write('The document has moved <A HREF="' . 
                        xml_escape($new_uri) . "\">here</A>.<P>\n");
    }
    elsif ($code == BAD_REQUEST) {
        $self->write("<p>Your browser sent a request that this server could not understand.<br />\n" .
                     xml_escape($extras)."</p>\n");
    }
    elsif ($code == UNAUTHORIZED) {
        $self->write("<p>This server could not verify that you\n" .
                       "are authorized to access the document\n" .
                       "requested.  Either you supplied the wrong\n" .
                       "credentials (e.g., bad password), or your\n" .
                       "browser doesn't understand how to supply\n" .
                       "the credentials required.</p>\n");
    }
    elsif ($code == FORBIDDEN) {
        $self->write("<p>You don't have permission to access " . 
                     xml_escape($self->headers_in->uri) .
                     "\non this server.</p>\n");
    }
    elsif ($code == NOT_FOUND) {
        $self->write("<p>The requested URL " . 
                     xml_escape($self->headers_in->uri) .
                     " was not found on this server.</p>\n");
    }
    elsif ($code == SERVICE_UNAVAILABLE) {
        $self->write("<p>The server is temporarily unable to service your\n" .
                     "request due to maintenance downtime or capacity\n" .
                     "problems. Please try again later.</p>\n");
    }
    else {
        $self->write("The server encountered an internal error or \n" .
                     "misconfiguration and was unable to complete \n" .
                     "your request.<p>\n" .
                     "More information about this error may be available\n" .
                     "in the server error log.<p>\n");
    }
    
    $self->write(<<EOT);
<HR>
</BODY></HTML>
EOT

    $self->write(sub { $self->hook_response_sent($self->headers_out->response_code) });
}

1;
( run in 2.195 seconds using v1.01-cache-2.11-cpan-cdf2f3d4e48 )