view release on metacpan or  search on metacpan

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

    $s->{_expires} = $time;
    $s->{_expires_absolute} = time2str( $time );
    $s->SetHeader( expires  => $s->ExpiresAbsolute );
  }# end if()
  
  return $s->{_expires};
}# end Expires()


sub ExpiresAbsolute { shift->{_expires_absolute} }


sub Status
{
  my $s = shift;
  
  @_ ? $s->context->r->status( $s->{_status} = +shift ) : $s->{_status};
}# end Status()


sub End
{
  my $s = shift;
  
  if( $s->Status =~ m{^2} )
  {
    $s->Flush;
  }
  else
  {
    delete $s->context->headers_out->{'content-type'};
  }# end if()
  
  # Would be nice to somehow stop all execution:
  $s->context->did_end( 1 );
}# end End()


sub Flush
{
  my $s = shift;
  $s->context->rflush;
}# end Flush()


sub Clear
{
  shift->context->rclear
}# end Clear()


sub IsClientConnected
{
  ! shift->context->r->connection->aborted();
}# end IsClientConnected()


sub Write
{
  my $s = shift;
  $s->context->rprint( shift(@_) )
}# end Write()


sub SetCookie
{
  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()