view release on metacpan or  search on metacpan

lib/ASP4/HTTPContext.pm  view on Meta::CPAN

}

sub rclear {
  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";
  
  return $s->end_request;
}# end handle_error()


sub end_request
{
  my $s = shift;
  
  $s->response->End;
  my $res = $s->response->Status =~ m/^200/ ? 0 : $s->response->Status;
  
  return $res;
}# end end_request()


sub do_disable_session_state
{
  my ($s) = @_;
  
#  my ($uri) = split /\?/, $s->r->uri;
  my ($uri) = split /\?/, $ENV{REQUEST_URI} || $s->r->uri;
  my ($yes) = grep { $_->disable_session } grep {
    if( my $pattern = $_->uri_match )
    {
      $uri =~ m/^$pattern$/
    }
    else
    {
      $uri eq $_->uri_equals;
    }# end if()
  } $s->config->web->disable_persistence;
  
  return $yes;
}# end do_disable_session_state()


sub DESTROY
{
  my $s = shift;
  $s->session->save if $s->session && ! $s->session->is_read_only;
  $s = { };
  undef(%$s);
}# end DESTROY()

1;# return true:

=pod

=head1 NAME

ASP4::HTTPContext - Provides access to the intrinsic objects for an HTTP request.

=head1 SYNOPSIS

  use ASP4::HTTPContext;
  
  my $context = ASP4::HTTPContext->current;
  
  # Intrinsics:
  my $request   = $context->request;
  my $response  = $context->response;
  my $session   = $context->session;