ASP4
view release on metacpan or search on metacpan
lib/ASP4/HTTPContext.pm view on Meta::CPAN
my $s = shift;
$s->buffer->clear;
}
sub send_headers
{
my $s = shift;
return if $s->{did_send_headers};
my $headers = $s->headers_out;
while( my ($k,$v) = each(%$headers) )
{
$s->r->err_headers_out->{$k} = $v;
}# end while()
$s->r->rflush;
$s->{did_send_headers} = 1;
}# end send_headers()
# Here be dragons:
sub buffer { shift->{buffer}->[-1] }
sub add_buffer {
my $s = shift;
$s->rflush;
push @{$s->{buffer}}, ASP4::OutBuffer->new;
}
sub purge_buffer { shift( @{shift->{buffer}} ) }
sub execute
{
my ($s, $args, $is_include) = @_;
unless( $is_include )
{
# Set up and execute any matching request filters:
my $resolver = $s->config->web->filter_resolver;
foreach my $filter ( $resolver->new()->resolve_request_filters( $s->r->uri ) )
{
$s->config->load_class( $filter->class );
$filter->class->init_asp_objects( $s );
my $IS_FILTER = 1;
my $res = $s->handle_phase(sub{ $filter->class->new()->run( $s ) }, $IS_FILTER);
if( $s->did_end || ( defined($res) && $res != -1 ) )
{
return $res;
}# end if()
}# end foreach()
}# end unless()
eval {
$s->{handler} = $s->config->web->handler_resolver->new()->resolve_request_handler( $s->r->uri );
};
if( $@ )
{
$s->server->{LastError} = $@;
return $s->handle_error;
}# end if()
return $s->response->Status( 404 ) unless $s->{handler};
eval {
$s->config->load_class( $s->handler );
$s->config->web->handler_runner->new()->run_handler( $s->handler, $args );
};
if( $@ )
{
$s->server->{LastError} = $@;
return $s->handle_error;
}# end if()
$s->response->Flush;
my $res = $s->end_request();
$res = 0 if $res =~ m/^200/;
return $res;
}# end execute()
sub handle_phase
{
my ($s, $ref, $is_filter) = @_;
my $res = eval { $ref->( ) };
if( $@ )
{
$s->handle_error;
}# end if()
# Undef on success:
if( $is_filter )
{
if( defined($res) && $res > -1 )
{
$s->response->Status( $res );
return $res;
}
else
{
return;
}# end if()
}
else
{
return if (! defined($res)) || $res == -1;
return $s->response->Status =~ m/^200/ ? undef : $s->response->Status;
}# end if()
}# end handle_phase()
sub handle_error
{
my $s = shift;
$s->response->Status( 500 );
$s->response->Clear();
my $err_str = $@;
my $error = $s->server->Error( $@ );
warn "[Error: @{[ HTTP::Date::time2iso() ]}] $err_str\n";
( run in 0.678 second using v1.01-cache-2.11-cpan-39bf76dae61 )