view release on metacpan or  search on metacpan

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

  my ($s, %args) = @_;
  
  $args{domain} ||= eval { $s->context->config->data_connections->session->cookie_domain } || $ENV{HTTP_HOST};
  $args{path}   ||= '/';
  my @parts = ( );
  push @parts, $s->context->server->URLEncode($args{name}) . '=' . $s->context->server->URLEncode($args{value});
  unless( $args{domain} eq '*' )
  {
    push @parts, 'domain=' . $s->context->server->URLEncode($args{domain});
  }# end unless()
  push @parts, 'path=' . $args{path};
  if( $args{expires} )
  {
    if( my ($num,$type) = $args{expires} =~ m/^(\-?\d+)([MHD])$/ )
    {
      my $expires;
      if( $type eq 'M' ) {
        # Minutes:
        $expires = time() + ( $num * 60 );
      }
      elsif( $type eq 'H' ) {
        # Hours:
        $expires = time() + ( $num * 60 * 60 );
      }
      elsif( $type eq 'D' ) {
        # Days:
        $expires = time() + ( $num * 60 * 60 * 24 );
      }# end if()
      push @parts, 'expires=' . time2str( $expires );
    }
    else
    {
      push @parts, 'expires=' . time2str( $args{expires} );
    }# end if()
  }# end if()
  $s->AddHeader( 'Set-Cookie' => join('; ', @parts) . ';' );
}# end SetCookie()


sub AddHeader
{
  my ($s, $name, $value) = @_;
  
  $s->context->headers_out->push_header( $name => $value );
}# end AddHeader()


sub SetHeader
{
  my ($s, $name, $value) = @_;
  
  $s->context->headers_out->header( $name => $value );
}# end AddHeader()


sub Headers
{
  my $s = shift;
  
  my $out = $s->context->headers_out;
  map {{
    $_ => $out->{$_}
  }} keys %$out;
}# end Headers()


sub Redirect
{
  my ($s, $url) = @_;
  
  $s->Clear;
  $s->Status( 301 );
  $s->Expires( "-24H" )
    unless $s->Expires;
  $s->SetHeader( Location => $url );
  $s->End;
  return $s->Status;
}# end Redirect()


sub Declined { -1 }


sub Include
{
  my ($s, $file, $args) = @_;
  
  $s->Write( $s->_subrequest( $file, $args ) );
}# end Include()


sub TrapInclude
{
  my ($s, $file, $args) = @_;
  
  return $s->_subrequest( $file, $args );
}# end TrapInclude()


sub _subrequest
{
  my ($s, $file, $args) = @_;
  
  my $context = ASP4::HTTPContext->new( is_subrequest => 1 );
  my $original_r = $s->context->r;
  my $root = $s->context->config->web->www_root;
  my $cgi = $s->context->cgi;
  (my $uri = $file) =~ s/^\Q$root\E//;
  my $r = ASP4::Mock::RequestRec->new(
    uri   => $uri,
    args  => $original_r->args,
  );
  SCOPE: {
    local $ASP4::HTTPContext::_instance = $context;
    local $ENV{SCRIPT_NAME} = $uri;
    local $ENV{SCRIPT_FILENAME} = $file;
    $context->setup_request( $r, $cgi );
    $context->execute( $args, 1 );
  };
  
  return $context->r->buffer;